Примеры по PascalABC

{
 Пример описания типа "Цвет" и "Кот" и создание объектов этих типов (классов).
 В них мы описываем сами свойства соответсвующих объектов данных типов.
 Следует обратить внимание на то, что доступ к переменным (правильней называть их полями)
 в классах не ограничен - имеется из любого места в программе. Почему - показано в следующих примерах.
 
 Ниже можете видеть такую функцию (хотя вместо function слово constructor), которая имеет имя Create.
 По сути это обычная функция, которая заполняет поля объекта какими то значениями и возвращает ссылку
 на него. Но правильней эту функцию называть конструктором.
 
 В именах параметров конструкторов можете заметить нижнее подчеркивание - оно требуется для того, чтобы
 не было конфликта имен. Однако, есть и другой способ решения этой проблемы, но - он описан в других
 примерах.
}
 
type
  TColor = class // Тип цвета.
    R, G, B: byte; // Компоненты цвета R, G, B.
    
    { При создании цвета обязательно указываем все три компоненты цвета. }
    constructor Create(r_, g_, b_: byte);
    begin
      R := r_;
      G := g_;
      B := b_;
    end;
  end;
  
type
  TCat = class // Тип кота.
    Color: TColor; // Цвет кота.
    Weight: byte; // Вес кота.
    
    { При создании кота указываем его цвет и вес обязательно. }
    constructor Create(color_: TColor; weight_: byte);
    begin
      Color := color_;
      Weight := weight_;
    end;
  end;
 
var
  Color: TColor; // Цвет кота.
  Cat: TCat; // Сам кот.
 
begin
  { Для создания объекта (в данном случае цвета) пишем имя класса (в данном случае TColor),
    затем через точку слово "Create" и указываем все те параметры, которые нужны для создания цвета. }
  Color := TColor.Create(244, 245, 12); // Создаем цвет.
  Cat := TCat.Create(Color, 12); // Создаем кота, используя ранее созданный цвет.
  
  { Доступ к полям цвета или кота осуществляется также как и доступ к полям записи: }
  Writeln(Color.B);
end.

{
 Пример описания типа "Цвет". Создаем методы (просто процедуры и функции, описываемые в классе) класса.
}
 
type
  TColor = class
  { Явно указываем (с помощью public), что все поля и методы до конца класса (в данном случае)
    доступны из любого места программы. }
  public
    R, G, B: byte;
 
    constructor Create(r_, g_, b_: byte);
    begin
      R := r_;
      G := g_;
      B := b_;
    end;
    
    { Процедура (метод) для прибавления к компонентам цвета R, G, B чисел r_, g_, b_. }
    procedure Add(r_, g_, b_: byte);
    begin
      R := R + r_;
      G := G + g_;
      B := B + b_;
    end;
    
    { Процедура (метод) для отнимания от компонентам цвета R, G, B чисел r_, g_, b_. }
    procedure Minus(r_, g_, b_: byte);
    begin
      Add(-r_, -g_, -b_); // Просто вызовем метод сложения с компонентами R, G, B изменив знаки параметров процедуры.
    end;
 
    { Процедура, предназначенная для вывода цвета на экран. }
    procedure Println;
    begin
      Writeln(R, ' ', G, ' ', B);
    end;
  end;
 
var
  Color: TColor;
 
begin
  Color := TColor.Create(100, 50, 25);
  Writeln(Color.R, ' ', Color.G, ' ', Color.B);
  Color.Add(0, 50, 75);
  Writeln(Color.R, ' ', Color.G, ' ', Color.B);
  Color.Println(); // Тоже самое, что и выше, только методом.
end.

{
  Пример защиты от дурака.
}
type
  TPerson = class
  { Явно указываем (с помощью private), что все поля и методы (если бы были) до public (в данном случае)
    доступны из любого места только этого класса. }
  private
    name: string;
    age: integer;
 
  { А все что ниже (до конца класса) видно во всей программе. }
  public
    { Для установки возраста - защита от дурака.
      Если возраст будет неправильный (в параметре age_),
      то у человека останется прежний возраст. }
    procedure SetAge(age_: integer);
    begin
      if age_ < 1 then
        Writeln('Ошибочка вышла - возраст не может быть отрицательным или равным нулю.')
      else
        age := age_;
    end;
    
    { Для получения возраста - ведь доступ к age вне класса отсутсвует. }
    function GetAge: integer;
    begin
      Result := age;
    end;
    
    { Для установки имени - защита от дурака.
      Если имя будет неправильным (в параметре name_),
      то у человека останется прежнее имя. }
    procedure SetName(name_: string);
    begin
      if name_ = '' then
        Writeln('Ошибочка вышла - человек не может быть без имени.')
      else
        name := name_;
    end;
    
    { Для получения имени - ведь доступ к name вне класса отсутсвует. }
    function GetName: string;
    begin
      Result := name;
    end;
    
    constructor Create(name_: string; age_: integer);
    begin
      { Считаем, что по умолчанию человеку 10 лет и его зовут Вася.
        Тем более не во всех компиляторах есть автоматическая инициазация переменных.
        Поэтому без этой (ниже) строчки в ней бы мог лежать мусор. }
      name := 'Вася';
      age := 10;
      SetName(name_); // Пытаемся поменять имя, установленныое по умолчанию.
      SetAge(age_); // Пытаемся поменять возраст, установленный по умолчанию.
    end;
    
    procedure Println;
    begin
      Writeln('Имя: ', name, '; Возраст: ', age);
    end;
  end;
 
var
  P1, P2, P3: TPerson;
 
begin
  P1 := TPerson.Create('', 21); // Тут неправильное имя.
  P1.Println();
  
  Writeln();
  P2 := TPerson.Create('Петя', 0); // Тут неправильный возраст.
  P2.Println();
  
  Writeln();
  P3 := TPerson.Create('Андрей', 21); // Тут все хорошо.
  P3.Println();
end.

{
 Пример использования свойств. Свойство - это абстракция над парой методов GetSomething и SetSomething
 (например, SetAge, GetAge).
 Оно больше похоже на переменную, но фактически это не так - это не переменная. Это пара методов,
 которые получают значение некоторого поля (которое описано в разделе private) и меняют его (если
 требуется). Синтаксис свойств таков:
   property ИмяСвойства: T read ИмяМетодаДляПолученияЗначенияПоля write ИмяМетодаДляИзмененияЗначенияПоля.
 Где T - тип свойства.
 Хотя, можно вместо одного (илли даже двух методов) писать просто значение того поля, которое надо
 получать (читать) и менять (если не требуется производить каких-то дополнительных действий - проверок
 верности записываемого значения, например).
 Пусть есть поле _x и свойство X (предполагается наличие методов GetX и SetX), то валидны следующи
 определения свойства X:
   property X: T read GetX write SetX;
   property X: T read GetX write _x;
   property X: T read _x write SetX;
   property X: T read _x write _x;
 Либо (если изменять значение _x не следует):
   property X: T read GetX;
   property X: T read _x;
 Свойства чаще всего описываются имменно в разделе public.
}
type
  TCircle = class // Класс окружности
  private
    _radius: integer;
    
    procedure SetRadius(value: integer);
    begin
      if value >= 0 then
        _radius := value
      else
        Writeln('Ошибочка вышла - радиус не может быть отрицательным.');
    end;
    
  public
    { Свойсво должно быть видно вне класса везде. }
    property Radius: integer read _radius write SetRadius; // Радиус окружности.
    
    constructor Create(radius_: integer);
    begin
      radius := 1;
      SetRadius(radius_);
    end;
    
    procedure Println;
    begin
      Writeln('Радиус = ', _radius); // Правильно в самом классе обращаться именно к полям.
    end;
  end;
 
var
  Circle: TCircle;
 
begin
  Circle := TCircle.Create(10);
  Circle.Println();
end.

{
  Пример наследования классов фигур, переопределение методов.
  
  Переопределение метода Method базового класса TBase в классе потомке TDescendant означает его
  полная перезапись во всех классах, находящихся выше по иерархии наследования чем TDescendant
  и в самом TDescendant.
}
type
  TFigure = class // Класс фигуры
    procedure Println;
    begin
      Writeln('Это TFigure'); // Напоминаю, что Println - виден везде.
    end;
  end;
  
  TBox = class(TFigure) // Класс куба
    { ереопределяем метод базового класса TFigure - просто объявляем такой же метод, только с другим
      содержимым. }
    procedure Println; // Напоминаю, что Println - виден везде.
    begin
      Writeln('Это TBox');
    end;
  end;
  
  TSphere = class(TFigure) // Класс сферы
    { Переопределяем метод базового класса TFigure - просто объявляем такой же метод, только с другим
      содержимым. }
    procedure Println; // Напоминаю, что Println - виден везде.
    begin
      Writeln('Это TSphere');
    end;
  end;
 
var
  Figure: TFigure;
  Box: TBox;
  Sphere: TSphere;
 
begin
  Figure := TFigure.Create();
  Figure.Println(); // Выведет: Это TFigure
  
  Box := TBox.Create();
  Box.Println(); // Выведет: Это TBox
  
  Sphere := TSphere.Create();
  Sphere.Println(); // Выведет: Это TSphere
  
  Figure := TSphere.Create();
  Figure.Println(); // Так как метод Println переопределен, то выведет: Это TSphere
end.

type
  // описание класса звена
  TypeNode = class
    value: integer;
    Next: TypeNode;
 
    constructor Create(v: integer);
    begin
      Value:=v;
      Next:=nil;
    end;
    
    destructor Destroy;
    begin
    
    end;
 
    procedure Print;
    begin
      writeln('Value: ', Value);
    end;
  end;
 
type
  // описание класса списка
  TypeList = class
    List: TypeNode;
 
    constructor Create;
    begin
      // Создание заголовочного узла списка.
      // Какое значение он будет содержать, неважно.
      // Целью создания заголовочного узла - написание более простых программ
      // работы со списком.
      List:=TypeNode.Create(0);
    end;
    
    destructor Destroy;
    var
      x,y: TypeNode;
    begin
      // удаление списка вместе с заголовочным узлом
      x:=List;
      while x<>nil do
      begin
        y:=x.Next;
        x.Destroy;
        x:=y;
      end;
    end;
    
    procedure AddEnd(value: integer);
    var
      x: TypeNode;
    begin
      x:=List;
      while x.Next<>nil do
        x:=x.Next;
      x.Next:=TypeNode.Create(value);
    end;
    
    procedure Delete(n: integer);
    var
      x,y: TypeNode;
      i: integer;
    begin
      x:=List;
      i:=0;
      while (x.Next<>nil)and(i<>n) do
      begin
        x:=x.Next;
        Inc(i);
      end;
      y:=x.Next;
      x.Next:=y.Next;
      y.Destroy;
    end;
 
    procedure Print;
    var
      x: TypeNode;
      i: integer;
    begin
      x:=List.Next;
      i:=0;
      while x<>nil do
      begin
        write('№', i, ': '); x.Print;
        x:=x.Next;
        Inc(i);
      end;
    end;
  end;
 
var
  List: TypeList;
  i: integer;
begin
  // создание списка
  List:=TypeList.Create;
  for i:=1 to 5 do
    List.AddEnd(i);  // добавление элемента в конец списка
 
  // вывод списка
  writeln('Исходный список:');
  List.Print;
  writeln('---------');
  
  // удаление элемента, например под номером 3 (отсчёт с нуля)
  List.Delete(3);
  
  // вывод списка
  writeln('Список после удаления третьего элемента:');
  List.Print;
  writeln('---------');
 
  // уничтожение списка
  List.Destroy;
end.