3.3. Процесс отладки программы
Отладка программы – это завершающая стадия разработки. Именно на этой стадии разработки программы происходит комплексное тестирование работоспособности и надежности программного продукта. Как правило, первоначально комплексная отладка производиться разработчиком. Только разработчик, зная все тонкости разработки, может выявить те недостатки в работе программы, которые могут возникнуть через несколько недель.
Программа построена таким образом, чтобы действия пользователя не приводили к повреждению самой программы. При неправильных действиях со стороны пользователя программа предупреждает его об этом.
Необходимо проверить, действительно ли правильно программа работает именно так, как было задумано при разработке программы. Для этого было проведено комплексное тестирование программы. В главной форме разместили корабли и провели одну партию игры. Во время игры выводится вся статистика, соперник действует также без ошибок.
При входе в программу можно увидеть главную форму (см. рисунок 1)
рис. 1
В ходе отладки программы трудностей не возникло. Нарушений работы программы замечено не было, как на компьютере разработчика, так и на компьютерах лаборатории вычислительного центра.
3.4. Анализ результатов решения задачи
Результатом разработки, проведенной в данном курсовом проекте, стала система, удовлетворяющая следующим требованиям:
разработанная система полностью реализует основные возложенные на нее функции;
система оснащена дружеским интерфейсом;
разработанная система является интегрированной;
программа имеет хороший дизайн.
оптимизироваться для использования ее на компьютере со средней производительностью, с помощью разделения программы на отдельные модули;
позволяет пользоваться ею одному игроку за счет присутствия в программе элементов искусственного интеллекта
В целом цель, поставленная в начале курсового проектирования, была достигнута. В программу вошли практически все необходимые требования для пользователя.
Несмотря на предполагаемые изменения в программе уже на данном этапе разработки система является полноценным программным продуктом, который после прохождения им заключающей стадии разработки – тестирования на стадии разработчика, может быть использована для предоставления необходимой информации для рядовых пользователей.
3.5. Инструкция пользователя
При входе в программу появляется, мы видим главную форму.
Пункт меню Файл - Настройки отвечает за установление настроек программы.
Затем при помощи размещаются корабли на правом игровом поле.
Ход делается также при помощи мыши – ей отмечается выбранная пользователем для удара клетка на левом игровом поле. Если промах – то она отмечается синим цветом, если попадание – красным, уничтоженные корабли отмечаются темно-красным цветом. Клетки, прилежащие непосредственно к кораблю, выделяются.
После завершения игры её можно сохранить в формате HTML, выполнив пункт меню Файл - Сохранить в HTML.
Заключение
Результатом разработки, проведенной в данном курсовом проекте, стала система, удовлетворяющая следующим требованиям:
разработанная система полностью реализует основные возложенные на нее функции;
система оснащена дружеским интерфейсом;
разработанная система является интегрированной;
программа имеет хороший дизайн.
оптимизироваться для использования ее на компьютере со средней производительностью, с помощью разделения программы на отдельные модули;
позволяет пользоваться ею одному игроку за счет присутствия в программе элементов искусственного интеллекта
В целом цель, поставленная в начале дипломного проектирования, была достигнута. В программу вошли все необходимые требования для пользователя.
ПРИЛОЖЕНИЕ 1
Исходный код программы
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, Gauges, ComCtrls, XPMan,
MMSystem, Registry;
type
TFormMain = class(TForm)
StatusGroupBox: TGroupBox;
StatusLabel: TLabel;
MissShape: TShape;
TargetShape: TShape;
MissLabel: TLabel;
TargetLabel: TLabel;
RotateButton: TSpeedButton;
DelButton: TSpeedButton;
DeleteShipPopupMenu: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
PlayButton: TSpeedButton;
KillShape: TShape;
KillLabel: TLabel;
Bevel1: TBevel;
N11: TMenuItem;
N21: TMenuItem;
N31: TMenuItem;
N41: TMenuItem;
MainMenu1: TMainMenu;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N10: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
procedure FormShow(Sender: TObject);
procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Shape65MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Shape65MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N2Click(Sender: TObject);
procedure PlayButtonClick(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure ReDrawAll;
procedure SetShip( StartTag:integer; FinishTag:integer; BoP:char );
procedure ReDraw( BoP:char );
procedure NewGame;
procedure Play;
function WriteCount:string;
procedure Zero( BoP:char );
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure KillShapeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
public
path:string;
{ чтоб схемы сохранять можно было }
e_s, m_s:array[1..4, 1..4] of integer; //матрицы с координ. каждого корабля
{ для html }
e_sh, m_sh:array[1..8, 1..8] of integer; //матриксы с инфой об игровом поле
alph:string[8]; // -= смерть от напалма =-
{ для конфа }
game:integer; //0-не играемся, 1-играемся, 2-наигралися
end;
var
FormMain: TFormMain;
set_ships:array[1..4] of bool; //трю - кор. стоит
cnt:array[0..1] of integer; //запись счета
paluba:integer; //сколькипалубный кор. ставим сейчас
e_k_ships, m_k_ships:integer; //кол-во убитых кораблей
rotate, zalez:bool;
implementation
uses FunctionsUnit, ConfUnit, MBoxUnit, HistoryUnit, SaveShemeUnit,
LoadDelShemeUnit, HTMLUnit, NapalmUnit, CleanerUnit;
{$R *.dfm}
{ все что на форме помечено "+++" - пишется программно }
//дает заключительный таг корабля
function GetFinishTag( StartTag:integer; PalubaCount:integer;
Rot:bool ):integer;
var temp, tag_f:integer; str:string[2]; a,b :char;
begin
if Rot then
begin
a := 'c';
b := 'r';
end else
begin
a := 'r';
b := 'c';
end;
temp := GetNum( StartTag, a );
tag_f := GetNum( StartTag, b ) + ( PalubaCount - 1 );
//если за край залез кораблиг
if tag_f > 8 then begin
tag_f := 8;
zalez := true;
end;
if Rot then str := IntToStr( tag_f ) + IntToStr( temp )
else str := IntToStr( temp ) + IntToStr( tag_f );
GetFinishTag := StrToInt( str );
end;
//свой месадж бокс написал :(
function MesBox( Text:string; Caption:string ):bool;
begin
FormMBox.Label1.Caption := Text;
FormMBox.Caption := Caption;
FormMBox.ShowModal;
MesBox := FormMBox.a;
end;
//трю - если есть соседи около корабля
function CheckNeig( StartTag:integer; FinishTag:integer; BoP:char ):boolean;
var str:string; i, m:integer;
begin
CheckNeig := false; //чтоб не клюкавила
//берем соседей
str := GetNeigNums( StartTag, FinishTag );
m := Length( str ) div 2;
if BoP = 'b' then
for i := 1 to m do
if FormMain.e_sh[GetNum( GetTagFromStr( str, i ), 'r' ),
GetNum( GetTagFromStr( str, i ), 'c' )] = 1 then
begin
CheckNeig := true;
Exit;
end;
if BoP = 'p' then
for i := 1 to m do
if FormMain.m_sh[GetNum( GetTagFromStr( str, i ), 'r' ),
GetNum( GetTagFromStr( str, i ), 'c' )] = 1 then
begin
CheckNeig := true;
Exit;
end;
end;
//проверяет, убит кор. или нет
function CheckKillShip( PalubaCount:integer; BoP:char ):boolean;
var i, r, c, tmp:integer;
begin
for i := 1 to PalubaCount do begin
if BoP = 'b' then begin //координаты берем
r := GetNum( FormMain.e_s[PalubaCount, i], 'r' );
c := GetNum( FormMain.e_s[PalubaCount, i], 'c' );
end
else begin
r := GetNum( FormMain.m_s[PalubaCount, i], 'r' );
c := GetNum( FormMain.m_s[PalubaCount, i], 'c' );
end;
//валим в темп значение по этому адресу
if BoP = 'b' then tmp := FormMain.e_sh[r,c] else tmp := FormMain.m_sh[r,c];
//если туда не попали - выходим
if ( tmp <> 3 ) then begin
Result := false;
Exit;
end;
end;
//инкриментим кол-во убитых кораблей
if BoP = 'b' then inc( e_k_ships ) else inc( m_k_ships );
Result := true;
end;
//сканит set_ships и говорит, какой кораблик еще не установлен
function GetPaluba:integer;
var i:integer;
begin
for i := 1 to 4 do
if set_ships[i] = false then begin
GetPaluba := i; //берем n-палубный не установ. корабль
FormMain.StatusLabel.Caption := 'Сейчас ставим:';
FormMain.ManKillLabel.Caption := IntToStr( i ) + ' - палубный';
Exit;
end;
GetPaluba := 0; //значит все на месте
end;
//пишет на форме лабелы с инфой об игре ( тока для мена )
procedure WriteInfo( Kill, Lost:integer );
begin
with FormMain do begin
if Kill <> -1 then
ManKillLabel.Caption := ManKillLabel.Caption + ' ' + IntToStr( Kill );
if Lost <> -1 then
ManLostLabel.Caption := ManLostLabel.Caption + ' ' + IntToStr( Lost );
end;
end;
//ищит подбитые таги с стренге
function GetRedTag( StrWithTags:string ):integer;
var i, l, r, c, tg:integer;
begin
l := Length( StrWithTags ) div 2;
for i := 1 to l do begin
tg := GetTagFromStr( StrWithTags, i ); //берем i-ый таг
r := GetNum( tg, 'r' );
c := GetNum( tg, 'c' );
if FormMain.m_sh[r,c] = 3 then begin //если попадание
Result := tg; //отдаем его
Exit; //и уходим ( больше одного не нужно, потому что )
end;
end;
Result := -1; //ни че не нашли
end;
//убирает таги, в которые уже стреляли
function FilterTargetTags( Str:string ):string;
var i, r, c, l:integer; res, tmp:string[8];
begin
res := '';
l := Length( Str ) div 2;
for i := 1 to l do begin
tmp := IntToStr( GetTagFromStr( Str, i ) );
r := StrToInt( tmp[1] );
c := StrToInt( tmp[2] );
if ( FormMain.m_sh[r,c] = 0 ) or ( FormMain.m_sh[r,c] = 1 ) then
res := res + tmp;
end;
Result := res;
end;
//бот выбирает таг корабля
function BotFireTag:integer;
var cross, tg:string[8]; i, j, k, r:integer; ran:boolean; stat:char;
begin
{ ламер - мочит на шару
перец - не учитывает положение подбитых кораблей
матер - boom bye yeah !!! }
Result := -1; //чтоб компилятер не ругался
ran := false; //пока ранений нету
r := -1;
//сложность
if FormMain.DiffComboBox.ItemIndex = 0 then i := 9
else i := 1;
//ищим попадание
while ( i <= 8 ) do begin
for j := 1 to 8 do
if FormMain.m_sh[i,j] = 3 then begin //нашел подбитый кораблик
ran := true; //а вот и ранение
cross := GetCoDTags( i, j, true );
if FormMain.DiffComboBox.ItemIndex = 2 then
r := GetRedTag( cross ); //смотрим на ранения
if r <> -1 then begin
tg := IntToStr( i ) + IntToStr( j ); //берем текущий таг
//определяем положение корабля
if GetNum( StrToInt( tg ), 'r' ) = GetNum( r, 'r' ) then stat := 'r'
else stat := 'c';
cross := FilterRedLineTags( cross, GetNum( r, stat ), stat );
end;
//выкидываем подбитые таги
cross := FilterTargetTags( cross );
//если есть хоть один таг, то палим
if cross <> '' then begin
Randomize; //ни хера не помогает :)
k := Random( Length( cross ) div 2 );
inc( k );
//результат - таг для функции Fire
Result := GetTagFromStr( cross, k );
Exit;
end;
end;
inc( i );
end;
//не нашел ни одного раненого бойца и палит на шару
if ran = false then Result := GetRandomTag;
end;
//пишет мему с ходами
procedure WriteStepsMemo( Row, Col, Kill:integer; BoP:char );
var n, w, r, s:string; t:integer;
begin
if BoP = 'b' then w := 'Бот: ' else w := 'Игрок: ';
case Kill of
-1: r := 'промазал';
0: r := 'подбил';
else begin
r := 'убил';
s := ' (' + IntToStr( Kill ) + ')';
end
end;
with FormMain.StepsMemo.Lines do begin
t := Count + 1;
if t < 10 then
n := '00' + IntToStr ( t ) + ') '
else
n := '0' + IntToStr ( t ) + ') ';
Add( n + w + FormMain.alph[Row] + IntToStr( Col ) + ' - ' + r + s );
end;
end;
//пишет одно заданное число во все заданные элементы матрицы
procedure WriteNumsInBigMatrix( StrWithTags:string; Number:integer;
BoP:char );
var i, l, r, c:integer;
begin
l := Length( StrWithTags ) div 2;
for i := 1 to l do begin
r := GetNum( GetTagFromStr( StrWithTags, i ), 'r' );
c := GetNum( GetTagFromStr( StrWithTags, i ), 'c' );
if BoP = 'b' then FormMain.e_sh[r,c] := Number
else FormMain.m_sh[r,c] := Number;
end;
end;
//помечает в матрице убитый корабль ( результ - кол-во палуб убитого корабля )
function MarkKillShip( BoP:char ):integer;
var i, s, f:integer;
begin
Result := 0;
for i := 1 to 4 do begin
if CheckKillShip( i, BoP ) = true then begin
if BoP = 'b' then begin
s := FormMain.e_s[i, 1];
f := FormMain.e_s[i, i];
end
else begin
s := FormMain.m_s[i, 1];
f := FormMain.m_s[i, i];
end;
if BoP = 'b' then WriteInfo( i, -1 )
else WriteInfo( -1, i );
//чтоб избежать кривого отображения, сначала помечаем его соседей
WriteNumsInBigMatrix( GetNeigNums( s, f ), 2, BoP );
//помечаем в матрице грохнутые корабли
WriteNumsInBigMatrix( GetShipTags( s, f ), 4, BoP );
Randomize;
if ( BoP = 'b' ) and ( FormConf.KillCheckBox.Checked ) then
case Random(5) of
0: sndPlaySound( 'sounds\KillShip1.wav', SND_ASYNC );
1: sndPlaySound( 'sounds\KillShip2.wav', SND_ASYNC );
2: sndPlaySound( 'sounds\KillShip3.wav', SND_ASYNC );
3: sndPlaySound( 'sounds\KillShip4.wav', SND_ASYNC );
4: sndPlaySound( 'sounds\KillShip5.wav', SND_ASYNC );
end;
Result := i;
end;
end;
end;
//3абивает матрицу данными - попал / промазал
//1 - палить дальше низя ( промах, карочи )
function Fire( ShapeTag:integer; BoP:char ):integer;
var r, c, temp:integer; //BoP - кто стреляет
begin
Result := 0;
r := GetNum( ShapeTag, 'r' );
c := GetNum( ShapeTag, 'c' );
if BoP = 'b' then temp := FormMain.m_sh[r,c]
else temp := FormMain.e_sh[r,c];
//уже стрелял туда
if ( temp = 2 ) or ( temp = 3 ) or ( temp = 4 ) then Exit;
{ -- принцип записи ходов --
если промах - пишем в мему промах,
если попал - определяем убитый корабль (если есть), то пишем его,
если нет убитого - пишем просто попадание }
if temp = 0 then WriteStepsMemo( r, c, -1, BoP );
case temp of
0: begin
temp := 2; //не попал
if ( BoP = 'p' ) and ( FormConf.MissCheckBox.Checked ) then
sndPlaySound( 'sounds\Miss.wav', SND_ASYNC );
Result := 1;
end;
1: begin
temp := 3; //попал
if ( BoP = 'p' ) and ( FormConf.TargetCheckBox.Checked ) then
sndPlaySound( 'sounds\Target.wav', SND_ASYNC );
end;
end;
if BoP = 'b' then begin
FormMain.m_sh[r,c] := temp;
if temp = 3 then WriteStepsMemo( r, c, MarkKillShip( 'p' ), BoP );
FormMain.ReDraw( 'p' );
end
else begin
FormMain.e_sh[r,c] := temp;
if temp = 3 then WriteStepsMemo( r, c, MarkKillShip( 'b' ), BoP );
FormMain.ReDraw( 'b' );
end;
if temp = 2 then Exit;
// --- ниже код не прет, если промах ---
if m_k_ships = 4 then begin
if FormConf.EndGameCheckBox.Checked then
sndPlaySound( 'sounds\Looser.wav', SND_ASYNC );
inc( cnt[0] );
ShowMessage( 'Учись играть !' );
end
else
if e_k_ships = 4 then begin
if FormConf.EndGameCheckBox.Checked then
sndPlaySound( 'sounds\Winner.wav', SND_ASYNC );
inc( cnt[1] );
ShowMessage( 'Ты надрал бота !' );
end;
//если уже есть лузер, то ни че не делаем
if ( m_k_ships = 4 ) or ( e_k_ships = 4 ) then begin
FormMain.game := 2; //закончили играть
FormMain.ReDraw( 'b' ); //покажем проигравшему игроку кораблики бота
//пишем счет
FormMain.CountLabel.Caption := FormMain.WriteCount;
Exit;
end;
end;
//изменяет содержимое попы
procedure ChangePopUpMenu;
var i:integer;
begin
//элем. попы присваиваем значение элем. сет_шыпа
for i := 1 to 4 do
FormMain.DeleteShipPopupMenu.Items[i+1].Enabled := set_ships[i];
end;
//раздаем таги всем всем всем шейпам ( как-то по-пи@ерски 3вучит )
procedure SetTags;
var i, t, j, p:integer; temp:string[2];
begin
for p := 0 to 1 do begin
t := 1; j := 1;
for i := 0 to 127 do
if Application.MainForm.Components[i] is TShape then
with Application.MainForm.Components[i] as TShape do
if Tag = t then
begin
temp := IntToStr( t ) + IntToStr( j );
Tag := StrToInt( temp );
inc( j );
if j = 9 then
begin
inc( t );
j := 1;
end;
end;
end;
end;
//пишет маленькую матрицу
procedure WriteSmallMatrix( StartTag:integer; FinishTag:integer;
PalubaCount:integer; BoP:char );
var str:string[8]; i:integer;
begin
str := GetShipTags( StartTag, FinishTag ); //берем все таги корабля
//пишем таги в маленькую матрицу
for i := 1 to PalubaCount do
if BoP = 'b' then
FormMain.e_s[PalubaCount, i] := GetTagFromStr( str, i )
else FormMain.m_s[PalubaCount, i] := GetTagFromStr( str, i );
//перепис. данные в большую
WriteNumsInBigMatrix( str, 1, BoP );
end;
//из матрицы перерисовывает кораблики на поле
procedure TFormMain.ReDraw( BoP:char );
var i, start, finish, temp:integer;
begin
if BoP = 'b' then
begin
start := 0; finish := 63;
end
else begin
start := 64; finish := 127;
end;
//нашел кораболь - не рабей
//перерисуй его скорей !
for i := start to finish do
if Application.MainForm.Components[i] is TShape then
with Application.MainForm.Components[i] as TShape do begin
if BoP = 'b' then temp := e_sh[GetNum( Tag, 'r' ), GetNum( Tag, 'c' )]
else temp := m_sh[GetNum( Tag, 'r' ), GetNum( Tag, 'c' )];
//цвета посмотрим
case temp of
//пусто
0: Brush.Color := FormConf.GetColor( FormConf.GridComboBox.Text );
//есть кораблик ( не рысуется для бота в процессе игры )
1: if BoP = 'p' then
Brush.Color := FormConf.GetColor( FormConf.ShipComboBox.Text )
else if ( game = 2 ) or ( FormNapalm.cht ) then
Brush.Color := FormConf.GetColor( FormConf.ShipComboBox.Text );
//промах
2: Brush.Color := FormConf.GetColor( FormConf.MissComboBox.Text );
//подбил !
3: Brush.Color := FormConf.GetColor( FormConf.TargetComboBox.Text );
//total destroy
4: Brush.Color := FormConf.GetColor( FormConf.KillComboBox.Text );
end;
end;
end;
procedure TFormMain.ReDrawAll;
begin
ReDraw( 'b' );
ReDraw( 'p' );
//меняем "хелп" на форме
with FormMain do begin
MissShape.Brush.Color := FormConf.GetColor( FormConf.MissComboBox.Text );
TargetShape.Brush.Color := FormConf.GetColor( FormConf.TargetComboBox.Text );
KillShape.Brush.Color := FormConf.GetColor( FormConf.KillComboBox.Text );
end;
end;
//рисуем n-палубный корабль
procedure DrawShip( StartTag:integer; FinishTag:integer; Rot:bool );
var i:integer; din, stat:char; color:TColor;
begin
if paluba = 0 then exit; //если без этого - глюки будуть !
//rc - row или col который мы не изменяем
if Rot = false then
begin
stat := 'r';
din := 'c';
end else
begin
stat := 'c';
din := 'r';
end;
color := FormConf.GetColor( FormConf.ShipComboBox.Text );
//чекаем соседок и "залезность"
if CheckNeig( StartTag, FinishTag, 'p' ) or zalez
then color := clRed;
//красим этот диапазон
for i := 64 to 127 do
if Application.MainForm.Components[i] is TShape then
with Application.MainForm.Components[i] as TShape do
//если координата влезает в диапазон ... хорошо значит
if GetNum( Tag, stat ) = GetNum( StartTag, stat ) then
if ( GetNum( Tag, din ) >= GetNum( StartTag, din ) ) and
( GetNum( Tag, din ) <= GetNum( FinishTag, din ) )
then Brush.Color := color;
zalez := false;
end;
//удаляет корабель
procedure DelShip( PalubaCount:integer );
var str:string[8]; i:integer;
begin
FormMain.PlayButton.Enabled := false; //хоть один кор. удалил - не играемся
//берем все таги этого корабля
str := '';
for i := 1 to PalubaCount do
str := str + IntToStr( FormMain.m_s[PalubaCount, i] );
//пишем в эти адреса нули
WriteNumsInBigMatrix( str, 0, 'p' );
//"убираем" этот корабль
set_ships[PalubaCount] := false;
paluba := GetPaluba;
ChangePopUpMenu;
FormMain.ReDraw( 'p' );
end;
//пишет нули во все элементы большой матрицы
procedure TFormMain.Zero( BoP:char );
var i, j:integer;
begin
for i := 1 to 8 do
for j := 1 to 8 do
if BoP = 'b' then FormMain.e_sh[i,j] := 0
else FormMain.m_sh[i,j] := 0;
end;
//чистим конкретное игровое поле
procedure Clear( BoP:char );
begin
FormMain.Zero( BoP );
FormMain.ReDraw( BoP );
end;
//чистим игровые поля
procedure ClearAll;
begin
Clear( 'b' );
Clear( 'p' );
FormMain.ReDrawAll;
end;
function TFormMain.WriteCount:string;
var temp:integer;
begin
temp := cnt[0] + cnt[1];
Result := 'Счет: ' + IntToStr( cnt[0] ) + ' - ' + IntToStr( cnt[1] ) +
' ( ' + IntToStr( temp ) + ' )';
end;
//ставит корабли рандомом
procedure RandomSetShips( BoP:char );
var r, c, i, j, k, t_s, t_f:integer; str_tmp:string[2]; n, rot:bool;
begin
j := 0;
Clear( BoP );
for i := 1 to 4 do begin
while ( j < 1 ) do begin
Randomize;
zalez := false;
r := Random( 8 );
c := Random( 8 );
inc( r ); inc( c );
//опред. направление
k := Random( 2 );
if k = 0 then rot := false else rot := true;
str_tmp := IntToStr( r ) + IntToStr( c ); //первый таг
t_s := StrToInt( str_tmp );
t_f := GetFinishTag( t_s, i, rot ); //послед. таг
n := CheckNeig( t_s, t_f, BoP ); //соседи
//если соседей нету и кораблик не залез за поле
if ( n = false ) and ( zalez = false ) then begin
WriteSmallMatrix( t_s, t_f, i, BoP );
j := 2;
end;
end;
j := 0;
end;
//легче так сделать, чтоб не исп. ПАЛУБУ
if BoP = 'p' then begin
for i := 1 to 4 do set_ships[i] := true; //все стоить
paluba := 0;
ChangePopUpMenu;
FormMain.PlayButton.Enabled := true; //можно играть
if FormConf.PlayCheckBox.Checked then FormMain.Play;
end;
end;
//дождались ...
procedure TFormMain.Play;
begin
game := 1;
with FormMain do begin
StatusGroupBox.Caption := ' Статус: игра ';
StatusLabel.Caption := 'Игрок';
ManKillLabel.Caption := 'Убил:';
ManLostLabel.Caption := 'Потерял:';
//нажать уже низя
RanSetShipsButton.Enabled := false;
RotateButton.Enabled := false;
DelButton.Enabled := false;
PlayButton.Enabled := false;
DiffComboBox.Enabled := false;
end;
RandomSetShips( 'b' ); //теперь бот корабли ставит
if ( FormNapalm.cht ) then FormMain.ReDraw( 'b' );
end;
procedure TFormMain.SetShip( StartTag:integer; FinishTag:integer; BoP:char );
begin
if FormConf.SetCheckBox.Checked then
sndPlaySound( 'sounds\SetShip.wav', SND_ASYNC );
WriteSmallMatrix( StartTag, FinishTag, paluba, BoP );
set_ships[paluba] := true;
paluba := GetPaluba;
ChangePopUpMenu;
if ( FormConf.PlayCheckBox.Checked ) and ( paluba = 0 ) then Play
else
if paluba = 0 then FormMain.PlayButton.Enabled := true; //можно играть
end;
procedure TFormMain.NewGame;
var i:integer;
begin
ClearAll;
with FormMain do begin
StatusGroupBox.Caption := ' Статус: расстановка ';
StatusLabel.Caption := 'Сейчас ставим:';
ManKillLabel.Caption := '1 - палубный';
ManLostLabel.Caption := '';
PlayButton.Enabled := false;
RotateButton.Enabled := true;
DelButton.Enabled := true;
RanSetShipsButton.Enabled := true;
DiffComboBox.Enabled := true;
FormNapalm.cht := false; //чит
StepsMemo.Clear;
end;
game := 0; //ставим корабли (играть низя)
paluba := 1;
zalez := false;
e_k_ships := 0;
m_k_ships := 0;
for i := 1 to 4 do set_ships[i] := false;
ChangePopUpMenu;
end;
procedure ClearCount;
begin
cnt[0] := 0; cnt[1] := 0; //счет 0-0
FormMain.CountLabel.Caption := 'Счет: 0 - 0 ( 0 )';
end;
procedure TFormMain.FormShow(Sender: TObject);
begin
SetTags; //раздаем таги всем шейпам
NewGame; //дефултовые параметры
end;
procedure TFormMain.FormCreate(Sender: TObject);
var Reg:TRegistry;
begin
path := ExtractFilePath( Application.ExeName );
Caption := Application.Title;
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.KeyExists( 'sf' ) = false then begin
Reg.OpenKey( 'sf', true );
Reg.WriteInteger( '_left', Left );
Reg.WriteInteger( '_top', Top );
end
else Reg.OpenKeyReadOnly( 'sf' );
Left := Reg.ReadInteger( '_left' );
Top := Reg.ReadInteger( '_top' );
Reg.Free;
RanSetShipsButton.Caption := 'В случайном'#13'порядке';
alph := 'абвгдежз'; //для записи ходов
ClearCount;
end;
procedure TFormMain.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var j:integer;
begin
if ( game = 0 ) or ( game = 2 ) then Exit;
j := 0;
if Fire( (Sender as TShape).Tag, 'p' ) = 1 then
while ( j < 1 ) do
if Fire( BotFireTag, 'b' ) = 1 then j := 2;
end;
procedure TFormMain.Shape65MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var tag_s, tag_f:integer;
begin
if game <> 0 then exit;
ReDraw( 'p' );
tag_s := (Sender as TShape).Tag;
tag_f := GetFinishTag( tag_s, paluba, rotate );
DrawShip( tag_s, tag_f, rotate );
end;
procedure TFormMain.Shape65MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var s, f:integer;
begin
if paluba = 0 then Exit;
s := (Sender as TShape).Tag;
f := GetFinishTag( s, paluba, rotate );
if (Sender as TShape).Brush.Color <> clRed then SetShip( s, f, 'p' );
end;
procedure TFormMain.N2Click(Sender: TObject);
var p:integer;
begin
if (Sender as TMenuItem).Tag = -1 then exit; //атменка
p := StrToInt( (Sender as TMenuItem).Caption[1] ); //берем "палубность" корабля
if FormConf.DelShipCheckBox.Checked then begin
if MesBox( 'Вы точно хотите удалить ' + (Sender as TMenuItem).Caption +
' корабль ?', 'Удаление корабля' ) = true
then DelShip( p )
else Exit;
Exit;
end;
DelShip( p );
end;
procedure TFormMain.PlayButtonClick(Sender: TObject);
begin
case (Sender as TSpeedButton).Tag of
0: Play;
1: if rotate then rotate := false else rotate := true;
2: DeleteShipPopupMenu.Popup( FormMain.Left + DelButton.Left + 2, FormMain.Top + DelButton.Top + 74 );
3: begin //рандом
RandomSetShips( 'p' );
ReDraw( 'p' );
end;
end;
end;
procedure TFormMain.N9Click(Sender: TObject);
begin
case (Sender as TMenuItem).Tag of
11: begin
if FormConf.NewGameCheckBox.Checked then begin
if MesBox( 'Создать новую игру ?', 'Новая игра' ) = true
then NewGame
else Exit;
Exit;
end;
NewGame;
end;
12: FormConf.ShowModal;
13: begin
if FormConf.ExitCheckBox.Checked then begin
if MesBox( 'Вы точно хотите выйти ?', 'Выход' ) = true
then Close
else Exit;
Exit;
end;
Close;
end;
14: if game <> 2 then ShowMessage( 'Текущая игра должна быть закончена' )
else FormHTML.ShowModal;
15: begin
FormMain.NewGame;
ClearCount;
end;
21: if paluba = 0 then FormSaveSheme.ShowModal
else ShowMessage( 'Все корабли должны быть поставлены' );
22: FormLoadDelSheme.ShowModal;
23: FormCleaner.ShowModal;
31: FormHistory.ShowModal;
32: ShowMessage('Инфу о найденых ошибках,'#13'лагах, багах,'#13 +
'можете слать сюда:'
+ #13#13 + 'kulbes@mail.ru');
end;
end;
procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
var Reg:TRegistry;
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey( 'sf', true );
Reg.WriteInteger( '_left', Left );
Reg.CloseKey;
Reg.OpenKey( 'sf', true );
Reg.WriteInteger( '_top', Top );
Reg.CloseKey;
end;
procedure TFormMain.KillShapeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FormNapalm.ShowModal;
end;
end.