Блок-схема

unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons, Menus,
Draughts, VChessBoard, Unit1;
type
TfmCheckers = class(TForm)
Timer1: TTimer;
pnRight: TPanel;
MainMenu1: TMainMenu;
miFile: TMenuItem;
miGame: TMenuItem;
miHelp: TMenuItem;
miAbout: TMenuItem;
miExit: TMenuItem;
miStartLocalGame: TMenuItem;
pnChessBoard: TPanel;
lbedBlackName: TLabeledEdit;
lbedWhiteName: TLabeledEdit;
Label1: TLabel;
Label2: TLabel;
stCurrentPlayer: TStaticText;
Label3: TLabel;
stTimer: TStaticText;
miCancelGame: TMenuItem;
procedure miExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure miStartLocalGameClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure miCancelGameClick(Sender: TObject);
procedure miAboutClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
vcbChess:TVisualChessBoard;
PlayerSide, CurrentPlayer:Integer;
IsDraughtChosen:Boolean;
DraughtPosition:TCellPosition;
StrikeMode:Boolean;
PlayTime:Integer;
StartTime:TDateTime;
LocalGame:Boolean;
procedure vcbChessMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure vcbChessMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure vcbChessMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Procedure TrySelectNewDraught(x, y:Integer);
Procedure TryMakeStrike(x, y:Integer);
Procedure SwitchCurrentPlayer;
Function CheckForWin:Integer;
end;
var
fmCheckers: TfmCheckers;
implementation
uses About;
{$R *.dfm}
procedure TfmCheckers.miExitClick(Sender: TObject);
begin
Close;
end;
procedure TfmCheckers.FormCreate(Sender: TObject);
begin
vcbChess:=TVisualChessBoard.Create(pnChe ssBoard);
vcbChess.Parent:=pnChessBoard;
vcbChess.Left:=8;
vcbChess.Top:=8;
vcbChess.Width:=1200;
vcbChess.Height:=1200;
vcbChess.OnMouseMove:=vcbChessMouseMove;
vcbChess.OnMouseDown:=vcbChessMouseDown;
vcbChess.OnMouseUp:=vcbChessMouseUp;

vcbChess.Refresh;
end;

procedure TfmCheckers.FormResize(Sender: TObject);
Var
CellSize:Integer;
begin
If pnChessBoard.Width<pnChessBoard.Height Then
CellSize:=(pnChessBoard.Width-16) div 8
Else
CellSize:=(pnChessBoard.Height-16) div 8;

vcbChess.Left:=8;
vcbChess.Top:=8;
vcbChess.Width:=CellSize*8;
vcbChess.Height:=CellSize*8;
vcbChess.Refresh;
If IsDraughtChosen Then
TrySelectNewDraught(DraughtPosition.X, DraughtPosition.Y);
end;

procedure TfmCheckers.vcbChessMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
Var
xP, yP:Integer;
begin
vcbChess.Cursor:=crDefault;

vcbChess.GetCellNumberByCoord(X, Y, xP, yP);

If vcbChess.Board.GetDraught(xP, yP)<>nil Then
Begin
If vcbChess.Board.GetDraught(xP, yP).Side=PlayerSide Then
vcbChess.Cursor:=crHandPoint
End;
end;

procedure TfmCheckers.vcbChessMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var
xP, yP:Integer;
begin
If StrikeMode Then Exit;

vcbChess.GetCellNumberByCoord(X, Y, xP, yP);

If Not(IsDraughtChosen) Then //Если еще нет выбранной шашки
Begin
TrySelectNewDraught(xP, yP);
End
Else Begin //Если уже есть выбранная шашка
If vcbChess.Board.GetDraught(xP, yP)=nil Then
Begin //Если клетка пустая, то обработаем как отпускание мыши
vcbChessMouseUp(Sender, Button, Shift, X, Y);
End
Else Begin //Если там стоит наша шашка, то сбросим выбор и рекурсируем
If vcbChess.Board.GetDraught(xP, yP).Side=PlayerSide Then
Begin
vcbChess.Refresh;
IsDraughtChosen:=False;
vcbChessMouseDown(Sender, Button, Shift, X, Y);
End;
End;
End;
end;

procedure TfmCheckers.vcbChessMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var
xP, yP:Integer;
Moves, Strikes, Strickens:TList;
begin
vcbChess.GetCellNumberByCoord(X, Y, xP, yP);

If IsDraughtChosen Then //Если есть выбранная шашка
Begin
//Проверим: можно ли в принципе шагнуть сюда
If vcbChess.Board.GetDraught(xP, yP)<>nil Then Exit;
//Клетка пустая
//Проверим правильность хода в эту клетку
vcbChess.Board.FindMoves(DraughtPosition .X, DraughtPosition.Y, Moves, Strikes, Strickens);
If Strikes.Count=0 Then //Нет рубки - пытаемся просто ходить
Begin
If CheckPosition(xP, yP, Moves)>=0 Then //Ход верен!
Begin
vcbChess.Board.MoveDraught(DraughtPositi on.X, DraughtPosition.Y, xP, yP);
IsDraughtChosen:=False;
vcbChess.Refresh;
vcbChessMouseMove(Sender, Shift, X, Y);

SwitchCurrentPlayer; //Ход сделан - переключем игрока
CheckForWin;
End;
End
Else Begin //Есть возможность рубки - обязательно!
TryMakeStrike(xP, yP);
End;
ClearMoves(Moves);
ClearMoves(Strikes);
ClearMoves(Strickens);
End
Else Begin //Шашка не еще выбрана

End;
end;

Procedure TfmCheckers.TrySelectNewDraught(x, y:Integer);
Var
Moves, Strikes, Strickens:TList;
StrikingDraughts:TList;
Begin
If vcbChess.Board.GetDraught(x, y)=nil Then Exit;
If vcbChess.Board.GetDraught(x, y).Side<>PlayerSide Then Exit;
//Проверим обязательные рубки
StrikingDraughts:=vcbChess.Board.FindStr ikingDraughts(PlayerSide);
If StrikingDraughts.Count>0 Then
Begin
If CheckPosition(x, y, StrikingDraughts)<0 Then
Begin
ClearMoves(StrikingDraughts);
Exit;
End;
End;
ClearMoves(StrikingDraughts);

DraughtPosition.X:=x;
DraughtPosition.Y:=y;
IsDraughtChosen:=True;
//Отрисуем возможные ходы с учетом обязаловки рубки
vcbChess.Board.FindMoves(x, y, Moves, Strikes, Strickens);
If Strikes.Count=0 Then
vcbChess.DrawMoves(Moves, nil)
Else
vcbChess.DrawMoves(nil, Strikes);
ClearMoves(Moves);
ClearMoves(Strikes);
ClearMoves(Strickens);
End;

Procedure TfmCheckers.TryMakeStrike(x, y:Integer);
Var
Moves, Strikes, Strickens:TList;
CP:PCellPosition;
Begin
If Not(IsDraughtChosen) Then Exit;
vcbChess.Board.FindMoves(DraughtPosition .X, DraughtPosition.Y, Moves, Strikes, Strickens);
//Возможна ли рубка в данную клетку
If CheckPosition(x, y, Strikes)>=0 Then //Рубка верна!
Begin //рубим
//Определим срубленную шашку
CP:=Strickens.Items[CheckPosition(x, y, Strikes)];
vcbChess.Board.DeleteDraught(CP^.X, CP^.Y);
//Перескакиваем
vcbChess.Board.MoveDraught(DraughtPositi on.X, DraughtPosition.Y, x, y);
DraughtPosition.X:=x; DraughtPosition.Y:=y;

ClearMoves(Moves);
ClearMoves(Strikes);
ClearMoves(Strickens);

//Определим: возможно ли продолжение рубки
vcbChess.Board.FindMoves(DraughtPosition .X, DraughtPosition.Y, Moves, Strikes, Strickens);
If Strikes.Count>0 Then
Begin
StrikeMode:=True; //Установим режим рубки
End
Else Begin
StrikeMode:=False;
SwitchCurrentPlayer; //Закончена рубка - переключим игрока
End;

ClearMoves(Moves);
ClearMoves(Strikes);
ClearMoves(Strickens);

vcbChess.Refresh;
End;

If StrikeMode Then
Begin
IsDraughtChosen:=False;
TrySelectNewDraught(DraughtPosition.X, DraughtPosition.Y);
End;

CheckForWin;
End;

Procedure TfmCheckers.SwitchCurrentPlayer;
Begin
If CurrentPlayer=sdWhite Then CurrentPlayer:=sdBlack Else CurrentPlayer:=sdWhite;
If LocalGame Then PlayerSide:=CurrentPlayer;

If CurrentPlayer=sdWhite Then stCurrentPlayer.Caption:='Белые' Else stCurrentPlayer.Caption:='Черные';
If PlayerSide=CurrentPlayer Then
Begin
pnChessBoard.Enabled:=True;
End
Else Begin
pnChessBoard.Enabled:=False;
End;
End;

Function TfmCheckers.CheckForWin:Integer;
Begin
Result:=-1;
//Проверим победу по срубам
If vcbChess.Board.CountDraughts(sdWhite)=0 Then
Begin
Result:=sdBlack;
End;
If vcbChess.Board.CountDraughts(sdBlack)=0 Then
Begin
Result:=sdWhite;
End;
//Проверим победу по блокировкам
If Not(vcbChess.Board.AbleToMove(CurrentPla yer)) Then
If CurrentPlayer=sdWhite Then Result:=sdBlack Else Result:=sdWhite;

If Result<0 Then Exit;
//Game Over!
miCancelGameClick(Self);
Case Result Of
sdWhite: Application.MessageBox('Победила команда "Белых"', 'Победили Белые!', MB_OK+MB_ICONINFORMATION);
sdBlack: Application.MessageBox('Победила команда "Черных"', 'Победили Черные!', MB_OK+MB_ICONINFORMATION);
End;
End;

procedure TfmCheckers.Timer1Timer(Sender: TObject);
begin
// Inc(PlayTime);
// stTimer.Caption:=Format('%d:%.2d:%.2d', [PlayTime div 3600, (PlayTime mod 3600) div 60, (PlayTime mod 3600) mod 60]);
stTimer.Caption:=TimeToStr(Now-StartTime);
end;

procedure TfmCheckers.miStartLocalGameClick(Sender : TObject);
begin
LocalGame:=True;

lbedWhiteName.ReadOnly:=True;
lbedBlackName.ReadOnly:=True;

// PlayTime:=0;
StartTime:=Now;
PlayerSide:=sdWhite;
CurrentPlayer:=sdBlack;
IsDraughtChosen:=False;
StrikeMode:=False;

vcbChess.Board.Respawn;
vcbChess.Refresh;

pnChessBoard.Enabled:=True;

Timer1.Enabled:=True;
SwitchCurrentPlayer;
end;


procedure TfmCheckers.miCancelGameClick(Sender: TObject);
begin
Timer1.Enabled:=False;
pnChessBoard.Enabled:=False;
lbedWhiteName.ReadOnly:=False;
lbedBlackName.ReadOnly:=False;

Application.MessageBox('Игра зкончена', 'Игра закончена', MB_OK+MB_ICONINFORMATION);
end;
procedure TfmCheckers.miAboutClick(Sender: TObject);
begin
Form1.Show;
end;
end.


помогите пожалуйста, мне еще таких же 4 чертить

0

0