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

uses GraphABC;
begin
  SetWindowSize(800,600);
  Coordinate.Origin := Window.Center; // Координаты начала координат - в центре окна
  Coordinate.SetMathematic;           // устанавливаем обычную математическую систему координат
  line(-400,0,400,0);                 //строим оси координат
  line(0,-300,0,300);
  var a: real :=0;
 Repeat
    var r:=12*(1-cos(a));             // вычисляем значение функции
      var x:=round(r*10*Cos(a));  // переводим в "экранные"
      var y:=round(r*10*Sin(a));  // координаты и округляем. Деление на 10 позволяет уменьшить радиус
      PutPixel(x,y,ClMaroon);             // рисуем точку на графике
      a:=a+0.001
  until a>=360
end.

uses GraphABC;
begin
SetWindowSize(800,600);
Coordinate.Origin := Window.Center; // Координаты начала координат - в центре окна
Coordinate.SetMathematic; // устанавливаем обычную математическую систему координат
line(-400,0,400,0); //строим оси координат
line(0,-300,0,300);
var a: real :=0;
Repeat
var r:=10; 
var x:=round(r*10*sin(0.995*a)+50*Cos(15.075*a)); // вычисляем функцию и переводим в "экранные"
var y:=round(r*10*cos(0.995*a)+50*Sin(15.075*a)); // координаты и округляем. Деление на 10 позволяет уменьшить радиус
PutPixel(x,y,ClMaroon); // рисуем точку на графике
a:=a+0.001
until a>=45
end.

uses graphABC;
//массив цветов 
const col: array [1..10,1..14] of color=
      ((clAquamarine,     clBisque,       clBlue,                 clBurlyWood,      clChocolate,        clCornsilk,       clDarkBlue,       clDarkGray,         clDarkMagenta,    clDarkOrchid,     clDarkSeaGreen,         clDarkViolet,     clDeepSkyBlue,    clFirebrick     ),
       (clFuchsia,        clGold,         clGreen,                clHotPink,        clIvory,            clLavenderBlush,  clLightBlue,      clLightGray,        clLightPink,      clLightSkyBlue,   clLightYellow,          clLinen,          clMediumBlue,     clMediumPurple  ),
       (clMoneyGreen,     clNavy,         clMediumSpringGreen,    clMediumTurquoise,clOliveDrab,        clOrchid,         clPaleTurquoise,  clPeachPuff,        clMediumVioletRed,clRed,            clSaddleBrown,          clSeaGreen,       clSilver,         clSlateGray     ),
       (clSteelBlue,      clThistle,      clTurquoise,            clWhite,          clYellowGreen,      clAzure,          clBlack,          clBlueViolet,       clCadetBlue,      clCoral,          clCrimson,              clDarkCyan,       clDarkGreen,      clDarkOliveGreen),
       (clDarkRed,        clDarkSlateBlue,clDeepPink,             clDimGray,        clFloralWhite,      clGainsboro,      clGoldenrod,      clGreenYellow,      clIndianRed,      clKhaki,          clLawnGreen,            clLightCoral,     clLightGreen,     clLightSalmon   ),
       (clLightSlateGray, clLime,         clMagenta,              clMediumOrchid,   clMediumSeaGreen,   clPlum,           clMidnightBlue,   clMoccasin,         clOldLace,        clOrange,         clPaleGoldenrod,        clPaleVioletRed,  clPeru,           clPowderBlue    ),
       (clRosyBrown,      clSalmon,       clSeaShell,             clSkyBlue,        clSnow,             clTan,            clTomato,         clViolet,           clWhiteSmoke,     clBeige,          clBlanchedAlmond,       clBrown,          clChartreuse,     clCornflowerBlue),
       (clCyan,           clDarkGoldenrod,clDarkKhaki,            clDarkOrange,     clDarkTurquoise,    clDarkSlateGray,  clDarkSalmon,     clDodgerBlue,       clForestGreen,    clGhostWhite,     clGray,                 clHoneydew,       clIndigo,         clLavender      ),
       (clLemonChiffon,   clLightCyan,    clLightGoldenrodYellow, clLightSeaGreen,  clLightSteelBlue,   clLimeGreen,      clMaroon,         clMediumAquamarine, clMediumSlateBlue,clMistyRose,      clMintCream,            clNavajoWhite,    clOlive,          clOrangeRed     ),
       (clPaleGreen,      clPapayaWhip,   clPink,                 clPurple,         clRoyalBlue,        clSandyBrown,     clSienna,         clSlateBlue,        clSpringGreen,    clTeal,           clTransparent,          clWheat,          clYellow,         clYellow        ));
//массив названий цветов
textcol: array [1..10,1..14] of string=
      (('clAquamarine',     'clBisque        ','clBlue                 ','clBurlyWood      ','clChocolate        ','clCornsilk       ','clDarkBlue       ','clDarkGray         ','clDarkMagenta    ','clDarkOrchid     ','clDarkSeaGreen         ','clDarkViolet     ','clDeepSkyBlue    ','clFirebrick'     ),
       ('clFuchsia',        'clGold          ','clGreen                ','clHotPink        ','clIvory            ','clLavenderBlush  ','clLightBlue      ','clLightGray        ','clLightPink      ','clLightSkyBlue   ','clLightYellow          ','clLinen          ','clMediumBlue     ','clMediumPurple'  ),
       ('clMoneyGreen',     'clNavy          ','clMediumSpringGreen    ','clMediumTurquoise','clOliveDrab        ','clOrchid         ','clPaleTurquoise  ','clPeachPuff        ','clMediumVioletRed','clRed            ','clSaddleBrown          ','clSeaGreen       ','clSilver         ','clSlateGray'     ),
       ('clSteelBlue',      'clThistle       ','clTurquoise            ','clWhite          ','clYellowGreen      ','clAzure          ','clBlack          ','clBlueViolet       ','clCadetBlue      ','clCoral          ','clCrimson              ','clDarkCyan       ','clDarkGreen      ','clDarkOliveGreen'),
       ('clDarkRed',        'clDarkSlateBlue ','clDeepPink             ','clDimGray        ','clFloralWhite      ','clGainsboro      ','clGoldenrod      ','clGreenYellow      ','clIndianRed      ','clKhaki          ','clLawnGreen            ','clLightCoral     ','clLightGreen     ','clLightSalmon'   ),
       ('clLightSlateGray', 'clLime          ','clMagenta              ','clMediumOrchid   ','clMediumSeaGreen   ','clPlum           ','clMidnightBlue   ','clMoccasin         ','clOldLace        ','clOrange         ','clPaleGoldenrod        ','clPaleVioletRed  ','clPeru           ','clPowderBlue'    ),
       ('clRosyBrown',      'clSalmon        ','clSeaShell             ','clSkyBlue        ','clSnow             ','clTan            ','clTomato         ','clViolet           ','clWhiteSmoke     ','clBeige          ','clBlanchedAlmond       ','clBrown          ','clChartreuse     ','clCornflowerBlue'),
       ('clCyan',           'clDarkGoldenrod ','clDarkKhaki            ','clDarkOrange     ','clDarkTurquoise    ','clDarkSlateGray  ','clDarkSalmon     ','clDodgerBlue       ','clForestGreen    ','clGhostWhite     ','clGray                 ','clHoneydew       ','clIndigo         ','clLavender'      ),
       ('clLemonChiffon',   'clLightCyan     ','clLightGoldenrodYellow ','clLightSeaGreen  ','clLightSteelBlue   ','clLimeGreen      ','clMaroon         ','clMediumAquamarine ','clMediumSlateBlue','clMistyRose      ','clMintCream            ','clNavajoWhite    ','clOlive          ','clOrangeRed'     ),
       ('clPaleGreen',      'clPapayaWhip    ','clPink                 ','clPurple         ','clRoyalBlue        ','clSandyBrown     ','clSienna         ','clSlateBlue        ','clSpringGreen    ','clTeal           ','clTransparent          ','clWheat          ','clYellow         ','clYellow'        ));
 
//процедура рисования образца цвета
procedure usecolor(x,y: integer; c: color);
begin
setbrushcolor(c);
rectangle(x-40,y+40,x,y);
setbrushcolor(clwhite);
end;
//обработчик нажатия кнопки мыши
procedure MouseDown(x,y,mb: integer);
begin
   if (mb=1) and (x>40) and (x<600) and (y>40) and (y<440) then  //если нажата левая кнопка в заданных координатах - вывод соответствующего значения
    begin
    //стираем прошлое значение, выводим новое
    setbrushcolor(clwhite);
    rectangle(0,460,640,550);
    textout(50,460,textcol[y div 40,x div 40]);
    end;
   if (mb=2) then closewindow; //если правая кнопка - закрять окно
end;
 
begin
//размер и заголовок окна
setwindowsize(640,550);
window.Caption:='ЗНАЧЕНИЯ ЦВЕТОВ     (1рПК-выход)';
setpencolor(clwhite);
//параметры шрифта
setfontsize(40);
setfontname('Tachoma');
//в цикле рисуем образцы цвета
for var j:=1 to 10 do
  for var i:=1 to 14 do
      usecolor(i*40+40,j*40,col[j,i]);
 
OnMouseDown := MouseDown;
end.

uses graphABC;
var x,y,kx,ky: integer;
 
//процедура рисования кнопок
procedure keys;
begin
setbrushcolor(clwhite);
rectangle(200,150,240,190);
rectangle(260,150,300,190);
rectangle(200,210,240,250);
rectangle(260,210,300,250);
setpenwidth(4);
//левая верхняя стрелка
line(210,160,230,180);
line(210,160,210,170);
line(210,160,220,160);
//правая верхняя стрелка
line(290,160,270,180);
line(290,160,290,170);
line(290,160,280,160);
//левая нижняя стрелка
line(230,220,210,240);
line(210,240,210,230);
line(210,240,220,240);
//правая нижняя стрелка
line(270,220,290,240);
line(290,240,290,230);
line(280,240,290,240);
setpenwidth(1);
end;
//процедура рисования фона - бильярдный стол
procedure Fon;
begin
clearwindow;
setbrushcolor(clbrown);
rectangle(10,10,490,390);
setbrushcolor(clgreen);
rectangle(20,20,480,380);
setbrushcolor(clbrown);
keys;
end;
//обработка нажатия кнопки мыши
procedure MouseDown(x,y,mb: integer);
begin
  if mb=1 then //если левая кнопка
     begin
     if (x>200) and (x<240) and (y>150) and (y<190) then 
        begin
        kx:=-1; ky:=-1;
        end;
     if (x>260) and (x<300) and (y>150) and (y<190) then
        begin
        kx:=1; ky:=-1;
        end;
     if (x>200) and (x<240) and (y>210) and (y<250) then
        begin
        kx:=-1; ky:=1;
        end;
     if (x>260) and (x<300) and (y>210) and (y<250) then
        begin
        kx:=1; ky:=1;
        end;
     end;
end;
//процедура рисования шарика
procedure Shar(var xx,yy,kkx,kky: integer);
begin
if (xx<30) or (xx>470) then kkx:=kkx*(-1);
if (yy<30) or (yy>370) then kky:=kky*(-1);
xx:=xx+kkx;
yy:=yy+kky;
setbrushcolor(clwhite);
circle(xx,yy,10);
end;
 
begin
lockdrawing;
Fon;
//обработчик нажатия
OnMouseDown:=MouseDown;
x:=250;
y:=200;
//бесконечный цикл
repeat
Fon;
Shar(x,y,kx,ky);
sleep(10);
redraw;
until false;
end.

uses graphABC;
 
var x0:integer;
 
//процедура рисования фона
procedure Fon;
begin
clearwindow(clskyblue);
setpencolor(clgreen);
setbrushcolor(clgreen);
rectangle(0,420,900,600);
//дорога
setpencolor(clgray);
setbrushcolor(clgray);
rectangle(0,450,900,550);
setpencolor(clyellow);
setbrushcolor(clyellow);
circle(800,100,50);
end;
//процедура рисования колес
procedure Koleso(xk1,yk1,xk2,yk2,uu: integer);
var r,i:integer;
    u:real;
begin
r:=15;u:=uu;
setbrushcolor(clblack);
setpencolor(clblack);
circle(xk1,yk1,r+10);
circle(xk2,yk2,r+10);
setbrushcolor(clwhite);
circle(xk1,yk1,r);
circle(xk2,yk2,r);
for i:=1 to 4 do
    begin
    line(xk1,yk1,xk1+round(r*cos(u)),yk1-round(r*sin(u)));
    line(xk2,yk2,xk2+round(r*cos(u)),yk2-round(r*sin(u)));
    u:=u+(pi/2);
    end;
end;
//процедура рисования автомобиля
procedure Auto(x: integer);
var uu: integer;
begin
    uu:=-(x mod 100);
    setpenwidth(3);
    setpencolor(clred);
    setbrushcolor(clred);
    ellipse(x-100,350,x+100,450);
    setbrushcolor(clwhite);
    ellipse(x-90,360,x+90,440);
    setpencolor(clred);
    setbrushcolor(clred);
    rectangle(x-150,400,x+150,450);
    rectangle(x-10,355,x+10,450);
    Koleso(x-100,450,x+100,450,uu);
    redraw;
end;
//обработка нажатия клавиш
procedure KeyDown(Key: integer);
begin
  case Key of
       VK_Left: if x0>200 then x0:=x0-2;
       VK_Right: if x0<700 then x0:=x0+2;
  end;
  clearwindow;
  Fon;
  Auto(x0);
end;
 
//основная программа
begin
//запрет на рисование в рабочем окне
lockdrawing;
//размер окна
setwindowsize(900,600);
//начальное значение позиции авто
x0:=200;
Fon;
Auto(x0);
OnKeyDown:=KeyDown;
end.

{$apptype windows}
{$reference 'System.Windows.Forms.dll'}
 
uses
  System.Windows.Forms;
 
var
  MyForm: Form;
 
procedure FormClosing(sender: object; e: system.ComponentModel.CancelEventArgs);
begin
  e.Cancel := messagebox.Show('Вы действительно хотите выйти?', 'Выход', MessageboxButtons.YesNo) = dialogresult.No;
  //e.cancel - логическая переменная. Если e.cancel = true, происходит отмена закрытия формы
end;
 
begin
  MyForm := new Form;            //Создаем форму
  MyForm.Closing += FormClosing; //Ставим обработчик на событие
  application.Run(MyForm);
end.

//Подключение функции API Windows "mouse_event", которая позволяет управлять мышью
function mouse_event(dwFlags, dx, dy, dwData, dwExtraInfo: integer): boolean;
external 'user32.dll';
 
//Значения параметра dwFlags, определяющие поведение функции mouse_event
const
  MOUSEEVENTF_LEFTDOWN = 2;
  MOUSEEVENTF_LEFTUP = 4;
 
begin
  mouse_event(MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0); // Одиночный клик мышью
end.

//Подключение функции "SetCursorPos" из "неуправляемой" dll (user32.dll), которая устанавливает позицию курсора мыши в заданные коордитнаты
function SetCursorPos(x, y: integer): boolean;
external 'user32.dll';
 
begin
  SetCursorPos(10, 10); // Перемещаем мышь в координаты 10, 10
end.

function getValue(variable:string):object;
begin
try
Result:=system.Reflection.methodBase.GetCurrentMethod.ReflectedType.GetField(variable).GetValue(new object);
except on System.NullReferenceException do end;
end;

Screen.GetBounds(new Point(0,0)).Width
//аналогично для высоты

uses GraphABC;
begin
  SetWindowSize(800,600);
  Coordinate.Origin := Window.Center; // Координаты начала координат - в центре окна
  Coordinate.SetMathematic;           // устанавливаем обычную математическую систему координат
  line(-400,0,400,0);                 //строим оси координат
  line(0,-300,0,300);
 var r:=15; 
 for var i:=1 to 8 do  //цикл для рисования "вложенных" сердец
  begin
  var a: real :=0;
  Repeat
      var x:=round(r*16*sin(a)*sin(a)*sin(a)); // вычисляем функцию, переводим в "экранные"
      var y:=round(r*13*cos(a)-r*5*cos(2*a)-r*2*cos(3*a)-r*cos(4*a));  // координаты и округляем.
      PutPixel(x,y,ClMaroon);             // рисуем точку на графике
      a:=a+0.001
  until a>=180;
  dec(r,2);   //уменьшение "масштаба"
  end;
end.

program arcanoid;
uses
   graphabc;   //,ukeyb;
var
   //картинки
   pula, ball, zast, fon: Picture;
   flame: array[1..5]of Picture;//Массив пламени
   brick: array[1..3]of Picture;//Массив кирпичей
   bita: array[1..4]of Picture;//Массив бит
   bonus: array[1..3]of Picture;//Массив бонусов
   //Свойства объектов
   xs, ys, vxs, vys, ks: integer;//Свойство шарика
   ps: boolean;
   xb, yb, vb, db, nb: integer;//Свойства биты
   kir: array[1..3, 1..16, 1..10]of byte;//расположение кирпичей
   xbon, ybon, vbon: array[1..5]of integer;//свойства бонусов
   lbon: array[1..5]of boolean;
   xp, yp: array[1..10]of integer;//свойства пуль
   lp: array[1..10] of boolean;
   level, i, j, n: integer;
   f: text;
   s: string;
   xk, yk, v, kp, zadp, kk: integer;
  kUpKey, kDownKey, kLeftKey, kRightKey,kSpaceKey,kLControlKey: boolean;// Состояние клавиш Влево,Вправо,Вверх,Вниз
/// Событие - обработчик нажатия клавиатуры
procedure KeyDown(Key: integer);
begin
   case Key of
      vk_Left:  kLeftKey := True;
      vk_Right: kRightKey := True;
      vk_Up:    kUpKey := True;
      vk_Down:  kDownKey := True;
      VK_Space : kSpaceKey :=true;
      VK_LControlKey: kLControlKey:=true;
   end;
end;
/// Событие - обработчик отжатия клавиатуры
procedure KeyUp(Key: integer);
begin
   case Key of
      vk_Left:  kLeftKey := False;
      vk_Right: kRightKey := False;
      vk_Up:    kUpKey := False;
      vk_Down:  kDownKey := False;
      VK_Space : kSpaceKey :=False;
      VK_LControlKey:kLControlKey:=False;
   end;
end;
///Событие бонус
procedure createbonus;
var
   ver, k: integer;
begin
   if kir[level, xk, yk] = 0 then //кирпич совсем разбит
   begin
      ver := 1 + random(13);
      if ver <= 3 then
         for k := 1 to 5 do
            if not lbon[k] then
            begin
               lbon[k] := true;
               xbon[k] := (xk - 1) * 50 + 12;
               ybon[k] := (yk - 1) * 25;
               vbon[k] := ver;
               break;
            end;
   end;
end;
begin
 
   //задаем размеры и свойства окна
   setwindowsize(800, 600);//Задание размеров окна
   Window.Clear;//Очистка окна
   centerwindow;//Центрирование окна
   setwindowcaption('Arcanoid  группа 223, переведена мною на PascalABC.NET :) ');//Название заголовка на окне
   //загружаем отдельные картинки
   fon := Picture.Create(800, 600);//Создание переменной для фона
   fon.load('Фон.bmp');//Загрузка фона
   zast := Picture.Create(800, 600);//Создание переменной для заставки
   zast.load('Заставка.bmp');//Загрузка заставки
   ball := Picture.Create(20, 20);//Создание переменной для шарика
   ball.load('Шарик.bmp'); //загрузка шарика
   ball.Transparent := true;//Задаёт прозрачность шарика активным
   ball.TransparentColor := clWhite;//Выбор цвета который должен быть прозрачным
   pula := Picture.Create(5, 10);//Создание переменной для пули
   pula.load('Пуля.bmp');//Загрузка пули 
   pula.Transparent := true;//Задаёт прозрачность пули активны
   pula.TransparentColor := clWhite;
   OnKeyDown := KeyDown;
   OnKeyUp:=KeyUp;
   //загружаем группы картинок--------1
   for i := 1 to 5 do//----Цикл загрузки пламени
   begin
      flame[i] := Picture.Create(800, 30);//Создание переменных для пламени
      flame[i].load('Пламя' + inttostr(i) + '.bmp');//Загрузка видов пламени в массив
      flame[i].Transparent := true;//Задаем прозрачность пламени
      flame[i].TransparentColor := clWhite;//Прозрачный цвет, белый
   end;
   for i := 1 to 4 do//----Цикл загрузки бит
   begin//--------2
      bita[i] := Picture.Create(100, 15);//Создание переменной для биты 1
      bita[i].load('Бита' + inttostr(i) + '.bmp');//Загрузка бит
      bita[i].transparent := true;//биты прозрачные
      bita[i].TransparentColor := clWhite;//Прозрачный цвет, белый
   end;
   for i := 1 to 3 do//----Цикл загрузки кирпичей
   begin//----------3
      brick[i] := Picture.Create(75, 15);//Создание переменных для кирпичей
      brick[i].load('Кир' + inttostr(i) + '.bmp');//Загрузка кирпичей
      brick[i].transparent := true;//делаем кирпичи прозрачными
      brick[i].TransparentColor := clBlack;//Прозрачный цвет, черный
   end;
   for i := 1 to 3 do//----Цикл загрузки бонусов
   begin//----------4
      bonus[i] := Picture.Create(25, 25);//Создание переменных для бонусов
      bonus[i].load('бонус' + inttostr(i) + '.bmp');//Загузка бонусов
      bonus[i].transparent := true;//Прозрачность бонусов
      bonus[i].TransparentColor := clWhite;//Прозрачный цвет, белый
   end;
   //загружаем карту с кирпичами
   assign(f, 'Кладка.txt');//связка с файлом Кладка.txt
   reset(f);//чтение файла Кладка.txt
   for n := 1 to 3 do//Цикл считывания вида кирпичей
   begin
      for i := 1 to 10 do//Цикл считывания строчки(ряда) кирпичей
      begin
         readln(f, s);
         for j := 1 to 16 do//Цикл считывания столбца кирпичей
            kir[n, j, i] := strtoint(s[j]);//Запись данных кирпичей в массив
      end;
      readln(f, s);
   end;
   close(f);//Закрытие файла Кладка.txt
   //показываем заставку и ждем нажатия клавиши или определенное время
   zast.draw(0, 0);//показ заставки
   n := 0;
   repeat
      sleep(1000);
      n := n + 1;
   until (kSpaceKey)or(n = 5);//Показываем заставку пока не пройдет 5 секунд или не будет нажат пробел
    lockdrawing;
   //разделяем видимую и активную видеостраницы
      //задаем начальные параметры игры
   ps := true;//в начале шарик прилип
   ks := 5;//кол-во шариков в начале 3
   level := 1;
   vb := 2; //начальное состояние биты
   v := 3;//начальная скорость шарика
   db := 150;
   xb := 325;
   yb := 555;
   nb := 0;
   for i := 1 to 10 do
      lp[i] := false;//пули не летят
   zadp := 0;
   for i := 1 to 5 do
      lbon[i] := false;//бонусов нет
   repeat //=====================
      //показываем кадр с текущим положением всех объектов
      fon.draw(0, 0);//отображение фона
      for i := 1 to 16 do
         for j := 1 to 10 do
            if kir[level, i, j] > 0 then
               brick[kir[level, i, j]].draw((i - 1) * 50, (j - 1) * 25);//отображение кирпичей
               flame[1+random(5)].draw( 0, 570);//Отображение пламени в случаяном порядке
        //Отображение нашей биты и изменение её координат в соответствии нажатой клавиши
      ball.draw(xs, ys);//Отображения шарика в данных координатах
      bita[vb].draw(xb, yb);//Отображение нашей биты и изменение её координат в соответствии нажатой клавиши
      for i := 1 to 5 do
         if lbon[i] then
            bonus[vbon[i]].draw(xbon[i], ybon[i]);//отображ-е наши случайные бонусы?
            setbrushcolor(clblack);
      for i := 1 to 10 do//пули
         if lp[i] then
            pula.draw(xp[i], yp[i]);//пули
      redraw;
      //если шарик не прилип то передвиним шарик
      if not ps then
      begin
         xs := xs + vxs;
         ys := ys + vys;
         //если шарик задел стену или биту, отражается
         if xs <= 0 then
            vxs := v;
         if xs + 20 >= 800 then
            vxs := -v;
         if ys <= 0 then
            vys := v;
         if (xs + 10 >= xb) and (xs + 10 <= xb + db) and (ys + 20 >= yb) and (ys + 20 <= yb + 5) then
         begin
            vys := -v;
            vxs := v * nb;
         end;
         //если шарик задел кирпич, кирпич разбивается, а шарик отражается
         //с некоторой вероятностью появляется бонус
         xk := (xs + 10) div 50 + 1;
         yk := ys div 25 + 1;
         if (yk > 0) and (yk <= 10) and (xk > 0) and (xk <= 16) then
            if kir[level, xk, yk] > 0 then //кирпич сверху отразимся вниз
            begin
               vys := v;
               kir[level, xk, yk] := kir[level, xk, yk] - 1;
               createbonus;
            end;
         xk := (xs + 10) div 50 + 1;
         yk := (ys + 20) div 25 + 1;
         if (yk > 0) and (yk <= 10) and (xk > 0) and (xk <= 16) then
            if kir[level, xk, yk] > 0 then //кирпич снизу отразимся вверх
            begin
               vys := -v;
               kir[level, xk, yk] := kir[level, xk, yk] - 1;
               createbonus;
            end;
         xk := xs div 50 + 1;
         yk := (ys + 10) div 25 + 1;
         if (yk > 0) and (yk <= 10) and (xk > 0) and (xk <= 16) then
            if kir[level, xk, yk] > 0 then //кирпич слева отразимся вправо
            begin
               vxs := v;
               kir[level, xk, yk] := kir[level, xk, yk] - 1;
               createbonus;
            end;
         xk := (xs + 20) div 50 + 1;
         yk := (ys + 10) div 25 + 1;
         if (yk > 0) and (yk <= 10) and (xk > 0) and (xk <= 16) then
            if kir[level, xk, yk] > 0 then //кирпич справа отразимся влево
            begin
               vxs := -v;
               kir[level, xk, yk] := kir[level, xk, yk] - 1;
               createbonus;
            end;
         //если шарик попал в пламя, то хп уменьшается или заканчивается
         if ys >= yb + 15 then
         begin
            ps := true;
            ks := ks - 1;
            sleep(1000);
            if ks = 0 then break;
         end
      end
      //а если шарик прилип то двигаем его вместе с битой
      else
      begin
         xs := xb + db div 2 - 10;
         ys := yb - 20;
      end;
      
      //передвигаем бонусы
      for i := 1 to 5 do
         if lbon[i] then
         begin
            ybon[i] := ybon[i] + 3;
            if ybon[i] > yb + 15 then//улетел в огонь
               lbon[i] := false
            else
            if (xbon[i] + 13 >= xb) and (xbon[i] + 13 <= xb + db) and (ybon[i] + 25 >= yb) and (ybon[i] + 25 <= yb + 15) then
            begin
               lbon[i] := false;
               case vbon[i] of
                  1:
                     begin//увеличем биту
                        if vb < 3 then
                           vb := vb + 1
                        else
                           vb := 3;
                        db := 50 + vb * 50;
                     end;
                  2:
                     begin//уменшим биту
                        if vb > 1 then vb := vb - 1;
                        db := 50 + vb * 50;
                     end;
                  3:
                     begin//пулемёт
                        vb := 4;
                        db := 75;
                     end;
               end;
            end;
         end;
      //передвигаем летящие пули(если долетела до верха, исчеазает)
      for i := 1 to 10 do
         if lp[i] then
         begin
            yp[i] := yp[i] - 7;
            if yp[i] < -10 then
               lp[i] := false;
         end;
      //если пуля попала в кирпич, он и она исчезают
      for i := 1 to 10 do
         if lp[i] then
         begin
            xk := (xp[i] + 2) div 50 + 1;
            yk := yp[i] div 25 + 1;
            if (xk > 0) and (xk <= 16) and (yk > 0) and (yk <= 10) then
               if kir[level, xk, yk] > 0 then
               begin
                  lp[i] := false;
                  kir[level, xk, yk] := 0;
               end;
         end;
      //передвигаем биту, под управлением клавиш стрелок
      if (kLeftKey) then
      begin
         if xb > 0 then
         begin
            xb := xb - 5;
            
         end;
         nb := -1;
      end
      else
      if (kRightKey) then
      begin
         if xb + db < 800 then
         begin
            xb := xb + 5;
            
         end;
         nb := 1;
      end
      else
         nb := 0;
      //если нажат пробел и бита-пулемет, выпускаем пулю
      zadp := zadp + 1;
      if zadp = 10 then
      begin
         zadp := 0;
         if (kspacekey) and (vb = 4) then
         begin
            kp := 0;
            for i := 1 to 10 do
               if not lp[i] then
               begin
                  kp := kp + 1;
                  if kp = 1 then
                  begin
                     lp[i] := true;
                     xp[i] := xb + 20;
                     yp[i] := yb;
                  end
                  else
                  if kp = 2 then
                  begin
                     lp[i] := true;
                     xp[i] := xb + 55;
                     yp[i] := yb;
                     break;
                  end;
               end;
         end;
      end;
      //если нажат пробел и шарик приклеен к бите то в зависимости
      //от направления движения биты выпускаем туда шарик
      if (kspacekey) then
         if ps then
         begin
            ps := false;
            vys := -v;
            vxs := nb * v;
         end;
      //если нажаты стрелки вверх или вниз вместе с левым ctrl меняем скорость шарика в пределах допустимого
      if ((kLControlKey)) and ((kUpKey)) then  //увеличиваем скорость
      begin
         if v < 30 then
            v := v + 1;
      end;
      if ((kLControlKey)) and ((kDownKey)) then  //уменьшаем скорость
      begin
         if v > 1 then
            v := v - 1;
      end;
      //если кирпичей не осталось, увеличиваем уровень
      kk := 0;
      for i := 1 to 16 do
         for j := 1 to 10 do
            if kir[level, i, j] > 0 then
               kk := kk + 1;
               
      if kk = 0 then
      begin
         level := level + 1;
         ks := 3;
         ps := true;
      end;
     until level = 4;//==============
   //сообщаем об выгреше или проигрыше
   if ks = 0 then
   begin//проиграли
      zast.load('заст1.bmp');
      zast.draw(0, 0);
   end
   else
   begin//Выйграли
      zast.load('заст2.bmp');
      zast.draw(0, 0);
   end;
   while true do
   begin
         redraw;
   end;    
end.

{$apptype windows}
{$reference 'System.Windows.Forms.dll'}
{$reference 'System.Drawing.dll'}
 
uses
  System.Windows.Forms,
  System.Drawing;
 
var
  MainForm: Form;
  Wb: System.Windows.Forms.WebBrowser;
  Tx: PABCSystem.Text;
  
procedure DocCompl(sender: Object; e: System.Windows.Forms.WebBrowserDocumentCompletedEventArgs);
begin 
  Assign(Tx, 'page.txt'); // Связываем переменную с именем файла
  Rewrite(Tx); // Открываем файл на запись
  Write(Tx, Wb.DocumentText); // Записываем в файл html-код страницы
  Close(Tx); // Закрываем файл
end;
  
begin
  MainForm := new Form;
  MainForm.Size := new System.Drawing.Size(600, 400);
  
  Wb := new WebBrowser; // Создаём веб-браузер
  Wb.Dock := System.Windows.Forms.DockStyle.Fill; // Растягиваем на всю форму
  Wb.Navigate('https://www.cyberforum.ru/'); // Загружаем страницу
  Wb.DocumentCompleted += DocCompl; // Событие происходящее если вся страница загружена
  
  MainForm.Controls.Add(Wb);
  
  Application.EnableVisualStyles;
  
  Application.Run(MainForm);
end.

procedure runAsync(proc:procedure);
begin
var t:=new Thread(proc);
t.Start;
end;

// Игра "Крестики-Нолики"
uses
  GraphABC, Drawing;
 
var
  Field: Array [1..3, 1..3] of Integer; // Игровое поле
  CellWidth, CellHeight: Integer; // Ширина и высота одной клетки
  X_or_O: Boolean; // Ход крестиков или ноликов
 
procedure CreateWindow();// Создание и отрисовка окна
begin
  SetWindowSize(WinWidth, WinHeight);
  SetWindowCaption('Крестики - Нолики');
  // Запрещаем разворачивать окно
  GraphABC.MainForm.MaximizeBox := False;
  // Горизонтальные линии
  for var x := 1 to Round(WinWidth / CellWidth) do
    Line(0, x * CellHeight, WinWidth, x * CellHeight);
  // Вертикальные линии
  for var y := 1 to Round(WinWidth / CellHeight) do
    Line(y * CellWidth, 0, y * CellWidth, WinHeight);
end;
 
procedure Win();// Победа
begin
  SetWindowCaption('Крестики выиграли!');
  LockDrawing();
end;
 
procedure Lose();// Поражение
begin
  SetWindowCaption('Нолики выиграли!');
  LockDrawing();
end;
 
procedure Check();// Проверка на выигрыш
begin
  // Выигрышные положения крестиков (1)
  if (Field[1, 1]) and (Field[2, 1]) and (Field[3, 1]) = 1 then
    Win();
  if (Field[1, 2]) and (Field[2, 2]) and (Field[3, 2]) = 1 then
    Win();
  if (Field[1, 3]) and (Field[2, 3]) and (Field[3, 3]) = 1 then
    Win();
  if (Field[1, 1]) and (Field[1, 2]) and (Field[1, 3]) = 1 then
    Win();
  if (Field[2, 1]) and (Field[2, 2]) and (Field[2, 3]) = 1 then
    Win();
  if (Field[3, 1]) and (Field[3, 2]) and (Field[3, 3]) = 1 then
    Win();
  if (Field[1, 1]) and (Field[2, 2]) and (Field[3, 3]) = 1 then
    Win();
  if (Field[3, 1]) and (Field[2, 2]) and (Field[1, 3]) = 1 then
    Win();
  // Выигрышные положения ноликов (2)
  if (Field[1, 1]) and (Field[2, 1]) and (Field[3, 1]) = 2 then
    Lose();
  if (Field[1, 2]) and (Field[2, 2]) and (Field[3, 2]) = 2 then
    Lose();
  if (Field[1, 3]) and (Field[2, 3]) and (Field[3, 3]) = 2 then
    Lose();
  if (Field[1, 1]) and (Field[1, 2]) and (Field[1, 3]) = 2 then
    Lose();
  if (Field[2, 1]) and (Field[2, 2]) and (Field[2, 3]) = 2 then
    Lose();
  if (Field[3, 1]) and (Field[3, 2]) and (Field[3, 3]) = 2 then
    Lose();
  if (Field[1, 1]) and (Field[2, 2]) and (Field[3, 3]) = 2 then
    Lose();
  if (Field[3, 1]) and (Field[2, 2]) and (Field[1, 3]) = 2 then
    Lose();
end;
 
procedure MoveO();// Ход ноликов
var
  r, r1: Integer;
 
begin
  // Ставим нолик в случайную клетку
  repeat
    r := Random(1, 3);
    r1 := Random(1, 3);
  until Field[r, r1] = 0;
  Field[r, r1] := 2;
  DrawO(r, r1);
  Check();
end;
 
procedure MouseDown(x, y, mb: Integer);// Обрабатываем нажатия
begin
  // Если нажата первая клетка и она пустая (в массиве 0)
  if (x <= CellWidth) and (y <= CellHeight) and (Field[1, 1] = 0) then
  begin
    Field[1, 1] := 1; // Заполняем клетку
    DrawX(1, 1); // Рисуем фигуру
    Check(); // Делаем проверку
    MoveO(); // Ходят нолики
  end;
  // 2-ая клетка
  if (x <= CellWidth * 2) and (y <= CellHeight) and (x > CellWidth) and (Field[2, 1] = 0) then
  begin
    Field[2, 1] := 1;
    DrawX(2, 1);
    Check();
    MoveO();
  end;
  // 3-я клетка
  if (x <= CellWidth * 3) and (y <= CellHeight) and (x > CellWidth * 2) and (Field[3, 1] = 0) then
  begin
    Field[3, 1] := 1;
    DrawX(3, 1);
    Check();
    MoveO();
  end;
  // 4-ая клетка
  if (x <= CellWidth) and (y <= CellHeight * 2) and (y > CellHeight) and (Field[1, 2] = 0) then
  begin
    Field[1, 2] := 1;
    DrawX(1, 2);
    Check();
    MoveO();
  end;
  // 5-ая клетка
  if (x <= CellWidth * 2) and (y <= CellHeight * 2) and (x > CellWidth) and (y > CellHeight) and (Field[2, 2] = 0) then
  begin
    Field[2, 2] := 1;
    DrawX(2, 2);
    Check();
    MoveO();
  end;
  // 6-ая клетка
  if (x <= CellWidth * 3) and (y <= CellHeight * 2) and (x > CellWidth * 2) and (y > CellHeight) and (Field[3, 2] = 0) then
  begin
    Field[3, 2] := 1;
    DrawX(3, 2);
    Check();
    MoveO();
  end;
  // 7-ая клетка
  if (x <= CellWidth) and (y > CellHeight * 2) and (Field[1, 3] = 0) then
  begin
    Field[1, 3] := 1;
    DrawX(1, 3);
    Check();
    MoveO();
  end;
  // 8-ая клетка
  if (x <= CellWidth * 2) and (y > CellHeight * 2) and (x > CellWidth) and (Field[2, 3] = 0) then
  begin
    Field[2, 3] := 1;
    DrawX(2, 3);
    Check();
    MoveO();
  end;
  // 9-ая клетка
  if (x <= CellWidth * 3) and (y > CellHeight * 2) and (x > CellWidth * 2) and (Field[3, 3] = 0) then
  begin
    Field[3, 3] := 1;
    DrawX(3, 3);
    Check();
    MoveO();
  end;
end;
 
begin
  CellWidth := Round(WinWidth / 3); // Ширина одной клетки
  CellHeight := Round(WinHeight / 3); // Высота одной клетки
  
  CreateWindow; // Создаём окно
  SetPenWidth(10); // Устанавливаем толщину крестиков
  
  OnMouseDown := MouseDown; // Обрабатываем нажатия мыши
end.

// Модуль для рисования фигур
unit Drawing;
 
interface
 
uses
  GraphABC;
 
const
  WinWidth = 300; // Ширина окна
  WinHeight = 300; // Высота окна
  PenW = 10; // Толщина фигур
  RadO = 40; // Радиус ноликов 
 
procedure DrawX(x, y: Integer);// Рисование крестиков
procedure DrawO(x, y: Integer);// Рисование ноликов
 
implementation
 
procedure DrawX();// Рисование крестиков (x, y - значения матрицы)
begin
  var CellWidth := Round(WinWidth / 3); // Ширина одной клетки
  var CellHeight := Round(WinHeight / 3); // Высота одной клетки
  SetPenColor(clRed);// Крестики красные
  // Если значения 1, 1 (первая клетка)
  if (x = 1) and (y = 1) then
  begin
    Line(0 + PenW, 0 + PenW, CellWidth - PenW, CellHeight - PenW);
    Line(CellWidth - PenW, 0 + PenW, 0 + PenW, CellHeight - PenW);
  end;
  // 2, 1 (2-ая клетка)
  if (x = 2) and (y = 1) then
  begin
    Line(CellWidth + PenW, 0 + PenW, CellWidth * 2 - PenW, CellHeight - PenW);
    Line(CellWidth * 2 - PenW, 0 + PenW, CellWidth + PenW, CellHeight - PenW);
  end;
  // 3, 1 (3-я клетка)
  if (x = 3) and (y = 1) then
  begin
    Line(CellWidth * 2 + PenW, 0 + PenW, CellWidth * 3 - PenW, CellHeight - PenW);
    Line(CellWidth * 3 - PenW, 0 + PenW, CellWidth * 2 + PenW, CellHeight - PenW);
  end;
  // 1, 2 (4-ая клетка)
  if (x = 1) and (y = 2) then
  begin
    Line(0 + PenW, CellHeight + PenW, CellWidth - PenW, CellHeight * 2 - PenW);
    Line(CellWidth - PenW, CellHeight + PenW, 0 + PenW, CellHeight * 2 - PenW);
  end;
  // 2, 2 (5-ая клетка)
  if (x = 2) and (y = 2) then
  begin
    Line(CellWidth + PenW, CellHeight + PenW, CellWidth * 2 - PenW, CellHeight * 2 - PenW);
    Line(CellWidth * 2 - PenW, CellHeight + PenW, CellWidth + PenW, CellHeight * 2 - PenW);
  end;
  // 3, 2 (6-ая клетка)
  if (x = 3) and (y = 2) then
  begin
    Line(CellWidth * 2 + PenW, CellHeight + PenW, CellWidth * 3 - PenW, CellHeight * 2 - PenW);
    Line(CellWidth * 3 - PenW, CellHeight + PenW, CellWidth * 2 + PenW, CellHeight * 2 - PenW);
  end;
  // 1, 3 (7-ая клетка)
  if (x = 1) and (y = 3) then
  begin
    Line(0 + PenW, CellHeight * 2 + PenW, CellWidth - PenW, CellHeight * 3 - PenW);
    Line(CellWidth - PenW, CellHeight * 2 + PenW, 0 + PenW, CellHeight * 3 - PenW);
  end;
  // 2, 3 (8-ая клетка)
  if (x = 2) and (y = 3) then
  begin
    Line(CellWidth + PenW, CellHeight * 2 + PenW, CellWidth * 2 - PenW, CellHeight * 3 - PenW);
    Line(CellWidth * 2 - PenW, CellHeight * 2 + PenW, CellWidth + PenW, CellHeight * 3 - PenW);
  end;
  // 3, 3 (9-ая клетка)
  if (x = 3) and (y = 3) then
  begin
    Line(CellWidth * 2 + PenW, CellHeight * 2 + PenW, CellWidth * 3 - PenW, CellHeight * 3 - PenW);
    Line(CellWidth * 3 - PenW, CellHeight * 2 + PenW, CellWidth * 2 + PenW, CellHeight * 3 - PenW);
  end;
end;
 
procedure DrawO();// Рисование ноликов (x, y - значения матрицы)
begin
  var CellWidth := Round(WinWidth / 3); // Ширина одной клетки
  var CellHeight := Round(WinHeight / 3); // Высота одной клетки
  SetPenColor(clBlue);// Нолики синие
  // Если значения 1, 1 (первая клетка)
  if (x = 1) and (y = 1) then
  begin
    Circle(Round(CellWidth / 2), Round(CellHeight / 2), 40);
  end;
  // 2, 1 (2-ая клетка)
  if (x = 2) and (y = 1) then
  begin
    Circle(Round(CellWidth / 2 + CellWidth), Round(CellHeight / 2), 40);
  end;
  // 3, 1 (3-я клетка)
  if (x = 3) and (y = 1) then
  begin
    Circle(Round(CellWidth / 2 + CellWidth * 2), Round(CellHeight / 2), 40);
  end;
  // 1, 2 (4-ая клетка)
  if (x = 1) and (y = 2) then
  begin
    Circle(Round(CellWidth / 2), Round(CellHeight / 2 + CellHeight), 40);
  end;
  // 2, 2 (5-ая клетка)
  if (x = 2) and (y = 2) then
  begin
    Circle(Round(CellWidth / 2 + CellWidth), Round(CellHeight / 2 + CellHeight), 40);
  end;
  // 3, 2 (6-ая клетка)
  if (x = 3) and (y = 2) then
  begin
    Circle(Round(CellWidth / 2 + CellWidth * 2), Round(CellHeight / 2 + CellHeight), 40);
  end;
  // 1, 3 (7-ая клетка)
  if (x = 1) and (y = 3) then
  begin
    Circle(Round(CellWidth / 2), Round(CellHeight / 2 + CellHeight * 2), 40);
  end;
  // 2, 3 (8-ая клетка)
  if (x = 2) and (y = 3) then
  begin
    Circle(Round(CellWidth / 2 + CellWidth), Round(CellHeight / 2 + CellHeight * 2), 40);
  end;
  // 3, 3 (9-ая клетка)
  if (x = 3) and (y = 3) then
  begin
    Circle(Round(CellWidth / 2 + CellWidth * 2), Round(CellHeight / 2 + CellHeight * 2), 40);
  end;
end;
end.