Полезные коды для PascalABC.NET

// Если IP несколько 
begin
var i :integer;
for i:=0 to System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName).AddressList.Length-1 do
writeln(System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName).AddressList[i].ToString);
end.

{$reference System.Drawing.dll}
uses System.Drawing,System.Reflection;
 
function Color.isEquivalence(Col: Color): boolean;
begin
  result := (Col.A = self.A) and (col.R = self.R) and (col.G = self.G) and (col.B = self.B);
  //result := self.ToArgb() = Col.ToArgb()
end;
 
function Color.GetEquivalence(): Color;
begin
  var prop := typeof(Color).GetProperties();
  for var i := 0 to prop.Length - 1 do
    if prop[i].PropertyType = typeof(Color) then
    begin
      var mem := prop[i].GetMethod;
      var cur := Color(mem.Invoke(mem, nil));
      if self.isEquivalence(cur) then
      begin
        result := cur;
        exit;
      end;
    end;
  result := self;
end;
 
begin
  var col := Color.FromArgb(255, 0, 128, 0);
  Writeln(col.Name);
  Write(col.GetEquivalence().Name);  
end.

USES graphabc;
var
  i, k, z: integer;
 
procedure ul(x, y: integer);
begin
  setpenwidth(2);
  setpencolor(clblack);
  circle(x, y, 50);floodfill(x, y, clgold);
  circle(x, y, 35);floodfill(x, y, clblue);
  circle(x, y, 20);floodfill(x, y, RgB(random(255), random(255), random(255)));
  circle(x + 90, y - 10, 20);floodfill(x + 90, y - 10, clgreen);
  circle(x + 80, y - 15, 3);floodfill(x + 80, y - 15, clblack);
  circle(x + 100, y - 15, 3);floodfill(x + 100, y - 15, clblack);
  line(x + 85, y, x + 95, y);
  line(x + 90, y - 30, x + 105, y - 45);
  line(x + 90, y - 30, x + 75, y - 45);
  line(x + 5, y + 50, x + 90, y + 10);
  line(x + 45, y + 50, x + 90, y + 10);
  line(x + 5, y + 50, x + 45, y + 50);
  floodfill(x + 34, y + 47, clgreen);
end;
 
procedure obl(x, y: integer);
begin
  setbrushcolor(clblue);
  circle(x + 25 + random(5), y + random(5), 15 + random(5));
  circle(x + 52 + random(5), y + random(5), 19 + random(5));
  circle(x + 75 + random(5), y + random(5), 15 + random(5));
end;
 
begin
  lockdrawing;
  while true do
  begin
    z := 400;
    for i := 100 to 500 do
    begin
      clearwindow;
      obl(40, 30);
      obl(170, 60);
      obl(350, 50);
      obl(455, 35);
      ul(i, z);
      ul(i - 70, 300);
      floodfill(100, 200, clLime);
      redraw;
      sleep(10);
    end;
    if i = 500 then 
      i := 1;
  end;
end.

function FindDir(): string;
begin
  Result := System.IO.Directory.GetDirectoryRoot('\WINDOWS\System32\shutdown.exe');
end;
 
begin
  Exec(FindDir + 'WINDOWS\System32\shutdown.exe', '-s');// -s выключение компьютера, -f выход из системы,-r перезагрузка
end.

Exec(FindDir + 'WINDOWS\System32\shutdown.exe', '-s');

program ugly_pixels;
 
uses GraphABC;
 
var
  
  //Переменная рисунка
  pic: Picture;
  
  //Коэфициент увеличения/уменьшения изображения
  resize: Integer;
  
  //Переменные, необходимые для отцентровки изображения
  cx, cy: Integer;
 
begin
  
  //Задаем заголовок окна (не обязательно)
  GraphABC.SetWindowCaption('Ugly pixels!');
  
  //Создаем рисунок
  //В нашем случае, это рисунок "pic.png" с размером 16x16 пикселей
  //Файл лежит в одной папке с программой
  pic := Picture.Create('pic.png');
  
  //Увеличение окна до максимального размера
  GraphABC.MaximizeWindow;
  
  //Получение коэфициента увеличения/уменьшения изображения
  if pic.GetWidth > pic.GetHeight then
    resize := GraphABC.WindowWidth div pic.GetWidth
  else
    resize := GraphABC.WindowHeight div pic.GetHeight;
  
  //Увеличиваем изображение
  pic.SetSize(resize * pic.GetWidth, resize * pic.GetHeight);
  
  //Установка центровочных координат
  cx := (GraphABC.WindowWidth - pic.GetWidth) div 2;
  cy := (GraphABC.WindowHeight - pic.GetHeight) div 2;
  
  //Отрисовка полученного изображения
  pic.Draw(cx, cy);
  
end.

program clear_pixels;
 
uses GraphABC;
 
var
  
  //Переменная рисунка
  original_picture: Picture;
  
  //Динамический двумерный массив цветов пикселей
  array_of_colors: array[,] of Color;
  
  //Коэфициент увеличения/уменьшения изображения
  resize: Integer;
  
  //Переменные, необходимые для отцентровки изображения
 cx, cy: Integer;
 
begin
 
  //Задаем заголовок окна (не обязательно)
  GraphABC.SetWindowCaption('Clear pixels!');
 
  //Создаем рисунок
  //В нашем случае, это рисунок "pic.png" с размером 16x16 пикселей
  //Файл лежит в одной папке с программой
  original_picture := Picture.Create('pic.png');
  
  //Устанавливаем размер массива цветов пикселей, зависящий от ширины и высоты исходного изображения
  array_of_colors := new Color[original_picture.GetWidth, original_picture.GetHeight];
  
  //Заполняем массив цветами из оригинального рисунка
  //Номер первого элемента динамического массива всегда равен [0, 0]
  //Поэтому массив array_of colors будет иметь диапозон array[0..15, 0..15], а не [1..16, 1..16]
  for var x := 0 to original_picture.GetWidth - 1 do
    for var y := 0 to original_picture.GetHeight - 1 do
    begin
      array_of_colors[x, y] := original_picture.GetPixel(x, y);
    end;
 
  //Увеличение окна до максимального размера
  GraphABC.MaximizeWindow;
  
  //Получение коэфициента увеличения/уменьшения изображения
  if original_picture.GetWidth > original_picture.GetHeight then
    resize := GraphABC.WindowWidth div original_picture.GetWidth
  else
    resize := GraphABC.WindowHeight div original_picture.GetHeight;
  
  //Установка центровочных координат
  cx := (GraphABC.WindowWidth - resize * original_picture.GetWidth) div 2;
  cy := (GraphABC.WindowHeight - resize * original_picture.GetHeight) div 2;
  
  //Отрисовка полученного изображения
  //Каждый квадрат равен одному пикселю из оригинального изображения
  for var x := 0 to original_picture.GetWidth - 1 do
    for var y := 0 to original_picture.GetHeight - 1 do
    begin
      GraphABC.SetPenColor(array_of_colors[x, y]);
      GraphABC.SetBrushColor(array_of_colors[x, y]);
      GraphABC.Rectangle(cx + resize * x, cy + resize * y, cx + resize * (x + 1), cy + resize * (y + 1));
      GraphABC.FillRectangle(cx + resize * x, cy + resize * y, cx + resize * (x + 1), cy + resize * (y + 1));
    end;
  
end.

{$apptype windows}
{$reference 'System.speech.dll'}
uses
 System.Speech;// System.Windows.Forms, System.Drawing;
 
var
 sysnz: System.Speech.Synthesis.SpeechSynthesizer;
begin
sysnz := new System.Speech.Synthesis.SpeechSynthesizer();
sysnz.Rate :=2 ;//скорость
sysnz.Volume := 100;//громкость
sysnz.SelectVoice(sysnz.GetInstalledVoices.Item[0].VoiceInfo.Name.tostring);//0 русский 1 английский стандартные 2 языковых движка виндовс
sysnz.Speak('Текст на языке движка');
 
end.

const
  Path1 = 'C:\Ilya\AlgoРитмы\Файл1.txt';
  Path2 = 'C:\Ilya\AlgoРитмы\Файл2.txt';
 
var
  F1, F2: Text;
  L: List<integer>;
  N: integer;
  MaxL: integer;
 
begin
  Assign(F1, Path1);
  Assign(F2, Path2);
  Reset(F1);
  Rewrite(F2);
  
  L := new List<integer>();
  
  while not Eof(F1) do
  begin
    Readln(F1, N);
    L.Add(N);
  end;
  
  var i := 0;
  N := L[0];
  while i < L.Count do
  begin
    var len := 1;
    while (i < L.Count) and (L[i] = N) do
    begin
      Inc(len);
      Inc(i);
    end;
    if len > MaxL then
      MaxL := len;
    if i < L.Count then
      N := L[i];
  end;
  
  Write(F2, MaxL);
  Close(F1);
  Close(F2);
end.

{Переведено с C#.}
uses System.Reflection;
 
type
  User = class
  private 
    _Name: string;
    _Age: integer;
  public 
    property Name: string read _Name write _Name;
    property Age: integer read _Age write _Age;
    
    constructor ();begin end;
    
    procedure Display() := WritelnFormat('Имя: {0} Возраст: {1}', Name, Age);
    
    function Payment(hours, perhour: integer) := hours * perhour;
  end;
 
begin
  var MyType := TypeOf(User);
  var MyType2 := System.Type.GetType('Рефлексия - пример 1.User', false, true);
  
  Writeln(MyType.ToString());
  Writeln(MyType2.ToString());
  Readln();
end.

{Переведено с C#.}
uses System.Reflection;
 
type
  User = class
  private 
    _Name: string;
    _Age: integer;
  public 
    property Name: string read _Name write _Name;
    property Age: integer read _Age write _Age;
    
    constructor ();begin end;
    
    procedure Display() := WritelnFormat('Имя: {0} Возраст: {1}', Name, Age);
    
    function Payment(hours, perhour: integer) := hours * perhour;
  end;
 
begin
  var Man := new User();
  Man.Name := 'Tom';
  Man.Age := 30;
  
  var MyType := Man.GetType();
  
  foreach var m in MyType.GetMembers() do
    System.Console.WriteLine(Format('{0} {1} {2}', m.DeclaringType.Name, m.MemberType, m.Name));
 
  Readln();
end.

{Переведено с C#.}
uses System.Reflection;
 
type
  User = class
  private 
    _Name: string;
    _Age: integer;
  public 
    property Name: string read _Name write _Name;
    property Age: integer read _Age write _Age;
    
    constructor ();begin end;
    
    procedure Display() := WritelnFormat('Имя: {0} Возраст: {1}', Name, Age);
    
    function Payment(hours, perhour: integer) := hours * perhour;
  end;
 
begin
  var Man := new User();
  Man.Name := 'Tom';
  Man.Age := 30;
  
  var MyType := Man.GetType();
  
  foreach var m in MyType.GetMethods() do
  begin
    var modifier := '';
    
    if m.IsStatic then modifier += 'static ';
    if m.IsVirtual then modifier += 'virtual';
    
    WriteFormat('{0} {1} {2}(', modifier, m.ReturnType.Name, m.Name);
    
    var parameters := m.GetParameters();
    
    for var i := 0 to Length(parameters) - 1 do
    begin
      WriteFormat('{0} {1}', parameters[i].ParameterType.Name, parameters[i].Name);
      if i + 1 < parameters.Length then Write(', ');
    end;
    Writeln(')');
  end;
  
  Readln();
end.

{Переведено с C#.}
procedure DrawLine();
begin
  while true do
  begin
    System.Console.Write('X: ');
    var x := System.Convert.ToInt32(System.Console.ReadLine());
    System.Console.Write('Y: ');
    var y := System.Convert.ToInt32(System.Console.ReadLine());
    System.Console.Write('X2: ');
    var x1 := System.Convert.ToInt32(System.Console.ReadLine());
    System.Console.Write('Y2: ');
    var y1 := System.Convert.ToInt32(System.Console.ReadLine());
    
    var l := Max(Abs(x1 - x), Abs(y1 - y));
    var incX := (x1 - x) / l;
    var incY := (y1 - y) / l;
    
    var cx := x * 1.0;
    var cy := y * 1.0;
    
    System.Console.BackgroundColor := System.ConsoleColor.Green; // Цвет линии.
    
    while not ((cy = y1) and (cx = x1)) do
    begin
      System.Console.SetCursorPosition(System.Convert.ToInt32(cx), System.Convert.ToInt32(cy));
      System.Console.Write(' ');
      cx += incX;
      cy += incY;
    end;
    
    System.Console.ReadKey();
    System.Console.BackgroundColor := System.ConsoleColor.Black;
    System.Console.Clear();
  end;
end;
 
begin
  System.Console.Title := 'Console';
  DrawLine();
end.

uses GraphABC, ABCObjects;
const
  Border = 100;
 
type
  Circles = List<CircleABC>; // Описываю тип списка, параметизированного типом CircleABC. 
 
var
  Obj: CircleABC;
  DX, DY: integer;
  Move: boolean;
  Numbers: Circles;
 
function IsEqual(L2: Circles): boolean; // Проверка на корректность последовательности. Узнаем в правильном ли порядке расставлены в ней цифры.
begin
  Result := true;
  for var i := 0 to L2.Count - 1 do
    if Numbers[i].Number <> L2[i].Number then
    begin
      Result := false;
      break;
    end;
end;
 
procedure MouseUp(x, y, mb: integer); // Необходима для перемещения кружочков.
begin
  if mb = 1 then
  begin
    Move := false;
    if IsEqual(Numbers.OrderBy(x -> x.Position.X).ToList()) then
    begin
      SetWindowIsFixedSize(true);
      var A := new RectangleABC(0, 0, Window.Width, Window.Height, clYellow);
      A.Text := 'Вы расставили все числа по местам.';
      Sleep(4000);
      Halt();
    end;
  end;
end;
 
procedure MouseMove(x, y, mb: integer); // Необходима для перемещения кружочков.
begin
  if mb = 1 then
    if not Move then
    begin
      for var i := 0 to Numbers.Count - 1 do
        if Numbers[i].PtInside(x, y) then
        begin
          DX := x - Numbers[i].Position.X;
          DY := y - Numbers[i].Position.Y;
          Obj := Numbers[i];
          
          Move := true;
          break;
        end;
    end
    else
      Obj.Position := new Point(x - Dx, y - Dy);
end;
 
begin
  var W := Window.Width - 2 * Border;
  var H := Window.Height - 2 * Border;
  
  Numbers := new Circles();
  for var i := 0 to 6 do
  begin
    Numbers.Add(new CircleABC(Border + Random(W), Border + Random(H), 30, clRandom()));
    Numbers.Last().Number := i;
  end;
  
  Move := false;
  OnMouseMove := MouseMove;
  OnMouseUp := MouseUp;
end.

uses
  System.Diagnostics;
 
begin
    var shutdown := new Process;
    shutdown.StartInfo.FileName := System.Environment.SystemDirectory + '\shutdown.exe';
    shutdown.StartInfo.Arguments := '/s /t 0';
    shutdown.StartInfo.WindowStyle := ProcessWindowStyle.Hidden;
    shutdown.Start();
    shutdown.WaitForExit;
end.

function mciSendString(command: string; buffer: StringBuilder; bufferSize: integer; hwndCallback: System.IntPtr): integer;
  External 'winmm.dll' name 'mciSendString';
  
function open(letter: char): boolean;
begin
  if mciSendString('open ' + letter + ': type CDAudio alias drive' + letter, nil, 0, System.IntPtr.Zero) + mciSendString('set drive' + letter + ' door open', nil, 0, System.IntPtr.Zero) = 0 then Result := true else Result := false;
end;
 
function close(letter: char): boolean;
begin
  if mciSendString('open ' + letter + ': type CDAudio alias drive' + letter, nil, 0, System.IntPtr.Zero) +  mciSendString('set drive' + letter + ' door closed', nil, 0, System.IntPtr.Zero) = 0 then Result := true else Result := false;
end;
 
begin
  Writeln(open('E'));
  sleep(1500);
  Writeln(close('E'));
end.

uses GraphABC;
type
  TTurtle = class
  private 
    _X, _Y: real;
    _Step: real;
    _MustDraw: boolean;
    _Angle: real;
    
    procedure TurtleLine(x1, y1, x2, y2: real);
    begin
      if _MustDraw then
        Line(Round(x1), Round(y1), Round(x2), Round(y2));
    end;
  
  public 
    property X: real read _X; // X координата черепашки
    property Y: real read _Y; // Y координата черепашки
    property Step: real read _Step write _Step; // Длина одного шага
    property MustDraw: boolean read _MustDraw write _MustDraw; // Рисовать ли отрезки
    property Angle: real read _Angle; // Угол поворота
    
    constructor(a: real := 90; s: real := 50);
    begin
      _Angle := a;
      _X := Window.Width / 2;
      _Y := Window.Height / 2;
      Step := s;
      MustDraw := true;
    end;
    
    procedure DecAngle(rotation: real) := _Angle -= rotation;
    
    procedure IncAngle(rotation: real) := _Angle += rotation;
    
    procedure MoveForward(); // Выполняет смещение вперед.
    begin
      var ang := DegToRad(_Angle);
      var (x1, y1) := (_X + _Step * Cos(ang), _Y + _Step * Sin(ang));
      TurtleLine(_X, _Y, x1, y1);
      (_X, _Y) := (x1, y1);
    end;
    
    procedure MoveBackward(); // Выполняет смещение назад.
    begin
      var ang := DegToRad(_Angle);
      var (x1, y1) := (_X - _Step * Cos(ang), _Y - _Step * Sin(ang));
      TurtleLine(_X, _Y, x1, y1);
      (_X, _Y) := (x1, y1);
    end;
    
    procedure MoveTo(cx, cy: real); // Перемещается в точку с координатами cx, cy.
    begin
      (_X, _Y) := (cx, cy);
    end;
    
    function ToString() := Format('Motion vector: ({0}, {1})', _X, _Y);
    
    procedure Print() := Write(ToString());
    
    procedure Println() := Writeln(ToString());
  end;
 
begin
  var T := new TTurtle(45);
  T.MoveForward();
  T.DecAngle(45);
  T.MoveForward();
end.

type
  OperationTypeEnum = (Add, Remove, Rewrite);
  TDynamicArrayOnChangeEventArgs = class // Класс аргументов события изменения списка
  private 
    _OperationType: OperationTypeEnum;
    _Index: integer;
  
  public
    property OperationType: OperationTypeEnum read _OperationType; // Тип операции
    property Index: integer read _Index; // Индекс изменяемого элемента
    
    constructor(opT: OperationTypeEnum; i: integer);
    begin
      _OperationType := opT;
      _Index := i;
    end;
  end;
  
type
  TOnChangeFunc = procedure(sender: object; eventArgs: TDynamicArrayOnChangeEventArgs); // Тип функции-обработчика события
  TDynamicArray = class
  public
    event OnChange: TOnChangeFunc; // Событие изменения списка
  
  private 
    _A: array of integer;
    _Count, _Capacity: integer;
    
    procedure TryOnChange(opT: OperationTypeEnum; i: integer); // Попытка вызова процедуры, соответствующей событию.
    begin
      if OnChange <> nil then
        OnChange(self, new TDynamicArrayOnChangeEventArgs(opT, i));
    end;
    
    procedure TryRaiseIndexOutOfRangeException(i: integer);
    begin
      if (i >= _Count) or (i < 0) then
        raise new System.IndexOutOfRangeException();
    end;
    
    procedure TryRaiseZeroCountException();
    begin
      if _Count = 0 then
        raise new Exception('Список пуст.');
    end;
    
    function GetItem(i: integer): integer;
    begin
      TryRaiseIndexOutOfRangeException(i);
      Result := _A[i];
    end;
    
    procedure SetItem(i: integer; v: integer);
    begin
      TryRaiseIndexOutOfRangeException(i);
      _A[i] := v;
      TryOnChange(OperationTypeEnum.Rewrite, i);
    end;
    
    procedure TryResize();
    begin
      Inc(_Count);
      if _Count > _Capacity then
      begin
        _Capacity *= 2;
        SetLength(_A, _Capacity);
      end;
    end;
  
  public
    property Items[i: integer]: integer read GetItem write SetItem;default;
    property Count: integer read _Count;
    property Capacity: integer read _Capacity;
    
    constructor();
    begin
      _Capacity := 2;
      SetLength(_A, _Capacity);
    end;
    
    procedure AddLast(v: integer); // Выполняет добавление элемента в конец списка.
    begin
      TryResize();
      _A[Pred(_Count)] := v;
      TryOnChange(OperationTypeEnum.Add, Pred(_Count));
    end;
    
    procedure RemoveLast(); // Выполняет удаление последнего элемента списка.
    begin
      TryRaiseZeroCountException();
      Dec(_Count);
      TryOnChange(OperationTypeEnum.Remove, Pred(_Count));
    end;
    
    procedure AddFirst(v: integer); // Выполняет добавление элемента в начало списка.
    begin
      TryResize();
      for var i := Pred(_Count) downto 1 do
        _A[i] := _A[Pred(i)];
      _A[0] := v;
      TryOnChange(OperationTypeEnum.Add, 0);
    end;
    
    procedure RemoveFirst(); // Выполняет удаление первого элемента списка.
    begin
      TryRaiseZeroCountException();
      for var i := 0 to _Count - 2 do
        _A[i] := _A[Succ(i)];
      TryOnChange(OperationTypeEnum.Remove, 0);
    end;
    
    function Seach(v1: integer): integer; // Выполняет поиск элемента по списку и возвращает его индекс (либо выбрасывает исключение при его отсутствии).
    begin
      Result := 0;
      while (Result < Pred(_Count)) and (_A[Result] <> v1) do Inc(Result);
      TryRaiseIndexOutOfRangeException(Result);
    end;
    
    {Убрал код остальных методов для краткости кода. Полный код можно найти здесь: https://ru.wikibooks.org/wiki/Книга_программиста/Структуры_данных_в_PascalABC.Net}
  end;
 
procedure EventHandler(sender: object; eventArgs: TDynamicArrayOnChangeEventArgs); // Обработчик события
begin
  case eventArgs.OperationType of
    OperationTypeEnum.Add: WritelnFormat('Элемент добавлен в позицию {0}.', eventArgs.Index);
    OperationTypeEnum.Remove: WritelnFormat('Элемент удален из позиции {0}.', eventArgs.Index);
    OperationTypeEnum.Rewrite: WritelnFormat('Перезаписан {0}-ый элемент.', eventArgs.Index);
  end;
end;
 
begin
  var L := new TDynamicArray();
  L.OnChange += EventHandler;
  
  for var i := 0 to 9 do
    L += i;
  
  L.Println();
  
  for var i := 0 to 2 do
    L.RemoveLast();
 
  L.Println();
  L[1] := 54;
  L.Println();
end.

uses System;
 
begin
  WriteLn('4^0.5 = ' + Math.Pow(4, 0.5)); //Выведет 2
end.

begin
  WriteLn(Power(4,0.5));
end.

function Power(x, y: real): real := Math.Pow(x, y);