Игры (пункт 5.3) 1 вопрос

create;
Figure[x, y].Transparent:=true;
Figure[x, y].TransparentColor:=clred;
If x=0 Then
Figure[x, y].LoadFromFile('White'+FigureNames[y]+'.bmp') Else
Figure[x, y].LoadFromFile('Black'+FigureNames[y]+'.bmp');
End;
Field:=Tbitmap.Create;
Field.Width:=SquareW.Width*8+9;
Field.Height:=SquareW.Height*8+9;
Image1.Picture.Bitmap:=Field;
Image1.Width:=Field.Width;
Image1.Height:=Field.Height;
ClearField;
UpdateFigureCount;
end;

Procedure TForm1.ClearField;
// очистка поля
Var
x, y:byte;
Const
FigureCount:Array[1..6] Of byte=(8, 2, 2, 2, 1, 1);
Begin
For x:=0 To 1 Do
For y:=1 To 6 Do // нет не расставленных фигур
Figure_count[x, y]:=FigureCount[y];
Image1.Canvas.Brush.Color:=clBlack;
Image1.Canvas.FillRect(Image1.Canvas.ClipRect); // Заполнение поля черным цветом
With Image1.Canvas Do
For x:=0 To 7 Do
For y:=0 To 7 Do
Begin // Заполнение поля клетками
Field_data[x, y]:=0;
If (x*7+y)Mod 2<>0 Then
draw(x*(SquareW.Width+1)+1, y*(SquareW.Height+1)+1, SquareW) Else
draw(x*(SquareB.Width+1)+1, y*(SquareB.Height+1)+1, SquareB);
End;
WKingState.Caption:=''; BKingState.Caption:='';
End;

Procedure TForm1.UpdateFigureCount;
// обновление данных о количестве нерасставленных фигур
Begin
wPawnLabel.Caption := IntToStr(Figure_count[0,1]) + ' шт';
If Figure_count[0,1]=0 Then wPawnImage.DragMode:=dmManual Else wPawnImage.DragMode:=dmAutomatic;
wRookLabel.Caption := IntToStr(Figure_count[0,2]) + ' шт';
If Figure_count[0,2]=0 Then wRookImage.DragMode:=dmManual Else wRookImage.DragMode:=dmAutomatic;
wKnightLabel.Caption := IntToStr(Figure_count[0,3]) + ' шт';
If Figure_count[0,3]=0 Then wKnightImage.DragMode:=dmManual Else wKnightImage.DragMode:=dmAutomatic;
wBishopLabel.Caption := IntToStr(Figure_count[0,4]) + ' шт';
If Figure_count[0,4]=0 Then wBishopImage.DragMode:=dmManual Else wBishopImage.DragMode:=dmAutomatic;
wQueenLabel.Caption := IntToStr(Figure_count[0,5]) + ' шт';
If Figure_count[0,5]=0 Then wQueenImage.DragMode:=dmManual Else wQueenImage.DragMode:=dmAutomatic;
wKingLabel.Caption := IntToStr(Figure_count[0,6]) + ' шт';
If Figure_count[0,6]=0 Then wKingImage.DragMode:=dmManual Else wKingImage.DragMode:=dmAutomatic;
bPawnLabel.Caption := IntToStr(Figure_count[1,1]) + ' шт';
If Figure_count[1,1]=0 Then bPawnImage.DragMode:=dmManual Else bPawnImage.DragMode:=dmAutomatic;
bRookLabel.Caption := IntToStr(Figure_count[1,2]) + ' шт';
If Figure_count[1,2]=0 Then bRookImage.DragMode:=dmManual Else bRookImage.DragMode:=dmAutomatic;
bKnightLabel.Caption := IntToStr(Figure_count[1,3]) + ' шт';
If Figure_count[1,3]=0 Then bKnightImage.DragMode:=dmManual Else bKnightImage.DragMode:=dmAutomatic;
bBishopLabel.Caption := IntToStr(Figure_count[1,4]) + ' шт';
If Figure_count[1,4]=0 Then bBishopImage.DragMode:=dmManual Else bBishopImage.DragMode:=dmAutomatic;
bQueenLabel.Caption := IntToStr(Figure_count[1,5]) + ' шт';
If Figure_count[1,5]=0 Then bQueenImage.DragMode:=dmManual Else bQueenImage.DragMode:=dmAutomatic;
bKingLabel.Caption := IntToStr(Figure_count[1,6]) + ' шт';
If Figure_count[1,6]=0 Then bKingImage.DragMode:=dmManual Else bKingImage.DragMode:=dmAutomatic;
End;

procedure TForm1.GroupBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
if Source=Image1 then Accept:=true else Accept:=false;
end;

procedure TForm1.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
x:=(X-1)Div(SquareW.Width+1);
y:=(Y-1)Div(SquareW.Height+1);
If Field_data[x, y]=0 Then Accept:=true Else Accept:=false;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
x:=(x-1)Div(SquareW.Width+1);
y:=(y-1)Div(SquareW.Height+1);
If Field_data[x, y]>0 Then
Begin
Image1.DragMode:=dmAutomatic;
BkPosX:=x; BkPosY:=y;
image1.BeginDrag(true);
End Else image1.EndDrag(false);
end;

procedure TForm1.Image1EndDrag(Sender, Target: TObject; X, Y: Integer);
var
k:byte;
begin
Image1.DragMode:=dmManual;
k:=Field_data[BkPosX, BkPosY];
If Target=Image1 Then
Begin
x:=(x-1)Div(SquareW.Width+1);
y:=(y-1)Div(SquareW.Height+1);
If k=6 Then
Begin
WhiteX:=x; WhiteY:=y;
End
Else
If k=13 Then
Begin
BlackX:=x; BlackY:=y;
End;
Field_data[BkPosX, BkPosY]:=0;
Field_data[x, Y]:=k;
End Else
If target<>Nil Then
Begin
Field_data[BkPosX, BkPosY]:=0;
inc(Figure_count[k Div 7, k-(k Div 7)*7]);
UpdateFigureCount;
End;
RefreshField;
end;

Procedure TForm1.RefreshField;
//обновление изображения поля
Var
x, y:byte;
Begin
Image1.Canvas.Brush.Color:=clblack;
Image1.Canvas.FillRect(Image1.Canvas.ClipRect); // Заполнение поля черным цветом
With Image1.Canvas Do
For x:=0 To 7 Do
For y:=0 To 7 Do
Begin// Заполнение поля клетками
If (x*7+y)Mod 2<>0 Then
draw(x*(SquareW.Width+1)+1, y*(SquareW.Height+1)+1, SquareW) Else
draw(x*(SquareB.Width+1)+1, y*(SquareB.Height+1)+1, SquareB);
If Field_data[x, y]>0 Then
self.DrawFigure(x, y, Figure[Field_data[x, y]Div 7, Field_data[x, y]-(Field_data[x, y]Div 7)*7]);
End;
BoardAnalysis;
End;

Procedure TForm1.DrawFigure(x, y:byte; Figure:Tbitmap);
// рисует фигуру в клетке x, y
Var
a, b:integer;
Begin
a:=(SquareW.Width-Figure.Width)Div 2;
b:=(SquareW.Height-Figure.Height)Div 2;
Image1.Canvas.Draw(x*(SquareW.Width+1)+1+a, y*(SquareW.Width+1)+1+b, Figure)
End;

procedure TForm1.BPawnImageEndDrag(Sender, Target: TObject; X, Y: Integer);
Var
FigIndex:byte;
colorIndex:byte;
begin
If Target<>Image1 Then exit;
x:=(x-1)Div(SquareW.Width+1);
y:=(y-1)Div(SquareW.Height+1);
If Sender=wPawnImage Then begin FigIndex:=1; colorIndex:=0; end Else
If Sender=wRookImage Then begin FigIndex:=2; colorIndex:=0; end Else
If Sender=wKnightImage Then begin FigIndex:=3; colorIndex:=0; end Else
If Sender=wBishopImage Then begin FigIndex:=4; colorIndex:=0; end Else
If Sender=wQueenImage Then begin FigIndex:=5; colorIndex:=0; end Else
If Sender=wKingImage Then begin FigIndex:=6; colorIndex:=0; WhiteX:=x; WhiteY:=y; end Else
If Sender=bPawnImage Then begin FigIndex:=1; colorIndex:=1; end Else
If Sender=bRookImage Then begin FigIndex:=2; colorIndex:=1; end Else
If Sender=bKnightImage Then begin FigIndex:=3; colorIndex:=1; end Else
If Sender=bBishopImage Then begin FigIndex:=4; colorIndex:=1; end Else
If Sender=bQueenImage Then begin FigIndex:=5; colorIndex:=1; end Else
If Sender=bKingImage Then begin FigIndex:=6; colorIndex:=1; BlackX:=x; BlackY:=y;
end;

Field_data[x, y]:=colorIndex*7+FigIndex;
dec(Figure_count[colorIndex, FigIndex]);
UpdateFigureCount;
RefreshField;
end;

Procedure TForm1.BoardAnalysis;
Var
CheckW, CheckB:boolean;
MateW, MateB:boolean;
x, y:byte;
Fig:byte;
Procedure Gamp(a, b:byte; isWhite:boolean);
Var
Cw, CB:boolean;
temp:byte;
Begin
temp:=Field_data[a, b];
If isWhite Then
Begin
Field_data[a, b]:=Field_data[WhiteX, WhiteY]; Field_data[WhiteX, WhiteY]:=0;
End Else
Begin
Field_data[a, b]:=Field_data[BlackX, BlackY]; Field_data[BlackX, BlackY]:=0;
End;
AnalysePosition(Cw, CB, false);
If Not MateW Then MateW:=(Not Cw)And(isWhite);
If Not MateB Then MateB:=(Not Cb)And(Not isWhite);
If ((Not Cw)And(isWhite))Or((Not Cb)And(Not isWhite)) Then SelectCell(a, b, clLime);
If isWhite Then
Field_data[WhiteX, WhiteY]:=Field_data[a, b] Else
Field_data[BlackX, BlackY]:=Field_data[a, b];
Field_data[a, b]:=temp;
End;
Begin
CheckW:=false; CheckB:=False;
WKingState.Caption:=''; BKingState.Caption:='';
AnalysePosition(CheckW, CheckB);
If CheckW Then
Begin
MateW:=false;
For y:=max(0,WhiteY-1) To min(WhiteY+1,7) Do
For x:= max(0,WhiteX-1) To min(WhiteX+1,7) Do
Begin
Fig:=Field_data[x, y];
If (Not((x=WhiteX)And(y=WhiteY)))And((Fig=0)Or(Fig>7)) Then
Gamp(x, y, true);
End;
If MateW Then WKingState.Caption:='ШАХ' Else WKingState.Caption:='МАТ';
End;
If CheckB Then
Begin
MateB:=false;
For y:=max(0,BlackY-1) To min(BlackY+1,7) Do
For x:= max(0,BlackX-1) To min(BlackX+1,7) Do
Begin
Fig:=Field_data[x, y];
If (Not((x=BlackX)And(y=BlackY)))And(Fig<8) Then
Gamp(x, y, false);
End;
If MateB Then BKingState.Caption:='ШАХ' Else BKingState.Caption:='МАТ';
End;
End;

Procedure TForm1.AnalysePosition(Var White, Black:boolean; Colored:boolean=true);
Var
x, y, Figure_type:byte;
c:Tcolor; // Цвет выделения
k:boolean; // временная переменная
Begin
White:=false;
Black:=false;
For y:=0 To 7 Do
For x:=0 To 7 Do
If Field_data[x, y]>0 Then
Begin
Figure_type:=Field_data[x, y]-(Field_data[x, y]Div 7)*7;
If Field_data[x, y]Div 7=0 Then c:=clRed Else c:=clBlue;
k:=false;
Case Figure_type Of
1:If PawnAttackKing(x, y) Then
Begin
k:=true; If colored Then SelectCell(x, y, c);
End;
2:If RookAttackKing(x, y) Then
Begin
k:=true; If colored Then SelectCell(x, y, c);
End;
3:If KnightAttackKing(x, y) Then
Begin
k:=true; If colored Then SelectCell(x, y, c);
End;
4:If BishopAttackKing(x, y) Then
Begin
k:=true; If colored Then SelectCell(x, y, c);
End;
5:If QueenAttackKing(x, y) Then
Begin
k:=true; If colored Then SelectCell(x, y, c);
End;
6:If KingAttackKing(x, y) Then
Begin
k:=true; If colored Then SelectCell(x, y, c);
End;
End;
If (k)And(Field_data[x, y]Div 7=1) Then White:=true;
If (k)And(Field_data[x, y]Div 7=0) Then Black:=true;
End;
End;

Function TForm1.PawnAttackKing(x, y:smallint):boolean;
Var
WorB:boolean; // белая или черная фигура
Begin
result:=false;
WorB:=Odd(Field_data[x, y]Div 7);
If (Not WorB)And(y>0) Then // белые снизу
Begin
If ((x>0)And(Field_data[x-1, y-1]=13))Or((x<7)And(Field_data[x+1, y-1]=13)) Then
result:=true;
End Else
If (y<7)And(WorB) Then // черные сверху
Begin
If ((x>0)And(Field_data[x-1, y+1]=6))Or((x<7)And(Field_data[x+1, y+1]=6)) Then
result:=true;
End;
End;

Function TForm1.KnightAttackKing(x, y:smallint):boolean;
Var
WorB:boolean; // белая или черная фигура
Begin
result:=false;
WorB:=Not Odd(Field_data[x, y]Div 7);
If (x<6) Then
Begin
If ((y>0)And(Field_data[x+2, y-1]=BorWKing[WorB]))Or((y<7)And(Field_data[x+2, y+1]=
BorWKing[WorB])) Then result:=true;
End;
If (x>1)And(Not result) Then
Begin
If ((y>0)And(Field_data[x-2, y-1]=BorWKing[WorB]))Or((y<7)And(Field_data[x-2, y+1]=
BorWKing[WorB])) Then result:=true;
End;
If (Y>1)And(Not result) Then
Begin
If ((X>0)And(Field_data[x-1, y-2]=BorWKing[WorB]))Or((x<7)And(Field_data[x+1, y-2]=
BorWKing[WorB])) Then result:=true;
End;
If (Y<6)And(Not result) Then
Begin
If ((X>0)And(Field_data[x-1, y+2]=BorWKing[WorB]))Or((x<7)And(Field_data[x+1, y+2]=
BorWKing[WorB])) Then result:=true;
End;
End;

Function TForm1.RookAttackKing(x, y:smallint):boolean;
Var
WorB:boolean; // белая или черная фигура
a:smallint;
Begin
result:=false;
WorB:=Not Odd(Field_data[x, y]Div 7);
If x<7 Then
For a:=x+1 To 7 Do
If Field_data[a, y]=BorWKing[WorB] Then
Begin
result:=true; break;
End Else
If Field_data[a, y]<>0 Then break;
If (Not result)And(x>0) Then
For a:=x-1 Downto 0 Do If Field_data[a, y]=BorWKing[WorB] Then
Begin
result:=true; break;
End Else
If Field_data[a, y]<>0 Then break;
If (Not result)And(y<7) Then
For a:=y+1 To 7 Do If Field_data[x, a]=BorWKing[WorB] Then
Begin
result:=true; break;
End Else
If Field_data[x, a]<>0 Then break;
If (Not result)And(y>0) Then
For a:=y-1 Downto 0 Do If Field_data[x, a]=BorWKing[WorB] Then
Begin
result:=true; break;
End Else
If Field_data[x, a]<>0 Then break;
End;

Function TForm1.BishopAttackKing(x, y:smallint):boolean;
Var
WorB:boolean; // белая или черная фигура
a, b:smallint; // временные величины
Begin
result:=false;
WorB:=Not Odd(Field_data[x, y]Div 7);
a:=x+1; b:=y+1;
If (x<7)And(y<7) Then
While (a<=7)And(b<=7) Do
Begin
If Field_data[a, b]=BorWKing[WorB] Then
Begin
result:=true; break;
End Else
If Field_data[a, b]<>0 Then break;
inc(a); inc(b);
End;
a:=x-1; b:=y-1;
If (Not result)And(x>0)And(y>0) Then
While (a>=0)And(b>=0) Do
Begin
If Field_data[a, b]=BorWKing[WorB] Then
Begin
result:=true; break;
End Else
If Field_data[a, b]<>0 Then break;
dec(a); Dec(b);
End;
a:=x-1; b:=y+1;
If (Not result)And(x>0)And(y<7) Then
While (a>=0)And(b<=7) Do
Begin
If Field_data[a, b]=BorWKing[WorB] Then
Begin
result:=true; break;
End Else
If Field_data[a, b]<>0 Then break;
dec(a); inc(b);
End;
a:=x+1; b:=y-1;
If (Not result)And(x<7)And(y>0) Then
While (a<=7)And(b>=0) Do
Begin
If Field_data[a, b]=BorWKing[WorB] Then
Begin
result:=true; break;
End Else
If Field_data[a, b]<>0 Then break;
inc(a); Dec(b);
End;
End;

Function TForm1.QueenAttackKing(x, y:smallint):boolean;
Begin
If BishopAttackKing(x, y)Or RookAttackKing(x, y) Then result:=true Else result:=false;
End;

Function TForm1.KingAttackKing(x, y:smallint):boolean;
Var
i, j:smallint; // белая или черная фигура
Begin
result:=false;
For j:=max(0,y-1) To min(y+1,7) Do
For i:= max(0,x-1) To min(x+1,7) Do
Begin
If (Not((i=x)And(j=y)))And((Field_data[i,j]=6)Or(Field_data[i,j]=13)) Then
result:=true;
End;
End;

Procedure TForm1.SelectCell(x, y:integer; color:Tcolor);
// выделяет клетку цветной рамкой
Begin
Image1.Canvas.Brush.Style:=bsclear;
Image1.Canvas.pen.Width:=2;
Image1.Canvas.pen.Color:=color;
x:=x*(SquareW.Width+1)+2;
y:=y*(SquareW.Height+1)+2;
if (Image1.Canvas.Pixels[x,y]=clRed) Or (Image1.Canvas.Pixels[x,y]=clBlue) then
Image1.Canvas.Rectangle(x+3, y+3, x+SquareW.Width-4, y+SquareW.Height-4)
else
Image1.Canvas.Rectangle(x, y, x+SquareW.Width-1, y+SquareW.Height-1);
End;

procedure TForm1.N3Click(Sender: TObject);
begin
ClearField;
UpdateFigureCount;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.N2Click(Sender: TObject);
// Расстановка фигур случайным образом
Var
x, y, CurrentInstal:integer;
NoFigure, a, b,
PlacedCount:byte;
begin
Randomize;
PlacedCount:=0; // общее количество расставленных фигур
NoFigure:=Random(23); // количество фигур которые не будут расставлены на поле
ClearField; // Очистка поля
Repeat
Repeat
If Figure_count[0, 6]>0 Then
Begin
a:=0; b:=6;
End Else
If Figure_count[1, 6]>0 Then
Begin
a:=1; b:=6;
End Else
Begin
a:=Random(29)Div 15; // случайное число или 0 для белых или 1 для черных
b:=Random(16)Div 3+1; // случайное число 1 до 6 для выбора той или иной фигуры
End;
CurrentInstal:=Figure_count[a, b];
If Figure_count[a, b]>0 Then dec(Figure_count[a, b]) Else CurrentInstal:=-1;
Until CurrentInstal>0;
Repeat
x:=Random(8); // выбор клетки
y:=Random(8); // выбор клетки
Until Field_data[x, y]=0;
DrawFigure(x, y, Figure[a, b]);
Field_data[x, y]:=a*7+b;
If b=6 Then
Begin
If a=0 Then
Begin
WhiteX:=x; WhiteY:=y;
End Else
Begin
BlackX:=x; BlackY:=y;
End;
End;
inc(PlacedCount);
Until PlacedCount>=32-NoFigure;
UpdateFigureCount;
BoardAnalysis;
end;

End.








2