Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Морской бой! 
:(
    Опции темы
EnShTe1N
Дата 10.12.2007, 20:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 23
Регистрация: 9.12.2007

Репутация: нет
Всего: нет



Код игры морской бой на Delphi:

Код

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
          


Это сообщение отредактировал(а) EnShTe1N - 10.12.2007, 20:58
PM MAIL   Вверх
tommy256
Дата 10.12.2007, 21:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 27
Регистрация: 28.11.2007

Репутация: нет
Всего: нет



Можно поиграть? smile
PM MAIL ICQ   Вверх
EnShTe1N
Дата 10.12.2007, 21:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 23
Регистрация: 9.12.2007

Репутация: нет
Всего: нет



Цитата(tommy256 @ 10.12.2007,  21:01)
Можно поиграть? smile

Играй хоть до посинения!!!
PM MAIL   Вверх
ivan219
  Дата 10.12.2007, 22:53 (ссылка) |    (голосов:3) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 5
Всего: 12



Цитата(EnShTe1N @  10.12.2007,  21:02 Найти цитируемый пост)
Играй хоть до посинения!!!

Новерное до посинения и будет  smile код заканчивается в незапно smile где:
Код

end;
end.

PM MAIL ICQ   Вверх
Sanchezzz
  Дата 10.12.2007, 23:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1670
Регистрация: 19.11.2006
Где: Voronezh

Репутация: 1
Всего: 60



потом потестю если получится поиграть то сделаю на миранду плагин на основе твоего исходника.. EnShTe1N  автор ты исходника? smile


--------------------
Понравился ответ "+" по репе, не забываем закрывать тему, заказы в LS.
PM MAIL Skype GTalk   Вверх
THandle
Дата 11.12.2007, 09:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 50
Всего: 372



А где конец то? Почему заканчивается код на строке    while(tmp = FAILED) do. Где окончание? Выкладывай всё давайsmile
PM   Вверх
EnShTe1N
Дата 11.12.2007, 14:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 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;


Модератор: дальше не влезло
                
          

Это сообщение отредактировал(а) Alexeis - 11.12.2007, 15:33
PM MAIL   Вверх
EnShTe1N
Дата 11.12.2007, 14:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 23
Регистрация: 9.12.2007

Репутация: нет
Всего: нет



ыв

Добавлено через 4 минуты и 26 секунд
Кароче дерьмовый форум, я не знаю как тут выложить полный код, если получится слово "дерьмовый" уберу

Это сообщение отредактировал(а) EnShTe1N - 11.12.2007, 14:59
PM MAIL   Вверх
Alexeis
Дата 11.12.2007, 15:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 34
Всего: 459



EnShTe1N форум офигел от такого сорца  smile 

Просто приатач архивчиком smile 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »


 




[ Время генерации скрипта: 0.1080 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.