Форум программистов, компьютерный форум, киберфорум
Наши страницы
Алгоритмы
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.67/3: Рейтинг темы: голосов - 3, средняя оценка - 4.67
Alex877
0 / 0 / 0
Регистрация: 10.09.2014
Сообщений: 2
1

Блок-схема

16.12.2014, 22:25. Просмотров 574. Ответов 1
Метки нет (Все метки)

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(pnChessBoard);
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(DraughtPosition.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.FindStrikingDraughts(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(DraughtPosition.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(CurrentPlayer)) 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
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
16.12.2014, 22:25
Ответы с готовыми решениями:

Блок схема
Здраствуйте,помогите пожалуйста.Сдавал Вычеслительную технику 4 года назад,всё забыл уже.. Дан...

Блок - схема
Помогите построить блок - схему

Блок-схема
Здравствуйте! Подскажите, как правильно оформить ссылку на другую страницу в блок схеме? ...

БЛОК-СХЕМА
Нужна блок-схема нижеприведенной программы, помогите! #include &lt;stdio.h&gt; #include &lt;stdlib.h&gt;...

блок схема
пожалуйста помпгите создавать этого задача блок схему Program pr1; uses crt; Type ...

1
OldFedor
16.12.2014, 22:31     Блок-схема
  #2

Не по теме:

Цитата Сообщение от Alex877 Посмотреть сообщение
мне еще таких же 4 чертить
Круто! Но слезу не выдавите.

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
16.12.2014, 22:31
Привет! Вот еще темы с ответами:

Блок-схема C++
Доброго времени суток. Помогите составить блок-схему для кода. #include &lt;iostream&gt; #include...

Блок-схема
Помогите составить блок схему по данному коду bool dfs(v: int): if (used) return...

Блок-схема
Помогите пожалуйста составить блок- схему: В массиве хранятся данные о количестве осадков в...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru