Здесь содержаться примеры из справки PascalABC.NET. Исходные коды программ-примеров не изменялись.

Новые программы

gr_SpriteCreation

// Создание спрайта и его состояний
uses GraphABC,ABCSprites,ABCObjects,Events;

var
  s: SpriteABC;
  t: TextABC;

procedure MyMouseDown(x,y,mb: integer);
begin
  if s.PtInside(x,y) then
  begin
    if s.State<s.StateCount then
      s.State:=s.State+1
    else s.State:=1;
    t.Text:='Состояние спрайта: '+s.StateName;
  end;
end;
  
begin
  SetWindowCaption('Щелкните мышью на спрайте');
  SetWindowSize(400,300);
  FillWindow('Textures\mint.gif');
  
  s:=SpriteABC.Create(150,120,'SpriteFrames\multi1.bmp');
  s.Add('SpriteFrames\multi2.bmp');
  s.Add('SpriteFrames\multi3.bmp');
  s.Add('SpriteFrames\multi2.bmp');
  s.Add('SpriteFrames\multi4.bmp');
  s.Add('SpriteFrames\multi5.bmp');
  s.AddState('fly',4);
  s.AddState('stand',1);
  s.AddState('sit',1);
  s.StateName:='stand';
  s.Speed:=9;
  s.SaveWithInfo('d:\www\spr.png');
  // После создания спрайт можно сохранить: s.SaveWithInfo('spr.png');
  // Сохраненный спрайт можно создавать вызовом s:=Sprite.CreateFromInfo(150,120,('spr.png');
  t:=TextABC.Create(10,10,15,clRed,'Состояние спрайта: '+s.StateName);
  OnMouseDown:=MyMouseDown;
end.

gr_ManySprites

uses GraphABC,ABCSprites,Events,Containers;

var s: SpriteABC;

procedure KeyDown(key: integer);
begin
  case key of
    vk_Left: s.MoveOn(-3,0);
    vk_Right: s.MoveOn(3,0);
    vk_Up: s.MoveOn(0,-3);
    vk_Down: s.MoveOn(0,3);
  end;
end;

var i: integer;

begin
  FillWindow('Textures\mint.gif');

  for i:=1 to 20 do
  begin
    s:=SpriteABC.CreateFromInfo(Random(500),Random(300),'Sprites\spr.png');
    s.State:=Random(s.StateCount)+1;
    s.Speed:=Random(5)+6;
  end;
  s.State:=1;
  s.Speed:=10;
  StartSprites;
  
  OnKeyDown:=KeyDown;
end.

Игры

15

// Игра в 15
uses ABCObjects,ABCButtons,Events;

const
  n = 4;
  sz = 100;
  zz = 10;
  x0 = 20;
  y0 = 20;

var
  p: array [1..n,1..n] of SquareABC;
  digits: array [1..n*n-1] of integer;
  MeshButton: ButtonABC;
  StatusRect: RectangleABC;

  EmptyCellX,EmptyCellY: integer;
  MovesCount: integer;
  EndOfGame: boolean;  // True если все фишки стоят на своих местах

procedure Swap(var x,y: integer);
var v: integer;
begin
  v:=x;
  x:=y;
  y:=v;
end;

// Поменять местами две фишки
procedure Swap(var p,p1: SquareABC);
var
  v: SquareABC;
  i: integer;
begin
  v:=p;
  p:=p1;
  p1:=v;
  i:=p.Left;
  p.Left:=p1.Left;
  p1.Left:=i;
  i:=p.Top;
  p.Top:=p1.Top;
  p1.Top:=i;
end;

// Определить, являются ли клетки соседями
function Sosedi(x1,y1,x2,y2: integer): boolean;
begin
  Result:=(abs(x1-x2)=1) and (y1=y2) or (abs(y1-y2)=1) and (x1=x2)
end;

// Заполнить вспомогательный массив цифр
procedure FillDigitsArr;
var i: integer;
begin
  for i:=1 to n*n-1 do
    digits[i]:=i;
end;

// Перемешать вспомогательный массив цифр. Количество обменов должно быть четным
procedure MeshDigitsArr;
var i,x: integer;
begin
  for i:=1 to n*n-1 do
  begin
    repeat
      x:=Random(15)+1;
    until x<>i;
    Swap(digits[i],digits[x]);
  end;
  if n mod 2=0 then
    Swap(digits[1],digits[2]); // количество обменов должно быть четным
end;

// Заполнить двумерный массив фишек. Вместо пустой ячейки - белая фишка с числом 0
procedure Fill15ByDigitsArr;
var x,y,i: integer;
begin
  Swap(p[EmptyCellY,EmptyCellX],p[n,n]); // Переместить пустую фишку в правый нижний угол
  EmptyCellX:=n;
  EmptyCellY:=n;
  i:=1;
  for y:=1 to n do
  for x:=1 to n do
  begin
    if x*y=n*n then exit;
    p[y,x].Number:=digits[i];
    Inc(i);
  end;
end;

// Перемешать массив фишек
procedure Mesh15;
begin
  MeshDigitsArr;
  Fill15ByDigitsArr;
  MovesCount:=0;
  EndOfGame:=False;
  StatusRect.Text:='Количество ходов: '+IntToStr(MovesCount);
  StatusRect.Color:=RGB(200,200,255);
end;

// Создать массив фишек
procedure Create15;
var x,y: integer;
begin
  EmptyCellX:=n;
  EmptyCellY:=n;
  for x:=1 to n do
  for y:=1 to n do
  begin
    p[y,x]:=SquareABC.Create(x0+(x-1)*(sz+zz),y0+(y-1)*(sz+zz),sz,clMoneyGreen);
    p[y,x].BorderColor:=clGreen;
    p[y,x].BorderWidth:=2;
    p[y,x].TextScale:=0.7;
  end;
  p[EmptyCellY,EmptyCellX].Color:=clWhite;
  p[EmptyCellY,EmptyCellX].BorderColor:=clWhite;
  FillDigitsArr;
  MeshDigitsArr;
  Fill15ByDigitsArr;
end;

// Проверить, все ли фишки стоят на своих местах
function IsSolution: boolean;
var x,y,i: integer;
begin
  Result:=True;
  i:=1;
  for y:=1 to n do
  for x:=1 to n do
  begin
    if p[y,x].Number<>i then
    begin
      Result:=False;
      break;
    end;
    Inc(i);
    if i=n*n then i:=0;
  end;
end;

procedure MouseDown(x,y,mb: integer);
var fx,fy: integer;
begin
  if EndOfGame then // Если все фишки на своих местах, то не реагировать на мышь и ждать нажатия кнопки "Перемешать"
    exit;
  if ObjectUnderPoint(x,y)=nil then // Eсли мы щелкнули не на объекте, то не реагировать на мышь
    exit;
  fx:=(x-x0) div (sz+zz) + 1; // Вычислить координаты на доске для ячейки, на которой мы щелкнули мышью
  fy:=(y-y0) div (sz+zz) + 1;
  if (fx>n) or (fy>n) then
    exit;
  if Sosedi(fx,fy,EmptyCellX,EmptyCellY) then // Если ячейка соседствует с пустой, то поменять их местами
  begin
    Swap(p[EmptyCellY,EmptyCellX],p[fy,fx]);
    EmptyCellX:=fx;
    EmptyCellY:=fy;
    Inc(MovesCount);
    StatusRect.Text:='Количество ходов: '+IntToStr(MovesCount);
    if IsSolution then
    begin
      StatusRect.Text:='Победа! Сделано ходов: '+IntToStr(MovesCount);
      StatusRect.Color:=RGB(255,200,200);
      EndOfGame:=True;
    end
  end;
end;

begin
  Cls;
  SetWindowCaption('Игра в 15');
  SetWindowSize(2*x0+(sz+zz)*n-zz,2*y0+(sz+zz)*n-zz+90);
  
  EndOfGame:=False;
  Create15;
  MeshButton:=ButtonABC.Create((WindowWidth-200) div 2,2*y0+(sz+zz)*n-zz,200,'Перемешать',clLightGray);
  MeshButton.OnClick:=Mesh15;
  
  StatusRect:=RectangleABC.Create(0,WindowHeight-40,WindowWidth,40,RGB(200,200,255));
  StatusRect.TextVisible:=True;
  MovesCount:=0;
  StatusRect.Text:='Количество ходов: '+IntToStr(MovesCount);
  StatusRect.BorderWidth:=2;
  StatusRect.BorderColor:=RGB(80,80,255);//StatusRect.Color;

  OnMouseDown:=MouseDown;
end.

DeleteByMouse

uses ABCObjects,GraphABC,Events;

var
  i,current,mistakes,x,y: integer;
  ob: ObjectABC;
  txt: TextABC;

procedure MyMouseDown(x,y,mb: integer);
var ob: ObjectABC;
begin
  ob:=ObjectUnderPoint(x,y);
  if (ob<>nil) and (ob is RectangleABC) then
    if ob.Number=current then
    begin
      ob.Destroy;
      Inc(current);
    end
    else
    begin
      ob.Color:=clRed;
      Inc(mistakes);
      txt.Text:='Ошибок: '+IntToStr(mistakes);
    end;
end;

begin
  SetWindowTitle('Игра: удали все квадраты по порядку');
  for i:=1 to 16 do
  begin
    x:=Random(WindowWidth-50);
    y:=Random(WindowHeight-50);
    ob:=RectangleABC.Create(x,y,50,50,clMoneyGreen);
    ob.Number:=i;
  end;
  txt:=TextABC.Create(10,WindowHeight-30,14,clRed,'Ошибок: 0');
  current:=1;
  mistakes:=0;
  OnMouseDown:=MyMouseDown;
end.

KillThem

uses ABCObjects,Events,GraphABC,Timers,Utils;

var
  kLeftKey,kRightKey: boolean;
  kSpaceKey: integer;
  Player: RectangleABC;
  t: integer;
  EndOfGame: boolean;
  Enemies: TextABC;
  StaticObjectsCount: integer;
  NewGame: TextABC;
  Wins,Falls: integer;
  WinsABC,FallsABC: TextABC;
  r1: RectangleABC;

type
  KeysType=(kLeft,kRight);
  Pulya=class(CircleABC)
    constructor Create(x,y: integer);
    begin
      inherited Create(x,y,5,clRed);
      dx:=0; dy:=-5;
    end;
    procedure Move;
    var j: integer;
    begin
      inherited Move;
      if Top<0 then
        Visible:=False;
      for j:=StaticObjectsCount+1 to ObjectsCount do
        if (Objects[j]<>Self) and Intersect(Objects[j]) then
        begin
          Objects[j].Visible:=False;
          Visible:=False;
        end;
    end;
  end;
  Enemy=class(RectangleABC)
    constructor Create(x,y,w: integer);
    begin
      inherited Create(x,y,w,20,clRandom);
      if Random(2)=0 then
        dx:=5
      else dx:=-5;
      dy:=0;
    end;
    procedure Move;
    begin
      if Random(2)<>0 then Exit;
      if Random(10)=0 then dy:=5;
      if (Left<0) or (Left+Width>WindowWidth) or (Random(30)=0) then
        dx:=-dx;
      inherited Move;
      if dy<>0 then dy:=0;
      if Top>WindowHeight-50 then
        EndOfGame:=True;
    end;
  end;

function NumberOfEnemies: integer;
var i: integer;
begin
  Result:=0;
  for i:=1 to ObjectsCount do
    if Objects[i] is Enemy then
      Inc(Result);
end;

procedure CreateObjects;
var
  i: integer;
  r1: RectangleABC;
begin
  Player:=RectangleABC.Create(280,WindowHeight-30,100,20,clTeal);
  for i:=1 to 100 do
  begin
    r1:=Enemy.Create(Random(WindowWidth-50),40+Random(10),50);
    r1.TextVisible:=True;
    r1.Number:=i;
  end;
end;

procedure DestroyObjects;
var i: integer;
begin
  for i:=ObjectsCount downto StaticObjectsCount+1 do
    Objects[i].Destroy;
end;

procedure MoveObjects;
var i: integer;
begin
  for i:=StaticObjectsCount+2 to ObjectsCount do
    Objects[i].Move;
end;

procedure DestroyKilledObjects;
var i: integer;
begin
  for i:=ObjectsCount downto StaticObjectsCount+2 do
    if not Objects[i].Visible then
      Objects[i].Destroy;
end;

procedure KeyDown(Key: integer);
begin
  case Key of
vk_Left:  kLeftKey:=True;
vk_Right: kRightKey:=True;
vk_Space: if kSpaceKey=2 then kSpaceKey:=1;
  end;
end;

procedure KeyUp(Key: integer);
begin
  case Key of
vk_Left:  kLeftKey:=False;
vk_Right: kRightKey:=False;
vk_Space: kSpaceKey:=2;
  end;
end;

procedure Timer1;
var
  i,j,n: integer;
  p: Pulya;
begin
  if kLeftKey and (Player.Left>0) then
    Player.MoveOn(-10,0);
  if kRightKey and (Player.Left+Player.Width<WindowWidth) then
    Player.MoveOn(10,0);
  if kSpaceKey=1 then
  begin
    p:=Pulya.Create(Player.Left+Player.Width div 2,Player.Top-10);
    kSpaceKey:=0;
  end;
  MoveObjects;
  DestroyKilledObjects;
  RedrawObjects;
  n:=NumberOfEnemies;
  Enemies.Text:='Врагов: '+IntToStr(n);
  if n=0 then
    EndOfGame:=True;
  if EndOfGame then
  begin
    StopTimer(t);
    if n>0 then
    begin
      Inc(Falls);
      FallsABC.Text:='Поражений: '+IntToStr(Falls);
      RedrawObjects;
      ShowMessage('Вы проиграли!');
      DestroyObjects;
      Enemies.Text:='Врагов: '+IntToStr(NumberOfEnemies);
      RedrawObjects;
    end
    else
    begin
      Inc(Wins);
      WinsABC.Text:='Побед: '+IntToStr(Wins);
      RedrawObjects;
      ShowMessage('Вы выиграли!');
      DestroyObjects;
      Enemies.Text:='Врагов: '+IntToStr(NumberOfEnemies);
      RedrawObjects;
    end;
  end;
end;

procedure MouseUp(x,y,mb: integer);
begin
  if NewGame.PTInside(x,y) then
    StartTimer(t);
end;

procedure KeyPress(Key: char);
begin
  if ((UpCase(Key)='G') or (UpCase(Key)='П')) and EndOfGame then
  begin
    EndOfGame:=False;
    StartTimer(t);
    CreateObjects;
    kSpaceKey:=2;
    kLeftKey:=False;
    kRightKey:=False;
  end;
end;

begin
  LockDrawingObjects;
  EndOfGame:=True;
  r1:=RectangleABC.Create(0,0,WindowWidth,38,clWhite);
  NewGame:=TextABC.Create(WindowWidth-180,5,14,clBlack,'G - Новая игра');
  Enemies:=TextABC.Create(10,5,14,clRed,'Врагов: '+IntToStr(NumberOfEnemies));
  WinsABC:=TextABC.Create(150,5,14,clRed,'Побед: '+IntToStr(Wins));
  FallsABC:=TextABC.Create(280,5,14,clRed,'Поражений: '+IntToStr(Falls));
  StaticObjectsCount:=ObjectsCount;
  Enemies.Text:='Врагов: '+IntToStr(NumberOfEnemies);
  OnKeyDown:=KeyDown;
  OnKeyPress:=KeyPress;
  OnKeyUp:=KeyUp;
  OnMouseUp:=MouseUp;
  t:=CreateTimer(10,Timer1);
  StopTimer(t);
  RedrawObjects;
end.

Модуль ABCObjects (для обучения основам объектно-ориентированного программирования)

gr_PictureScale

uses ABCObjects;

const delay=2;

var
  p: PictureABC;
  x,y: integer;
  i,w: integer;

begin
  x:=100;
  y:=100;
  p:=PictureABC.Create(x,y,'demo.bmp');
  while True do
  begin
  for x:=100 to 450 do
    begin
      Sleep(delay);
      p.MoveOn(1,0);
    end;
    for i:=100 downto -100 do
    begin
      Sleep(delay);
      w:=p.Width;
      p.ScaleX:=i/100;
      p.Left:=p.Left+w-p.Width;
    end;
    for x:=450 downto 100 do
    begin
      Sleep(delay);
      p.MoveOn(-1,0);
    end;
    for i:=-100 to 100 do
    begin
      Sleep(delay);
      p.ScaleX:=i/100;
    end;
  end;
end.

gr_MovingObjects

uses ABCObjects;

function CreateRandomABC: ObjectABC;
begin
  case Random(3) of
0: Result:=CircleABC.Create(Random(WindowWidth-30)+10,Random(WindowHeight-30)+10,Random(20)+10,clRandom);
1: Result:=RectangleABC.Create(Random(WindowWidth-30)+10,Random(WindowHeight-30)+10,Random(20)+10,Random(20)+10,clRandom);
2: Result:=StarABC.Create(Random(WindowWidth-30)+10,Random(WindowHeight-30)+10,Random(20)+10,Random(10)+5,Random(4)+4,clRandom);
  end;
end;

procedure Move(o: ObjectABC);
begin
  o.MoveOn(o.dx,o.dy);
  if (o.Left<0) or (o.Left+o.Width>WindowWidth) then
    o.dx:=-o.dx;
  if (o.Top<0) or (o.Top+o.Height>WindowHeight) then
    o.dy:=-o.dy;
end;

const n=200;

var
  m: ObjectABC;
  i: integer;

begin
  SetWindowCaption('Движущиеся объекты');
  LockDrawingObjects;
  for i:=1 to n do
  begin
    m:=CreateRandomABC;
    repeat
      m.dx:=Random(7)-3;
      m.dy:=Random(7)-3;
    until (m.dx<>0) and (m.dy<>0);
  end;
  while True do
  begin
    for i:=1 to ObjectsCount do
      Move(Objects[i]);
    RedrawObjects;
  end;
end.

gr_Intersects1

uses ABCObjects;

var
  jadro: CircleABC;
  r: RectangleABC;
  i: integer;

procedure CheckPulyaIntersects;
var i: integer;
begin
  for i:=ObjectsCount-1 downto 1 do
    if jadro.Intersect(Objects[i]) then
      Objects[i].Destroy;
end;

begin
  for i:=1 to 300 do
    r:=CreateRectangleABC(Random(WindowWidth-200)+100,Random(WindowHeight-100),Random(200),Random(200),clRandom);
  jadro:=CircleABC.Create(10,WindowHeight div 2,100,clBlack);
  for i:=1 to 700 do
  begin
    jadro.MoveOn(1,0);
    CheckPulyaIntersects;
  end;
end.

gr_Text

es ABCObjects;

var
  bt: TextABC;
  x: integer;
  
begin
  x:=224;
  bt:=CreateTextABC(60,110,110,RGB(x,x,x),'Hello!');
  while x>32 do
  begin
    Sleep(40);
    Dec(x,32);
    bt:=TextABC(bt.Clone);
    bt.Color:=RGB(x,x,x);
    bt.MoveOn(7,7);
  end;
end.

gr_Mouse

uses ABCObjects,Events;

var
  r: RectangleABC;
  z: StarABC;
  el: EllipseABC;
  br: BoardABC;
  f: ContainerABC;
  cp: RegularPolygonABC;

begin
  cls;
  SetWindowCaption('Перетаскивание объектов мышью');
  r:=CreateRectangleABC(100,70,120,180,clCream);
  r.BorderWidth:=3;
  r.BorderColor:=clBrown;
  br:=CreateBoardABC(290,290,5,6,20,clBlack);
  z:=CreateStarABC(200,100,70,35,5,clRed);
  el:=CreateEllipseABC(5,55,65,50,clRandom);
  el:=el.Clone;
  el.Color:=clRandom;

  cp:=CreateRegularPolygonABC(250,220,60,6,clGreen);

  f:=CreateContainerABC(370,80);
  f.Add(CreateRectangleABC(80,0,20,100,clGray));
  f.Add(CreateRectangleABC(0,80,100,20,clGray));
  f.Scale(1.3);
  
  f:=f.Clone;
  f.MoveOn(50,-40);

  z.ToBack;

  OnMouseDown:=ABCMouseDown;
  OnMouseMove:=ABCMouseMove;
  OnMouseUp:=ABCMouseUp;
end.

gr_House

uses ABCObjects,ABCHouse,Events;
// исправить изменение координат фигуры при изменении координат
// составляющих ее объектов

var
  r: RectangleABC;
  z: StarABC;
  pp: RegularPolygonABC;
  c: CircleABC;
  sq: SquareABC;
  el: EllipseABC;
  p: PictureABC;
  br: BoardABC;
  f: ContainerABC;
  h,h1: HouseABC;
  cp: RegularPolygonABC;
  i,j,dx,dy: integer;
  g: ObjectABC;

begin
  cls;
  h:=HouseABC.Create(100,70,255,150,clGray);
  h.Wall.BorderWidth:=3;
  h.Window.Color:=clYellow;
  h.Door.Color:=clAqua;
  h.Window.BorderWidth:=2;
  h.Door.BorderWidth:=2;
  h.Window.Width2:=5;
  h.moveon(10,0);
  h.Redraw;
  f:=ContainerABC.Create(100,270);
  f.Add(RectangleABC.Create(20,0,300,80,clCream));
  g:=h.Door.Clone;
  g.moveon(80,10);
  g.Owner:=f;
  z:=StarABC.Create(300,300,70,35,5,clRed);
  g:=z.Clone;

  OnMouseDown:=ABCMouseDown;
  OnMouseMove:=ABCMouseMove;
  OnMouseUp:=ABCMouseUp;
end.

gr_Robots

uses ABCObjects,ABCRobots;

const ms=300;

var
  f: RobotField;
  r,r1: Robot;
  i: integer;

begin
  cls;
  SetWindowCaption('ABC Роботы');
  f:=RobotField.Create(144,116,5,8,40,clRed);
  r:=Robot.Create(1,1,clGreen,f);
  r1:=Robot.Create(8,5,clYellow,f);
  f.moveon(10,10);
  for i:=1 to 5 do
  begin
    Sleep(ms);
    r.Down;
    Sleep(ms);
    r1.Up;
  end;
end.

gr_Star_Rotate

uses ABCObjects, graphabc<ref></ref>;

var
  z: StarABC;
  i: integer;

begin
  z:=CreateStarABC(WindowWidth div 2,WindowHeight div 2,WindowHeight div 2 - 5,WindowHeight div 4 + 16,6,clRed);
  for i:=1 to 20 do
  begin
    Sleep(100);
    z.Count:=z.Count+1;
  end;
  for i:=1 to 180 do
  begin
    Sleep(10);
    z.Angle:=z.Angle+1;
  end;
end.

gr_Chess

uses ABCObjects,ABCChessObjects,Events,Utils;

var
  br: ChessBoardABC;
  ChessFigures: ChessSetABC;
  wk,wq,wb1,wkn1,wr1,wb2,wkn2,wr2: ChessFigureABC;
  wp: array [1..8] of ChessFigureABC;
  bk,bq,bb1,bkn1,br1,bb2,bkn2,br2: ChessFigureABC;
  bp: array [1..8] of ChessFigureABC;

procedure CreateFigures;
var i: integer;
begin
  ChessFigures:=ChessSetABC.Create(PascalABCPath+'Media\Images\Chess.wmf',45,br);

  wk:=ChessFigures.CreateWhiteKing(5,1);
  wq:=ChessFigures.CreateWhiteQueen(4,1);
  wb1:=ChessFigures.CreateWhiteBishop(3,1);
  wkn1:=ChessFigures.CreateWhiteKnight(2,1);
  wr1:=ChessFigures.CreateWhiteRook(1,1);
  wb2:=ChessFigures.CreateWhiteBishop(6,1);
  wkn2:=ChessFigures.CreateWhiteKnight(7,1);
  wr2:=ChessFigures.CreateWhiteRook(8,1);
  for i:=1 to 8 do
    wp[i]:=ChessFigures.CreateWhitePown(i,2);

  bk:=ChessFigures.CreateBlackKing(5,8);
  bq:=ChessFigures.CreateBlackQueen(4,8);
  bb1:=ChessFigures.CreateBlackBishop(3,8);
  bkn1:=ChessFigures.CreateBlackKnight(2,8);
  br1:=ChessFigures.CreateBlackRook(1,8);
  bb2:=ChessFigures.CreateBlackBishop(6,8);
  bkn2:=ChessFigures.CreateBlackKnight(7,8);
  br2:=ChessFigures.CreateBlackRook(8,8);
  for i:=1 to 8 do
    bp[i]:=ChessFigures.CreateBlackPown(i,7);
end;

begin
  br:=CreateChessBoardABC(20,20,8,8,50,clBlack);
  br.MouseIndifferent:=True;
  br.Delay:=50;
  
  CreateFigures;

  wp[5].move('e4');
  bp[5].move('e5');
  wkn2.move('f3');
  bkn1.move('c6');
  wp[4].move('d4');
  bkn1.move('d4');
  wp[4].Destroy;
  wkn2.move('d4');
  bkn1.Destroy;
  bp[5].move('d4');
  wkn2.Destroy;
  wq.move('d4');
  bp[5].Destroy;

  OnMouseDown:=ABCMouseDown;
  OnMouseMove:=ABCMouseMove;
  OnMouseUp:=ABCMouseUp;
end.

gr_Brown_Moving

uses ABCObjects;

var
  r: RectangleABC;
  rr: RoundRectABC;
  z: RegularPolygonABC;
  c: CircleABC;
  sq: SquareABC;
  rsq: RoundSquareABC;
  el: EllipseABC;
  p: PictureABC;
  br: BoardABC;
  t: TextABC;
  g: ObjectABC;
  i,j: integer;

procedure MoveAll(a,b: integer);
var j: integer;
begin
  for j:=1 to Objects.Count do
    Objects[j].moveOn(a,b);
end;

begin
//  LockDrawingObjects;
  sq:=CreateSquareABC(30,5,90,clSkyBlue);
  r:=CreateRectangleABC(10,10,100,180,RGB(255,100,100));
  rr:=CreateRoundRectABC(200,180,180,50,20,clRandom);
  rsq:=CreateRoundSquareABC(20,180,80,40,clRandom);
  c:=CreateCircleABC(160,55,70,clGreen);
  z:=CreateStarABC(200,150,70,135,5,clRandom);
  z.Filled:=False;
  el:=CreateEllipseABC(5,55,65,50,clRandom);
  el.Bordered:=False;
  t:=TextABC.Create(100,170,15,clBlack,'Hello, ABCObjects!');
  br:=CreateBoardABC(200,20,7,9,20,clBlack);
  p:=PictureABC.Create(80,30,'girl.bmp');
  z.Height:=200;
  z.Radius:=70;
  sq.Width:=120;
  t.TransparentBackground:=False;
  t.BackgroundColor:=clYellow;
  t.FontName:='Times New Roman';
  t.FontSize:=20;
  c.Height:=50;
  c.Scale(2);
  MoveAll(160,110);
  
  LockDrawingObjects;
  RedrawObjects;
  while True do
  begin
    for j:=1 to Objects.Count do
      Objects[j].moveOn(Random(3)-1,Random(3)-1);
    RedrawObjects;
  end;
end.

Модуль GraphABC

Brown_Moving

// Броуновское движение
uses GraphABC;

var x,y: integer;

procedure LineOn(dx,dy: integer);
begin
  if (x+dx>10) and (y+dy>10) and (x+dx<WindowWidth-10) and (y+dy<WindowHeight-10) then
  begin
    Line(x,y,x+dx,y+dy);
    x:=x+dx;
    y:=y+dy;
  end;  
end;

var i: integer;

const len=3;

begin
  SetWindowCaption('Броуновское движение');
  SetWindowSize(640,480);
  SetBrushColor(clBlack);
  FillRect(0,0,WindowWidth div 2,WindowHeight-1);
  SetFontColor(RGB(255,255,255));
  x:=Windowwidth div 2;
  y:=WindowHeight div 2;
  TextOut(5,5,'Начало!');
  MoveTo(x,y);
  for i:=1 to 100000 do
  begin
    if i mod 1000 = 0 then TextOut(5,25,IntToStr(i)+' итераций');
    SetPenColor(RGB(Random(256),Random(256),Random(256)));
    LineOn(Random(2*len+1)-len,Random(2*len+1)-len)
  end;  
  TextOut(5,45,'Конец!');
end.

Mosaic

// Мозаика. Квадратики случайным образом меняются местами
uses GraphABC;

const 
  w=25;
  w1=1;
  m=50;
  n=70;
  x0=0;
  y0=0;

var i,j,i1,j1,di,dj,v,k: integer;
    a: array [0..n,0..m] of integer;

begin
  SetWindowCaption('Мозаика');
  for i:=0 to n-1 do
  for j:=0 to m-1 do
  begin
    a[i,j]:=RGB(Random(256),Random(256),Random(256));
    SetBrushColor(a[i,j]);
    FillRect(x0+i*w,y0+j*w,x0+(i+1)*w-w1,y0+(j+1)*w-w1);
  end;
  while true do
  begin
    k:=k+1;
    if k mod 1000 = 0 then 
    begin
      k:=0;
      Sleep(1);
    end;  
    i:=Random(n-2)+1;
    j:=Random(m-2)+1;
    di:=Random(3)-1;
    dj:=Random(3)-1;
    i1:=i+di; j1:=j+dj;
    v:=a[i,j];
    a[i,j]:=a[i1,j1];
    a[i1,j1]:=v;
    SetBrushColor(a[i,j]);
    FillRect(x0+i*w,y0+j*w,x0+(i+1)*w-w1,y0+(j+1)*w-w1);
    SetBrushColor(a[i1,j1]);
    FillRect(x0+i1*w,y0+j1*w,x0+(i1+1)*w-w1,y0+(j1+1)*w-w1);
  end;
end.

Colors

 // Демонстрация стандартных цветов
uses GraphABC;

const n=22;

var 
  x,y,y1,w,ww,i: integer;
  Colors: array [1..n] of integer;

begin
  SetWindowCaption('Стандартные цвета');
  SetPenStyle(psClear);
  Colors[1]:=clWhite;
  Colors[2]:=clLightGray;
  Colors[3]:=clGray;
  Colors[4]:=clDarkGray;
  Colors[5]:=clBlack;
  Colors[6]:=clRed;
  Colors[7]:=clGreen;
  Colors[8]:=clBlue;
  Colors[9]:=clYellow;
  Colors[10]:=clAqua;
  Colors[11]:=clFuchsia;
  Colors[12]:=clPurple;
  Colors[13]:=clBrown;
  Colors[14]:=clMaroon;
  Colors[15]:=clMoneyGreen;
  Colors[16]:=clSkyBlue;
  Colors[17]:=clCream;
  Colors[18]:=clOlive;
  Colors[19]:=clTeal;
  Colors[20]:=clLime;
  Colors[21]:=clSilver;
  Colors[22]:=clNavy;

  x:=10; y:=20;
  y1:=400;
  w:=30;
  ww:=9;

  SetWindowSize(x+n*(w+ww),y1+y);

  for i:=1 to n do
  begin
    SetBrushColor(Colors[i]);
    Rectangle(x,y,x+w,y1);
    x:=x+w+ww;
  end;
end.

Graphic2

// Процедура drawGraph рисования графика функции в полном окне
// с масштабированием по оси OY
// Перерисовывает график при изменении размеров окна
uses GraphABC,Events;

type FUN = function (x: real): real;

function f(x: real): real;
begin
  Result:=x*sin(x)*exp(-0.1*x);
end;

// l (logical) - логические координаты
// s (screen) - физические координаты
procedure drawGraph(x1,x2: real; f: FUN);
 var
  xl,xl0,wl,yl,yl0,hl: real;
  xs0,ws,ys0,hs: integer;
 function LtoSx(xl: real): integer;
 begin
   Result:=round(ws/wl*(xl-xl0)+xs0);
 end;
 function LtoSy(yl: real): integer;
 begin
   Result:=round(hs/hl*(yl-yl0)+ys0);
 end;
 function StoLx(xs: integer): real;
 begin
   Result:=wl/ws*(xs-xs0)+xl0;
 end;
 var xi: integer;
     yi: array [0..1600] of real;
     min,max,y: real;
begin // drawGraph
  xs0:=0;
  ys0:=WindowHeight-1;
  ws:=WindowWidth;
  hs:=WindowHeight-1;
  
  xl0:=x1;
  wl:=x2-x1;

  min:=1e300;
  max:=-1e300;
  for xi:=0 to ws do
  begin
    yi[xi]:=f(StoLx(xi+xs0));
    if yi[xi]<min then min:=yi[xi];
    if yi[xi]>max then max:=yi[xi];
  end;
  yl0:=min;
  hl:=-(max-min);

  MoveTo(0,LtoSy(0));
  LineTo(ws,LtoSy(0));
  
  MoveTo(LtoSx(0),0);
  LineTo(LtoSx(0),hs);

  SetPenColor(clBlue);
  MoveTo(xs0,LtoSy(yi[0]));
  for xi:=xs0+1 to xs0+ws do
    LineTo(xi,LtoSy(yi[xi-xs0]));
end;

procedure Resize;
begin
  ClearWindow;
  drawGraph(0,60,f);
  Redraw;
end;

begin
  LockDrawing;
  SetWindowCaption('График функции: масштабирование');
  drawGraph(0,60,f);
  Redraw;
  OnResize:=Resize;
end.

InflateRect

uses GraphABC,PointRect;

var
  r: Rect;
  i: integer;
begin
  SetWindowSize(700,520);
  SetBrushStyle(bsClear);
  r:=RectF(100,10,600,510);
  for i:=1 to 60 do
  begin
    InflateRect(r,-4);
    Rectangle(r.Left,r.Top,r.Right,r.Bottom);
    Sleep(1);
  end;
  InflateRect(r,-2);
  for i:=1 to 59 do
  begin
    InflateRect(r,4);
    Rectangle(r.Left,r.Top,r.Right,r.Bottom);
    Sleep(1);
  end;
end.

MovingObject

 // Демонстрация элементарной анимации. Перемещение картинки
uses GraphABC;

const speed=1;

var
  w,h,i,j,pic: integer;

begin
  SetWindowCaption('Перемещение картинки');
  pic:=LoadPicture('demo.bmp');
  w:=PictureWidth(pic);
  h:=PictureHeight(pic);
  SetBrushColor(clWhite);
  for i:=0 to WindowWidth-w do
  begin
    DrawPicture(pic,i,0);
    if i mod speed = 0 then Sleep(1);
    FillRect(i,0,i+1,0+h);
  end;
  DestroyPicture(pic);
end.

SetPixel

// Демонстрация возможностей функции SetPixel.
uses GraphABC;

var i,j: integer;

begin
  SetWindowSize(300,200);
  for j:=0 to WindowHeight-1 do
  for i:=0 to WindowWidth-1 do
    SetPixel(i,j,RGB(i+j,i-j,i+2*j));

  for i:=0 to WindowWidth-1 do
  for j:=0 to WindowHeight-1 do
    SetPixel(i,j,RGB(2*i+j,i-2*j,i+2*j));

  for j:=0 to WindowHeight-1 do
  for i:=0 to WindowWidth-1 do
    SetPixel(i,j,RGB(0,0,i*i+j*j));
    
  for i:=0 to WindowWidth-1 do
  for j:=0 to WindowHeight-1 do
    if (i-150)*(i-150)+(j-100)*(j-100)<100*100
      then SetPixel(i,j,RGB(255-round(sqrt((i-100)*(i-100)+(j-50)*(j-50))),0,0))
      else SetPixel(i,j,clWhite);
    
  for j:=0 to WindowHeight-1 do
  for i:=0 to WindowWidth-1 do
    SetPixel(i,j,clRandom);
    
  ClearWindow;
  for j:=0 to 20000 do
  begin
    SetBrushColor(clRandom);
    FillRect(Random(WindowWidth),Random(WindowHeight),Random(WindowWidth),Random(WindowHeight));
  end;  

  ClearWindow;
  for j:=0 to 70000 do
    SetPixel(Random(WindowWidth),Random(WindowHeight),clRandom);

  SetBrushColor(clWhite);
  Rectangle(40,80,WindowWidth-40,WindowHeight-80);
  SetFontSize(14);
  SetFontName('Arial');
  SetFontColor(clRed);
  TextOut(50,WindowHeight div 2-14,'Модуль GraphABC!');
end.

Справочные примеры PascalABC

Содержание

Новые программы

gr_SpriteCreation

gr_ManySprites

Игры

15

DeleteByMouse

KillThem

Модуль ABCObjects (для обучения основам объектно-ориентированного программирования)

gr_PictureScale

gr_MovingObjects

gr_Intersects1

gr_Text

gr_Mouse

gr_House

gr_Robots

gr_Star_Rotate

gr_Chess

gr_Brown_Moving

Модуль GraphABC

Brown_Moving

Mosaic

Colors

Graphic2

InflateRect

MovingObject

SetPixel