Читайте также:
|
Исходный код программы
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.
Дата добавления: 2015-07-16; просмотров: 45 | Нарушение авторских прав
| <== предыдущая страница | | | следующая страница ==> |
| Инструкция пользователя | | | Глава первая |