2014 dxdy logo

Научный форум dxdy

Математика, Физика, Computer Science, Machine Learning, LaTeX, Механика и Техника, Химия,
Биология и Медицина, Экономика и Финансовая Математика, Гуманитарные науки

» » »




  Пред. тема | След. тема 
Natalya23 
 Шахматы. Ход пешки
Сообщение18.05.2012, 06:53 
Шахматы на Делфи. Помогите, пожалуйста, найти ошибки в ходе пешки. :oops: Не работает(((
Код:
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[24+i]:=Tpawn.OOO(polog);
    polog[2]:=polog[2]+1;
    end;



end;

{ TFigura }


constructor TFigura.OOO(value:Coordinaty);
begin
Create(Chess);
parent := Chess;
DragMode:=dmAutomatic;
OnDragDrop:=Chess.OnImageDrop;
OnDragOver:=Chess.OnImageOver;
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;

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] <> nil)
and ( Figures[i].Place[1] = self.Place[1]) 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] <> nil)
and (Figures[i].Place[2] = self.Place[2])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;

if abs(Self.Place[2] - x[2]) = abs(Self.FPlace[1] - x[1])
      then
      for i:= 1 to 32 do
      if (Figures[i] <> nil) and
        (((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]))) and
        (((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]))) and
        (abs(Figures[i].Place[2] - x[2]) = abs
          (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;
var
  fd: Boolean;
  i: Byte;
begin
fd := true;
  for i := 1 to 32 do
  begin
    if (Figures[i] <> nil) and (Figures[i].Color <> Self.Color) and
      (Figures[i].Place[1] = X[1]) and (X[2] = Figures[i].Place[2]) then
      fd := false;
  end;
if (fd) then
  begin
    result := false;
    if (Color) then
    begin
      if (self.Place[2] = 7) then
        if((self.Place[2] - X[2] = 1) or (self.Place[2] - X[2] = 2))
        and (self.Place[1] = X[1]) then
        hod:=true
      else
        if(self.Place[2] - X[2] = 1) and (self.Place[1] = X[1]) then
        hod:=true;
    end
    else
    begin
      if (self.Place[2] = 2) then
        if ((X[2] - self.Place[2] = 1) or (X[2] - self.Place[2] = 2))
        and (self.Place[1] = X[1])then
        hod:=true
      else
        if (X[2] - self.Place[2] = 1) and (self.Place[1] = X[1])then
        hod:=true;
    end;
   // if () then
   //   result := false;
  end
  else
  begin
    if (Color) then
      result := (abs(self.Place[1] - X[1]) = 1) and (self.Place[2] - X[2] = 1)
    else
      result := (abs(self.Place[1] - X[1]) = 1) and (X[2] - self.Place[2] = 1)}
  end;
{if self.place[2] = x[2] then
Hod:=true else Hod:=false;
  end; }
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;
OldPos:=TFigura(Source).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;
{Shah(NextTurn);
if NextTurn = true
then
NextTurn := false
else
NextTurn := true              }


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.
 
 
Natalya23 
 Re: Шахматы. Ход пешки
Сообщение18.05.2012, 08:04 
Спасибо, разобралась, подскажите, пожалуйста, куда прописать рокировку.
 
 
Natalya23 
 Re: Шахматы. Ход пешки
Сообщение18.05.2012, 08:04 
Спасибо, разобралась, подскажите, пожалуйста, куда прописать рокировку.
 
 
Natalya23 
 Re: Шахматы. Ход пешки
Сообщение18.05.2012, 09:17 
Помогите, пожалуйста, как и куда лучше прописать рокировку и в каком месте в процедуре TChess.OnImageDrop вызвать процедуру Sash :oops:

-- Пт май 18, 2012 12:47:56 --

Я вставила вот так:
Код:
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;
OldPos:=TFigura(Source).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;
Shah(NextTurn);
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;

Но при этом у меня получается, что когда король под шахом, фигуры все равно могут ходить.Надо сделать запрет хода, помогите, пожалуйста :oops:
 
 
arseniiv 
 Re: Шахматы. Ход пешки
Сообщение18.05.2012, 23:46 
Радикальный совет переписать всё заново, как понимаю, не подойдёт? :-)
 
 
Natalya23 
 Re: Шахматы. Ход пешки
Сообщение19.05.2012, 21:34 
Теперь все работает, кроме шаха. Когда фигуре шах, то выводится сообщение, но игру продолжить можно.Не подскажете, как запрерить ходить фигурам, если при этом остается королю шах

-- Вс май 20, 2012 00:35:29 --

arseniiv в сообщении #573109 писал(а):
Радикальный совет переписать всё заново, как понимаю, не подойдёт? :-)


разве все так плохо?
 
 
arseniiv 
 Re: Шахматы. Ход пешки
Сообщение20.05.2012, 18:15 
Natalya23 в сообщении #573434 писал(а):
разве все так плохо?
По-моему.
 
 
Natalya23 
 Re: Шахматы. Ход пешки
Сообщение20.05.2012, 21:24 
а можно конкретнее
 
 
hurtsy 
 Re: Шахматы. Ход пешки
Сообщение20.05.2012, 21:29 
arseniiv в сообщении #573109 писал(а):
Радикальный совет переписать всё заново, как понимаю, не подойдёт? :-)


В принципе, если у ТС не поднимается рука, можно применять метод перевода операторов в комментарий. Например в
Код:
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[24+i]:=Tpawn.OOO(polog);
    polog[2]:=polog[2]+1;
    end;
}


end;


На доске два короля. Попытка перевести короля на соседнюю клетку приводит к непредсказуемым скачкам. Получается очень забавная игра, перевести белого короля в гости к черному. :D Возможна задача о погоне.
Таким образом можно будет обучить ходить любую фигуру.
Код
Код:
a[i,9-j]
можно записать
Код:
a[i,j]
. Что бы это увидеть в двойном цикле инициализации клеток доски перед $end$ вставьте
Код:
if i>2 and j>3 then exit;
Меняйте ограничители и увидите от чего зависит заполнение доски.
Зря вы занялись установкой стандартной исходной позиции. Очень полезно устанавливать заданную позицию( задачи,этюды) С уважением,
 
 
arseniiv 
 Re: Шахматы. Ход пешки
Сообщение20.05.2012, 23:42 
Natalya23 в сообщении #573859 писал(а):
а можно конкретнее
Код слишком длинён, и потому никак. Много причин.
 
 
 Страница 1 из 1
  [ Сообщений: 10 ] 

Список форумов » Тематические обсуждения » Computer Science » Программирование


Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group