TestSuite/CompilationSamples/15.pas - master - n-dimens/pascalabcnet

TestSuite/CompilationSamples/15.pas
179 строк5 KB
Бондарев Иван
#190
12 авг 2016, 18:24
12 авг 2016, 18:24272ea81
// Игра в 15
uses GraphABC,ABCObjects,ABCButtons;

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 p,p1: SquareABC);
begin
  PABCSystem.Swap(p,p1);
  var 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;
begin
  for var i:=1 to n*n-1 do
    digits[i] := i;
end;

// Перемешать вспомогательный массив цифр. Количество обменов должно быть четным
procedure MeshDigitsArr;
var x: integer;
begin
  for var 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;
begin
  Swap(p[EmptyCellY,EmptyCellX],p[n,n]); // Переместить пустую фишку в правый нижний угол
  EmptyCellX := n;
  EmptyCellY := n;
  var i := 1;
  for var y:=1 to n do
  for var x:=1 to n do
  begin
    if x*y=n*n then exit;
    p[y,x].Number := digits[i];
    i += 1;
  end;
end;

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

// Создать массив фишек
procedure Create15;
begin
  EmptyCellX := n;
  EmptyCellY := n;
  for var x:=1 to n do
  for var y:=1 to n do
  begin
    p[y,x] := new SquareABC(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);
begin
  if EndOfGame then // Если все фишки на своих местах, то не реагировать на мышь и ждать нажатия кнопки "Перемешать"
    exit;
  if ObjectUnderPoint(x,y)=nil then // Eсли мы щелкнули не на объекте, то не реагировать на мышь
    exit;
  var fx := (x-x0) div (sz+zz) + 1; // Вычислить координаты на доске для ячейки, на которой мы щелкнули мышью
  var 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
  SetSmoothingOff;
  Window.Title := 'Игра в 15';
  Window.IsFixedSize := True;
  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 := new RectangleABC(0,WindowHeight-40,WindowWidth,40,RGB(200,200,255));
  StatusRect.TextVisible := True;
  StatusRect.Text := 'Количество ходов: '+IntToStr(MovesCount);
  StatusRect.BorderWidth := 2;
  StatusRect.BorderColor := RGB(80,80,255);

  MovesCount := 0;

  OnMouseDown := MouseDown;
end.