Шахматы

[Natalya23]

Помогите, пожалуйста, найти ошибку. Не могу разобраться с процедурой проверки перепрыгивания, она постоянно выдает ошибку. Подскажите, пожалуйста, как ее написать для диагоналей. Может, кто-нибудь еще какие-то советы даст

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

  type
  TChess = class(TForm)
    procedure FormCreate(Sender: TObject);
    private
     A: Array [1..8,1..8] of TShape;
    Number: Array [1..4, 1..8] of TLabel;
    { Private declarations }
    Function Shah(color : boolean) : boolean;
    procedure OnImageDrop(Sender, Source: TObject; X, Y: Integer);
    procedure OnImageOver(Sender, Source: TObject; X, Y: Integer;
    State: TDragState; var Accept: Boolean);
  public
    { Public declarations }
  end;

   Coordinaty=array [1..2] of integer;
  TFigura=Class (TImage)
  private
  Public
    FPlace: Coordinaty;
    FColor: boolean;
    Procedure SetPlace (const a:coordinaty);
    Property Place: coordinaty read FPlace write SetPlace;
    Property color: boolean read FColor;
    protected
    constructor  OOO(value:Coordinaty);
    Function Hod ( x : coordinaty): boolean; virtual; abstract;
    Function pryg (x: coordinaty): boolean;
    
  End;
// подклассы
TPAWN = class(TFigura)
  private
    Function Hod(X : coordinaty): boolean; override;
  end;
TRook = class(TFigura)
  private
    Function Hod(X : coordinaty): boolean; override;
  end;
TKING = class(TFigura)
  private
    Function Hod(X : coordinaty): boolean; override;
  end;
TBishop = class(TFigura)
  private
    Function Hod(X : coordinaty): boolean; override;
  end;
TQueen = class(TFigura)
  private
    Function Hod(X : coordinaty): boolean; override;
  end;
TKnight = class(TFigura)
  private
    Function Hod(X : coordinaty): boolean; override;
  end;



var
  Chess: TChess;
    Figures: array[1..32] of TFigura;
    ColorHOD: boolean;
    Nextturn:boolean;
implementation

{$R *.dfm}
{$R Picture.res}

procedure TChess.FormCreate(Sender: TObject);
var i, j: byte;
    polog:Coordinaty;
begin
Nextturn:=true;
  ClientHeight := 65*8+50;
  ClientWidth := 65*8+50;
  BorderStyle := bsSingle;

for j:=1 to 8 do
for i:=1 to 8 do
  begin
    a[i,9-j]:=TShape.Create(Chess);
    a[i,9-j].Parent:=Chess;
    a[i,9-j].Height:=65;
    a[i,9-j].Width:=65;
    a[i,9-j].Tag:=i*10+j;
    a[i,9-j].Left:=(i-1)*a[i,9-j].Height+20;
    a[i,9-j].Top:=(j-1)*a[i,9-j].Height+20;
    a[i,9-j].OnDragDrop:=Chess.OnImageDrop;
    a[i,9-j].OnDragOver:=Chess.OnImageOver;
    if odd(i+j) then a[i,9-j].Brush.Color:=clBtnShadow;
    end;
for i:=1 to 4 do
  for j:=1 to 8 do
    begin
    Number[i,j]:=TLabel.Create(Chess);
    Number[i,j].Parent:=Chess;
    case i of
    1, 2:
      begin
        Number[i,j].Caption := Chr(Ord('A')+j-1);
        Number[i,j].Left:=(j)*65-15;
        Number[i,j].Top:= 4 +550*(i-1);
      end;
    3, 4:
      begin
        Number[i,j].Caption := IntToStr(9-j);
        Number[i,j].Top:=(j)*65-15;
        Number[i,j].Left:= 4 +550*(i-3);
      end;
    end;

    end;
    polog[1]:=1;
    polog[2]:=5;
    Figures[1]:=TKING.OOO(polog);
    polog[1]:=1;
    polog[2]:=4;
    Figures[2]:=TQUEEN.OOO(polog);
    polog[1]:=1;
    polog[2]:=3;
    Figures[3]:=TBISHOP.OOO(polog);
    polog[1]:=1;
    polog[2]:=6;
    Figures[4]:=TBISHOP.OOO(polog);
    polog[1]:=1;
    polog[2]:=2;
    Figures[5]:=TKNIGHT.OOO(polog);
    polog[1]:=1;
    polog[2]:=7;
    Figures[6]:=TKNIGHT.OOO(polog);
    polog[1]:=1;
    polog[2]:=1;
    Figures[7]:=TROOK.OOO(polog);
    polog[1]:=1;
    polog[2]:=8;
    Figures[8]:=TROOK.OOO(polog);
    polog[1]:=2;
    polog[2]:=1;
    for i:=1 to 8 do begin
    Figures[8+i]:=Tpawn.OOO(polog);
    polog[2]:=polog[2]+1;
    end;
    polog[1]:=8;
    polog[2]:=5;
    Figures[17]:=TKING.OOO(polog);
    polog[1]:=8;
    polog[2]:=4;
    Figures[18]:=TQUEEN.OOO(polog);
    polog[1]:=8;
    polog[2]:=3;
    Figures[19]:=TBISHOP.OOO(polog);
    polog[1]:=8;
    polog[2]:=6;
    Figures[20]:=TBISHOP.OOO(polog);
    polog[1]:=8;
    polog[2]:=2;
    Figures[21]:=TKNIGHT.OOO(polog);
    polog[1]:=8;
    polog[2]:=7;
    Figures[22]:=TKNIGHT.OOO(polog);
    polog[1]:=8;
    polog[2]:=1;
    Figures[23]:=TROOK.OOO(polog);
    polog[1]:=8;
    polog[2]:=8;
    Figures[24]:=TROOK.OOO(polog);
    polog[1]:=7;
    polog[2]:=1;
    for i:=1 to 8 do begin
    Figures[8+i]:=Tpawn.OOO(polog);
    polog[2]:=polog[2]+1;
    end;



end;

{ TFigura }


constructor TFigura.OOO(value:Coordinaty);
begin
inherited Create(Chess);
parent := Chess;
if value[1] < 4
  then
    begin
      Picture.Bitmap.LoadFromResourceName(HInstance, 'BLACK_'
        + Self.ClassName);
      Fcolor:= false;
    end
  else
    begin
      Picture.Bitmap.LoadFromResourceName(HInstance, 'WHITE_'
        + Self.ClassName);
      Fcolor := true;
    end;
Width := 40; //указываем высоту нашей картинки
Height := 40; //Указываем ширину нашей картинки
transparent:=True;
Place:=value;

DragMode:=dmAutomatic;
end;

function TFigura.pryg(x: coordinaty): boolean;
var i:byte;
begin
Result :=true; {С этой строки начинается весь метод. Она необходима для начального присваивания значения результат функции. Таким образом, мы изначально разрешаем ход, а в случае найденной занятой клетки - запрещаем.}
//вертикаль
{проверка на ход по вертикали}
if self.Place[1] = x[1] then
for i:= 1 to 32 do //цикл по всем фигурам
{ищем несрубленную фигуру, координата X которой совпадает с нашей}
if (Figures[i].Place[1] = self.Place[1])
and (Figures[i] <> nil) then
{если такая найдена, то проверим находится ли она в промежутке движения фигуры}
if ((Figures[i].Place[2] > self.Place[2])
and (Figures[i].Place[2] < x[2]))
or ((Figures[i].Place[2] < self.Place[2])
and (Figures[i].Place[2] > x[2]))
then
{если и это условие выполнено, то занятая клетка найдена - ход запрещаем}
Result := false;

{if self.Place[2] = x[2] then
for i:= 1 to 32 do //цикл по всем фигурам
{ищем несрубленную фигуру, координата X которой совпадает с нашей}
{if (Figures[i].Place[2] = self.Place[2])
and (Figures[i] <> nil) then
{если такая найдена, то проверим находится ли она в промежутке движения фигуры}
{if ((Figures[i].Place[1] > self.Place[1])
and (Figures[i].Place[1] < x[1]))
or ((Figures[i].Place[1] < self.Place[1])
and (Figures[i].Place[1] > x[1]))
then
{если и это условие выполнено, то занятая клетка найдена - ход запрещаем}
{Result := false;   }
end;

procedure TFigura.SetPlace(const a: coordinaty);
begin
FPlace:=a;
Top:=(a[1]-1)*65+30;
Left:=(a[2]-1)*65+30;
end;


{ TPawn }

function TPawn.Hod(X: coordinaty): boolean;
begin
 
if self.place[2] = x[2] then
Hod:=true else Hod:=false;
end;

{ TRook }

function TRook.Hod(X: coordinaty): boolean;
begin
 if (self.place[1] = x[1])
or (self.place[2] = x[2])
then
Hod:=true
else
Hod:=false;
end;

{ TKing }

function TKing.Hod(X: coordinaty): boolean;
begin
if(abs(self.place[1]*10+self.place[2]-x[1]*10-x[2])=1) or (abs(self.place[1]*10+self.place[2]-x[1]*10-x[2])=11) or
(abs(self.place[1]*10+self.place[2]-x[1]*10-x[2])=10) or (abs(self.place[1]*10+self.place[2]-x[1]*10-x[2])=9) then
Hod:=true else Hod:=False;
end;

{ TBishop }

function TBishop.Hod(X: coordinaty): boolean;
begin
if abs(self.place[1]-x[1])=abs(self.place[2]-x[2])
then Hod:=true
else Hod:=false;
end;

{ TQueen }

function TQueen.Hod(X: coordinaty): boolean;
begin
if (self.Place[1] = X[1])
or (self.Place[2] = X[2])
or (abs(self.Place[1] - X[1]) = abs(self.Place[2] - X[2]))
then
Result := true
else
Result := false;
end;

{ TKnight }

function TKnight.Hod(X: coordinaty): boolean;
begin
 if (abs(self.place[1]-x[1])+abs(self.place[2]-x[2])=3) and
(abs(self.place[1]-x[1])>0) and (abs(self.place[2]-x[2])>0) then
Hod:=True else Hod:=False;
end;

procedure TChess.OnImageDrop(Sender, Source: TObject; X, Y: Integer);
var
Pos: coordinaty;
OldPos: coordinaty;
begin
if Sender is TShape then begin
Pos[1]:=TShape(Sender).Tag mod 10;
Pos[2]:=TShape(Sender).Tag div 10;
if (TFigura(Source).Hod(Pos)) and (TFigura(Source).pryg(Pos)) and (TFigura(Source).Fcolor = Nextturn) then
 begin
Pos[1]:=TShape(Sender).Tag mod 10;
Pos[2]:=TShape(Sender).Tag div 10;
 if NextTurn = true then
  NextTurn :=false
  else NextTurn:=true
  end else pos:=TFigura(Source).place;
end;
if Sender is TFigura then
begin
 pos:=TFigura(Sender).place;
 if (TFigura(Source).Hod(Pos))
 and (TFigura(Source).pryg(Pos))
 and (TFigura(Source).Fcolor = Nextturn)
 and (TFigura(Sender).FColor<>NextTurn) then
 begin
  pos:=TFigura(Sender).place;
  TFigura(Sender).Free;
  if NextTurn = true then
  NextTurn :=false else NextTurn :=true;
  end else pos:=TFigura(Source).place;
 end;
TFigura(Source).Place:=Pos;



end;

procedure TChess.OnImageOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
Accept := true;
end;

function TChess.Shah(color: boolean): boolean;
var I: byte;
King: integer;
begin
Result := false;
//найдем необходимого короля
for i := 1 to 32 do
if (Figures[i] is TKing)
and (Figures[i].Fcolor <> color)
then
King := i;
//проверим выполняемость всех описанных выше условий
for I := 1 to 32 do
if Figures[i]<>nil then
if (Figures[i].Fcolor<>Figures[king].Fcolor)
and Figures[i].Hod(Figures[king].place)
and Figures[i].pryg(Figures[king].place) then begin
ShowMessage('шах!');
Result := true;
end;

end;

end.

[lim0n]

Не силён в Delphi (действует ли порядок сокращённого вычисления логических выражений?), но может в условии

function TFigura.pryg(x: coordinaty): boolean;
...
if (Figures[i].Place[1] = self.Place[1])
and (Figures[i] <> nil) then
...

сначала проверить существование фигуры, а потом проверять её положение.
Не смотрится тип Coordinaty. Почему массив, а не структура? И квадратных скобок было бы поменьше, и код понятнее, ср. place[1] и place.x

[hurtsy]

Natalya23 в сообщении #568675 писал(а):

Не могу разобраться с процедурой проверки перепрыгивания,

Надо добавить картинки - shapes, а самому рисовать не хочется. почему же не помочь. С уважением.

[Natalya23]

Поменяла местами условие, теперь работает Спасибо
Я не могу вам здесь файл с картинками отправить, у меня не получается

-- Вт май 08, 2012 20:20:33 --

У меня в задании такие типы для координат, цвета и формы стоят, я не могу делать не через массивы(сама сначала путалась.

[Natalya23]

помогите, пожалуйста, реализовать проверку перепрыгивания по диагонали

[Joker_vD]

И это, в Delphi есть замечательная возможность: метаклассы.

type
  TFiguraClass = class of TFigura;

const
  InitialPosition: Array[1..8,1..8] of TFiguraClass = [
    TRook, TKnight, TBishop, TQueen, TKing, TBishop, TKnight, TRook,
    TPawn, TPawn, TPawn, TPawn, TPawn, TPawn, TPawn, TPawn,
    nil, nil, nil, nil, nil, nil, nil, nil, {...} ];

For I := 1 To 8 Do
  For J := 1 To 8 Do
    If InitialPosition[I, J] <> nil
    Then Field[I, J] := InitialPosition[I, J].Create;

Можно и с цветами что-нибудь придумать. Например, держать массив не TFiguraClass а из Record Figura: TFiguraClass; Color: TChessColor; End... много чего!

(Оффтоп)

И это, пишите уж либо сразу на русском или сразу на английском? TPiece, TPawn или TFigura, TPeshka...

[hurtsy]

Попробуйте

polog[1]:=7;
    polog[2]:=1;
    for i:=1 to 8 do begin
    Figures[8+i]:=Tpawn.OOO(polog);
    polog[2]:=polog[2]+1;

изменить

polog[1]:=7;
    polog[2]:=1;
    for i:=1 to 8 do begin
    Figures[24+i]:=Tpawn.OOO(polog);
    polog[2]:=polog[2]+1;

Вы используете дебагер, или уверенны во всемогуществе копипаста.
С уважением,

[Hasar1n]

Есть хорошая книга: программирование шахмат и других логических игр. Там есть все, что вам нужно.

[arseniiv]

lim0n в сообщении #568745 писал(а):

действует ли порядок сокращённого вычисления логических выражений?

Да.