Все программы, код которых выложен здесь, являются работоспособными. Ниже приведены возможные варианты реализации игр «Крестики-нолики» и «Змейка» на PascalABC.Net 3.0.

Крестики-нолики

Описание алгоритма
Отрисовать игровое поле. Позволить сделать шаг игроку. Проверить выиграл ли кто-то. Если да - выиграл текущий игрок, иначе - вернуться к шагу 1.

Управление:

Левая кнопка мыши - установить крестик/нолик.

uses GraphABC;
const
  N = 2;
  Z = '0';
  K = 'X';
  Size = 200;
  Border = 1;
  Sx = 1200;
  Sy = 70;

var
  Matrix: array [0..N, 0..N] of char;
  Player1: boolean;

procedure Draw();
  procedure DrawZ(i, j: integer);
  begin
    SetPenColor(clCyan);
    SetPenWidth(4);
    var size2 := Size div 2;
    DrawCircle((i + 1) * Size - size2, (j + 1) * Size - size2, Round(size2 * 0.7));
  end;
  
  procedure DrawK(i, j: integer);
    procedure RLine(x, y, x1, y1: real):=Line(Round(x), Round(y), Round(x1), Round(y1));

  begin
    SetPenColor(clPink);
    SetPenWidth(4);
    var size2 := Size div 2 * 0.3;
    var cx1 := i * Size + size2;
    var cy1 := j * Size + size2;
    var cx2 := (i + 1) * Size - size2;
    var cy2 := (j + 1) * Size - size2;
    RLine(cx1, cy1, cx2, cy2);
    RLine(cx1, cy2, cx2, cy1);
  end;

  begin
    ClearWindow(clBlack);
    if Player1 then SetWindowCaption('Ходит первый игрок') else SetWindowCaption('Ходит второй игрок');
    for var i := 0 to N do
      for var j := 0 to N do
      begin
        SetPenColor(clLightBlue);
        SetPenWidth(1);
        DrawRectangle(i * Size + Border, j * Size + Border, (i + 1) * Size - Border, (j + 1) * Size - Border);
        if Matrix[i, j] = Z then DrawZ(i, j)
        else if Matrix[i, j] = K then DrawK(i, j);
      end;
    Redraw();
  end;

function Won(c: char): boolean;
var
  count: byte;
begin
  Result := false;
  for var i := 0 to N do
  begin
    count := 0;
    for var j := 0 to N do
      if Matrix[i, j] = c then Inc(count);
    if count = 3 then Result := true;
  end;
  
  if not Result then
  begin
    for var i := 0 to N do
    begin
      count := 0;
      for var j := 0 to N do
        if Matrix[j, i] = c then Inc(count);
      if count = 3 then Result := true;
    end;
    
    if not Result then
    begin
      count := 0;
      for var i := 0 to N do
        if Matrix[i, i] = c then Inc(count);
      if count = 3 then Result := true;
      
      if not Result then
      begin
        count := 0;
        for var i := 0 to N do
          if Matrix[N - i, i] = c then Inc(count);
        if count = 3 then Result := true;
      end;
    end;
  end;
end;

function IsFull(): boolean;
begin
  Result := true;
  for var i := 0 to N do
    for var j := 0 to N do
      if (Matrix[i, j] <> Z) and (Matrix[i, j] <> K) then
      begin
        Result := false;
        break;
      end;
end;

procedure MouseDown(x, y, mb: integer);
  procedure ShowWinner(s: string; c: Color);
  begin
    SetWindowCaption('Результат игры');
    Sleep(2000);
    SetWindowSize(Sx, Sy);
    CenterWindow();
    ClearWindow(clBlack);
    
    SetFontSize(16);
    SetFontStyle(fsBold);
    SetFontColor(c);
    DrawTextCentered(0, 0, Sx, Sy, s);
    
    Redraw();
    Sleep(2000);
    Halt();
  end;

begin
  var i := x div Size;
  var j := y div Size;
  if (Matrix[i, j] <> Z) and (Matrix[i, j] <> K) then
  begin
    if Player1 then Matrix[i, j] := Z else Matrix[i, j] := K;
    Draw();
    
    var winnerExists := Won(Z) or Won(K);
    if winnerExists then
      if Player1 then ShowWinner('Игрок первый победил!', clLightBlue) else ShowWinner('Игрок второй победил!', clLightBlue);
    
    if IsFull() and not winnerExists then ShowWinner('Ничья!', clOrange);
    
    Player1 := not Player1;
  end;
end;

begin
  var Size2 := Size * 3;
  SetWindowIsFixedSize(true);
  SetWindowSize(Size2, Size2);
  CenterWindow();
  LockDrawing();
  
  Player1 := true;
  Draw();
  
  OnMouseDown := MouseDown;
end.

Змейка

==Упрощенный вариант== (просто змейка которой можно управлять)

Описание алгоритма
Нарисовать змейку. Если нажали клавишу - добавить новую точку, в которую перешла голова змейки, в список и удалить первую точку в списке. Перейти к шагу 1.

Управление:

W - вверх.
S - вниз.
A - влево.
D - вправо.

uses GraphABC;
const
  Size = 20;

var
  Snake: List<Point>;

procedure Draw();
begin
  ClearWindow();
  Polyline(Snake.ToArray());
  
  var c := Snake.Count - 1;
  Circle(Snake[c].X, Snake[c].Y, 5);
  Redraw();
end;

procedure KeyDown(Key: integer);
begin
  var c := Snake.Count - 2;
  case Key of
    VK_Left:
      begin
        Snake.RemoveAt(0);
        Snake.Add(new Point(Snake[c].X - Size, Snake[c].Y));
      end;
    VK_Right:
      begin
        Snake.RemoveAt(0);
        Snake.Add(new Point(Snake[c].X + Size, Snake[c].Y));
      end;
    VK_Up:
      begin
        Snake.RemoveAt(0);
        Snake.Add(new Point(Snake[c].X, Snake[c].Y  - Size));
      end;
    VK_Down:
      begin
        Snake.RemoveAt(0);
        Snake.Add(new Point(Snake[c].X, Snake[c].Y  + Size));
      end;
  end;
  Draw();
end;

begin
  LockDrawing();
  SetSmoothingOff();
  
  Snake := new List<Point>();
  for var x := 1 to 30 do
    Snake.Add(new Point(x * Size, Size));
  
  Draw();
  OnKeyDown := KeyDown;
end.

456

Возрастающая последовательность

uses GraphABC, ABCObjects;
const
  Border = 100;


var
  Obj: CircleABC;
  DX, DY: integer;
  Move: boolean;
  Numbers: TCircles;

function IsEqual(L2: TCircles): boolean;8
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);
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 TCircles();
  for var i := 0 to 6 do
  end;
begin
    Numbers.Add(new CircleABC(Border + Random(W), Border + Random(H), 30, clRandom()));
    Numbers.Last().Number := i;
  
  Move := false;
  OnMouseMove := MouseMove;
  OnMouseUp := MouseUp;76
end.

430

Книга программиста/Книга игр на PascalABC.Net

Крестики-нолики

Змейка

Возрастающая последовательность