Новичок
Профиль
Группа: Участник
Сообщений: 23
Регистрация: 9.12.2007
Репутация: нет
Всего: нет
|
выкладываю полный код заново: | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Files1: TMenuItem;
New1: TMenuItem;
Exit1: TMenuItem;
Player1: TMenuItem;
Player11: TMenuItem;
Computer1: TMenuItem;
Ships1: TMenuItem;
Player2: TMenuItem;
Random1: TMenuItem;
procedure FormPaint(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure New1Click(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Player11Click(Sender: TObject);
procedure Computer1Click(Sender: TObject);
// procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
// Y: Integer);
procedure Exit1Click(Sender: TObject);
procedure Random1Click(Sender: TObject);
procedure Player2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
//структура COORD
COORD = record
X, Y: Integer;
end;
SignOfCell = (EMPTY, MISSED, WOUNDED, KILLED, ZERO, CSHIP, DOUBLE,
FIRSTTIME);
ShowModeOFField = (SHOWSHIPS, NOSHOWSHIPS);
CopyFlag = (WITHSHIPS, WITHOUTSHIPS, WITHOUTSHIPSANDWOUNDED);
//структура поле
FIELD = record
//массив ячеек
field: array[0..9, 0..9] of SignOfCell;
//режим показа
ShowMode: ShowModeOFField;
end;
shipStatus = (DESTROYED, LIVE, WOUNDEDSHIP);
funcResult = (SUCCEEDED, FAILED);
Direction = (HORIZONTAL, VERTICAL);
//структура корабль
SHIP = record
//количество палуб
size: Integer;
//координаты каждой палубы
coord: array [0..3] of COORD;
//статус корабля (живой, живой, но раненый или убитый)
ShipStatus: shipStatus;
end;
//структура gameplce
GAMEPLACE = record
field: FIELD;
ship: array[0..9] of SHIP;
end;
GameStatus = (Player1IsMoving, ComputerIsMoving, PAUSE, SETSHIPS);
var
Form1: TForm1;
FieldBitmap: TBitmap;
MissedBitmap: TBitmap;
KilledBitmap: TBitmap;
WoundedBitmap: TBitmap;
ZeroBitmap: TBitmap;
ShipBitmap: TBitmap;
EmptyBitmap: TBitmap;
gameplacePlayer1: GAMEPLACE;
gameplacePlayer2: GAMEPLACE;
coordPlayer1: COORD;
coordPlayer2: COORD;
Status: GameStatus;
Result: SignOfCell;
NumberOfShip: Integer;
implementation
{$R *.DFM}
////////////////////////////////////////////////////////////////
//ПРОЦЕДУРЫ ДЛЯ РАБОТЫ С ПОЛЕМ (FIELD)
//функция установки знаков на поле
procedure setSign(var iField: FIELD; X, Y: Integer; sign: SignOfCell);
Forward;
//функция получения знака
function getSign(iField: FIELD; X, Y: Integer) :SignOfCell; Forward;
//функция очистки поля
procedure ClearField(var iField: FIELD); Forward;
//функция рисования поля
procedure DrawField(iField: FIELD; X, Y: Integer; Canvas: TCanvas);
Forward;
//функция копирования поля
procedure copyField(var dField: FIELD; const sField: FIELD; flag: CopyFlag);
Forward;
////////////////////////////////////////////////////////////////
//функция очистки поля
procedure ClearField(var iField: FIELD);
var
i, j: Integer;
begin
for i := 0 to 9 do
begin
for j := 0 to 9 do
begin
iField.field[i, j] := EMPTY;
end;
end;
end;
//функция рисования поля
procedure DrawField(iField: FIELD; X, Y: Integer;
Canvas: TCanvas);
var
i, j: Integer;
begin
// Canvas.Draw(X, Y, FieldBitmap);
for i := 0 to 9 do
begin
for j := 0 to 9 do
begin
if iField.field[i, j] = EMPTY then
Canvas.Draw(X + 20*(i + 1) + 2, Y + 20*(j + 1) + 2,
EmptyBitmap)
else
if iField.field[i, j] = MISSED then
Canvas.Draw(X + 20*(i + 1) + 2, Y + 20*(j + 1) + 2,
MissedBitmap)
else
if iField.field[i, j] = WOUNDED then
Canvas.Draw(X + 20*(i + 1) + 2, Y + 20*(j + 1) + 2,
WoundedBitmap)
else
if iField.field[i, j] = KILLED then
Canvas.Draw(X + 20*(i + 1) + 2, Y + 20*(j + 1) + 2,
KilledBitmap)
else
if iField.field[i, j] = ZERO then
Canvas.Draw(X + 20*(i + 1) + 2, Y + 20*(j + 1) + 2,
ZeroBitmap)
else
if (iField.ShowMode = SHOWSHIPS) and
(iField.field[i, j] = CSHIP) then
Canvas.Draw(X + 20*(i + 1) + 2, Y + 20*(j + 1) + 2,
ShipBitmap)
else
if (iField.ShowMode = NOSHOWSHIPS) and
(iField.field[i, j] = CSHIP) then
Canvas.Draw(X + 20*(i + 1) + 2, Y + 20*(j + 1) + 2,
EmptyBitmap);
end;
end;
end;
//функция установки знаков на поле
procedure setSign(var iField: FIELD; X, Y: Integer; sign: SignOfCell);
begin
if (x >= 0) and (x < 10) and (y >=0) and (y < 10) then
iField.field[X, Y] := sign;
end;
//функция получения знака
function getSign(iField: FIELD; X, Y: Integer) :SignOfCell;
begin
if (x >= 0) and (x < 10) and (y >=0) and (y < 10) then
result := iField.field[X, Y]
else
result := EMPTY;
end;
//функция установки режима отображения
procedure setShowMode(var iField: FIELD; ShowMode: ShowModeOFField);
begin
iField.ShowMode := ShowMode;
end;
//функция копирования поля
procedure copyField(var dField: FIELD; const sField: FIELD; flag: CopyFlag);
var
i, j:Integer;
begin
for i := 0 to 9 do
for j := 0 to 9 do
begin
if flag = WITHSHIPS then
dfield.field[i, j] := sfield.field[i, j]
else
if flag = WITHOUTSHIPS then
begin
if sfield.field[i, j] = CSHIP then
dfield.field[i, j] := EMPTY
else
dfield.field[i, j] :=
sfield.field[i, j];
end
else
if flag = WITHOUTSHIPSANDWOUNDED then
begin
if(sfield.field[i, j] = CSHIP) or
(sfield.field[i, j] = WOUNDED) then
dfield.field[i, j] := EMPTY
else
dfield.field[i, j] := sfield.field[i,j];
end;
end;
dfield.showMode := sfield.showMode;
end;
/////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////
//ФУНКЦИИ ДЛЯ РАБОТЫ С КОРАБЛЯМИ (SHIPS)
/////////////////////////////////////////////////////////////////
/////
//вспомагательные функции
/////////////////////////////////////////////////////////////////
//функция проверки того, находится ли данная клетка внутри поля
function IsInside(X, Y: Integer): Boolean; Forward;
//функция проверки, помечена ли данная клетка как "промах"
function IsMissed(iField: FIELD; x, y: Integer ): Boolean; Forward;
//проверка являится ли данная клетка пустой
function IsEmpty(iField: FIELD; x, y: Integer): Boolean; Forward;
/////////////////////////////////////////////////////////////////
//функция установки корабля на заданную клетку
function SetShip(var iShip: SHIP; var iField: FIELD; iCoord: COORD;
size: Integer; dir: Direction) :FuncResult; Forward;
//функция установки корабля в случайное место
function setShipToRandomPlace(var iShip: SHIP;
var iField: FIELD; size: Integer):
FuncResult; Forward;
//установить статус корабля
procedure setShipStatus(var iShip: SHIP; status: ShipStatus); Forward;
//узнать статус корабля
function getShipStatus(iShip: SHIP): ShipStatus; Forward;
//узнать размер корабля
function getShipSize(iShip: SHIP): Integer; Forward;
//узнать координаты корабля
function getShipCoord(iShip: SHIP; deck: Integer): COORD; Forward;
//функция убить корабль
procedure killShip(var iShip: SHIP; var iField: FIELD); Forward;
/////////////////////////////////////////////////////////////////
//функция проверки того, находится ли данная клетка внутри поля
function IsInside(X, Y: Integer): Boolean;
begin
if((x >=0 ) and (x <= 9) and (y >=0 ) and (y <=9)) then
result := TRUE
else
result := FALSE;
end;
//функция проверки, помечена ли данная клетка как "промах"
function IsMissed(iField: FIELD; x, y: Integer ): Boolean;
begin
if(getSign(iField, x, y) = MISSED) then
result := TRUE
else
result := FALSE;
end;
//проверка являится ли данная клетка пустой
function IsEmpty(iField: FIELD; x, y: Integer): Boolean;
begin
if((((getSign(iField, x, y) = EMPTY)or(getSign(iField, x, y) = ZERO)
or (getSign(iField, x, y) = MISSED))
and (x >=0 ) and (x <=9) and (y >=0 )and(y <=9)) or
((x <= -1)or(y <= -1)or(x >= 10)or(y >= 10))) then
result := TRUE
else
result := FALSE;
end;
//функция установки корабля на заданную клетку
function SetShip(var iShip: SHIP; var iField: FIELD; iCoord: COORD;
size: Integer; dir: Direction) :FuncResult;
var
x, y: Integer;
i, j: Integer;
begin
Result := SUCCEEDED;
for i := 0 to size - 1 do
begin
if(Result = SUCCEEDED) then
if(dir = VERTICAL) then
begin
x := iCoord.X;
y := iCoord.Y + i;
//если на данную клетку нельзя поставить корабль,
//выйти из функции
if(not((IsEmpty(iField, x, y)
and IsInside(x, y)
and not(IsMissed(iField, x, y))))) then
result := FAILED;
if(not((IsEmpty(iField, x - 1, y - 1) and
IsEmpty(iField, x - 1, y ) and
IsEmpty(iField, x - 1, y + 1) and
IsEmpty(iField, x , y - 1) and
IsEmpty(iField, x , y + 1) and
IsEmpty(iField, x + 1, y - 1) and
IsEmpty(iField, x + 1, y ) and
IsEmpty(iField, x + 1, y + 1)))) then
result := FAILED;
end
else
begin
x := iCoord.X + i;
y := iCoord.Y;
//если на данную клетку нельзя поставить корабль,
//выйти из функции
if((not(IsEmpty(iField, x, y)
and IsInside(x, y)
and(not(IsMissed(iField, x, y)))))) then
result := FAILED;
if(not((IsEmpty(iField, x - 1, y - 1) and
IsEmpty(iField, x - 1, y ) and
IsEmpty(iField, x - 1, y + 1) and
IsEmpty(iField, x , y - 1) and
IsEmpty(iField, x , y + 1) and
IsEmpty(iField, x + 1, y - 1) and
IsEmpty(iField, x + 1, y ) and
IsEmpty(ifield, x + 1, y + 1)))) then
result := FAILED;
end;
end;
//установить размер корабля
iShip.size := size;
iShip.ShipStatus := LIVE;
if(Result = SUCCEEDED) then
for i := 0 to size - 1 do
begin
//установить координат корабля
//и помететь определенные клетки на поле как занятые кораблем
if(dir = VERTICAL) then
begin
iShip.coord[i] := iCoord;
setSign(iField, iCoord.X, iCoord.Y, CSHIP);
iCoord.Y := iCoord.Y + 1;
end
else
begin
iShip.coord[i] := iCoord;
setSign(iField, iCoord.X, iCoord.Y, CSHIP);
iCoord.X := iCoord.X + 1;
end;
end;
end;
//функция установки корабля в случайное место
function setShipToRandomPlace(var iShip: SHIP;
var iField: FIELD; size: Integer):
FuncResult;
var
iCoord: COORD;
dir: DIRECTION;
begin
//присвоить случайные значения переменным coord и direction
iCoord.X := random(10);
iCoord.Y := random(10);
if(random(2)<>0) then
dir := HORIZONTAL
else dir := VERTICAL;
//попытаться установить корабль на случайные координаты
result := setShip(iShip, iField, iCoord, size, dir);
end;
//установить статус корабля
procedure setShipStatus(var iShip: SHIP; status: ShipStatus);
begin
iShip.ShipStatus := status;
end;
//узнать статус корабля
function getShipStatus(iShip: SHIP): ShipStatus;
begin
result := iShip.ShipStatus;
end;
//узнать размер корабля
function getShipSize(iShip: SHIP): Integer;
begin
result := iShip.size;
end;
//узнать координаты корабля
function getShipCoord(iShip: SHIP; deck: Integer): COORD;
begin
if deck < 4 then
result := iShip.coord[deck]
else
begin
MessageBox(0, 'Ошибка', 'Error', MB_OK);
end;
end;
//функция убить корабль
procedure killShip(var iShip: SHIP; var iField: FIELD);
var
iCoord: COORD;
i: Integer;
begin
//установить статус корабля
setShipStatus(iShip, DESTROYED);
//пометить клетки на поле как "убитый"
for i := 0 to iShip.size - 1 do
begin
iCoord := iShip.coord[i];
setSign(iField, iCoord.X, iCoord.Y, KILLED);
end;
end;
/////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////
//ФУНКЦИИ СВЯЗАННЫЕ С ИГРОВЫМ МЕСТОМ (GAMEPLACE)
//GAMEPLACE = поле + 10 кораблей
//расставить все корабли
procedure setAllShips(var igameplace: GAMEPLACE); Forward;
//организовать выстрел в данную клетку
//возвращает: попал, убил, мимо или вторичный выстрел
function fire(var igameplace: GAMEPLACE; X, Y: Integer): SignOfCell;
Forward;
//расставить знаки говорящие о том,
//что на этой клетке не может быть корабля,
//в качестве параметра принимает номер корабля
procedure setZeroSigns(var igameplace: GAMEPLACE; num: Integer); Forward;
//проверить, проиграл ли игрок
function LOST(igameplace: GAMEPLACE): Boolean; Forward;
//получить номер корабля расположенный на данной клетке
function getNumberOfShip(igameplace: GAMEPLACE; x, y: Integer): Integer;
Forward;
//жив ли корабль?
function IsLive(igameplace: GAMEPLACE; num: Integer): Boolean; Forward;
//ввод координат (для стрельбы при помощи клавиатуры)
//функция организует ход игрока
/////////////////////////////////////////////////////////////////
//расставить все корабли
procedure setAllShips(var igameplace: GAMEPLACE);
var
i: Integer;
tmp: FuncResult;
begin
clearField(igameplace.field);
for i := 0 to 9 do
setShipStatus(igameplace.ship[i], LIVE);
tmp := FAILED;
//пытаться расставить корабли начиная с наибольшего
//на случайное место
while(tmp = FAILED) do
tmp := setShipToRandomPlace(igameplace.ship[0],
igameplace.field, 4);
tmp := FAILED;
while(tmp = FAILED) do
tmp := setShipToRandomPlace(igameplace.ship[1],
igameplace.field, 3);
tmp := FAILED;
while(tmp = FAILED) do
tmp := setShipToRandomPlace(igameplace.ship[2],
igameplace.field, 3);
tmp := FAILED;
while(tmp = FAILED) do
tmp := setShipToRandomPlace(igameplace.ship[3],
igameplace.field, 2);
tmp := FAILED;
while(tmp = FAILED) do
tmp := setShipToRandomPlace(igameplace.ship[4],
igameplace.field, 2);
tmp := FAILED;
while(tmp = FAILED) do
tmp := setShipToRandomPlace(igameplace.ship[5],
igameplace.field, 2);
tmp := FAILED;
while(tmp = FAILED) do
tmp := setShipToRandomPlace(igameplace.ship[6],
igameplace.field, 1);
tmp := FAILED;
while(tmp = FAILED) do
tmp := setShipToRandomPlace(igameplace.ship[7],
igameplace.field, 1);
tmp := FAILED;
while(tmp = FAILED) do
tmp := setShipToRandomPlace(igameplace.ship[8],
igameplace.field, 1);
tmp := FAILED;
while(tmp = FAILED) do
tmp := setShipToRandomPlace(igameplace.ship[9],
igameplace.field, 1);
tmp := FAILED;
end;
//организовать выстрел в данную клетку
//возвращает: попал, убил, мимо или вторичный выстрел
function fire(var igameplace: GAMEPLACE; X, Y: Integer): SignOfCell;
var
num: Integer;
begin
//если клетка пустая
if((getSign(igameplace.field, x, y) = EMPTY) or
(getSign(igameplace.field, x, y) = ZERO)) then
begin
setSign(igameplace.field, x, y, MISSED);
result := MISSED;
end
else
//если на клетке есть корабль
if(getSign(igameplace.field, x, y) = CSHIP) then
begin
setSign(igameplace.field, x, y, WOUNDED);
num := getNumberOfShip(igameplace, x, y);
if(not(IsLive(igameplace, num))) then
begin
killShip(igameplace.ship[num], igameplace.field);
result := KILLED;
end
else
begin
setShipStatus(igameplace.ship[num], WOUNDEDSHIP);
result := WOUNDED;
end;
setZeroSigns(igameplace, num);
end
else
//если в клетку уже стреляли
if((getSign(igameplace.field, x, y) = WOUNDED) or
(getSign(igameplace.field, x, y) = KILLED) or
(getSign(igameplace.field, x, y) = MISSED)) then
result := DOUBLE;
end;
//расставить знаки говорящие о том,
//что на этой клетке не может быть корабля,
//в качестве параметра принимает номер корабля
procedure setZeroSigns(var igameplace: GAMEPLACE; num: Integer);
var
i, x, y: Integer;
icoord: COORD;
begin
for i := 0 to getShipSize(igameplace.ship[num]) - 1 do
begin
icoord := getShipCoord(igameplace.ship[num], i);
x := icoord.X;
y := icoord.Y;
|
|
Морской бой! 
Загрузка ...
код заканчивается в незапно 
где:
Дата 10.12.2007, 22:53 (
(голосов:3)
Дата 10.12.2007, 23:06 (
