Игры (пункт 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.