Как написать на делфи простую игру?

[rfgecnf]

Завожу тему) )

[x77]

ну, давайте писать. только по-быстрому что-то простое, типа тетриса, сапёра, линий и прочей лабуды. что именно?

[x77]

есть, кстати, тема интересная. можно наваять что-то по мотивам King's Bounty под винду.

[rfgecnf]

ну...простая_текстовая_так)_или_сложно_будет_а?(ссори_пробел_барахлит) мм_в_King's_Bounty_не_играл_давай_попробуем)

[x77]

Капустник, человек, не игравший в King's Bounty, не имеет морального права называться программером http://dosgames.ru/index.php?action=game&act=sub&id=114

можно и текстовую. что-то типа рпг или квеста, но без графики. типа, настольный mud

[rfgecnf]

всё, клаву почистил пробел работает, када эта игра вышла меня на свете не было!)

[x77]

Капустник, ну, игра культовая. комменты почитай куче народа она нравится больше героев и прочего

в принципе, можно сделать что-то аналогичное на дельфе. чтобы безо всяких досбоксов тихо-скромно оно жило в окошке где-нить. в разгар напряжённого рабочего дня

[x77]

но по времени это где-то с месяц займёт. недели две - минимум. если не пугает и других предложений нет - то можно попробовать.

[rfgecnf]

 ну вот King's Bounty не качаеться! блин хостинг у них отключён(, а немного информации про mud можно? Я думаю не стоить начинаь сразу и игр с графикой(или стоит?) а так пожалуй начнём, спешить некуда)

[x77]

Капустник, мады - это текстовые игры. нагугли Dungeon And Dragons, или просто DnD. c них все рпг и начинались, когда-то. ещё безо всяких компьютеров, на бумажке с кубиками. рассказывать это - нереально долго, на диссертацию потянет свободно

другой вариант. были (да и есть ещё наверное где-то) такие штуки, назывались "книжка-игра". на первой странице читаешь вводную, типа где ты оказался и зачем, дальше у тебя начинается выбор. например, открыть дверь налево - стр. 10, посмотреть в шкафу - страница 50. а на странице 50 будет написано - проверьте удачу (т.е. киньте кубик), если выпало чётное число - вы нашли лом. ну и т.д.

при желании можно наворочать достаточно нелинейный сюжет, с развитием параметров, и пр.

[x77]

ты расскажи, что ты сам хочешь.

[rfgecnf]

ура я её скачал! ну попробуем давай чтонить вроде мада

[x77]

хых. ну, давай. в какой области? фантастика, фэнтэзи, ещё что-нибудь? тебе что больше нравится, "постаппокалиптический мир", или полуголые девки с арбалетами?

[rfgecnf]

Star Wars-наверн это)

[x77]

а ты уверен, что хочешь именно mud? Multi User Dungeon? это подразумевает несколько игроков, т.е. в том или ином виде игра должна быть сетевой.

[rfgecnf]

сетевой.. всё, окончательно запутался))) ладно ладно)) Знаешь так) Пусть это будет текстовая игрушка для одного игрока в духе Star Wars)

[x77]

пусть будет. какой жанр? текстовый шутер, я думаю, писать смысла нет, значит это будет что? стратегия? квест?

[rfgecnf]

мм 4й эпизод смотрел? вот квестик по мотивам 4го эпизода

[x77]

Капустник, не помню напиши сюжет вкратце, всё равно будет нужен.

[rfgecnf]

ок! Значит так Корелийская канарейка(кажись так) на которой летит принцесса Лея попадает в захватывающий луч Имперского корабля, после удачного штурма Дарт Вейдер не находит планов Звезды Смерти, От корабля отстыковывается спасательняа капсула, на борту которой находятся 2джоида: С3РО и R2D2, после этого они попадают на планету Татуин где их хватают джавы(а кстать вот мульт можна быстренько всё вспомнить)  http://umora.ru/dl.cgi?file=115056909269123.swf уу еле нашёл) еси не вспомнишь, буду продолжать)

[x77]

ыыыыыыыыыыыыыыы..... я не могу............ "Use the Force, Dude!"............ ыыыыыыыыыыыыы

[x77]

аццкий мульт ладно, вспомнил.

квест от имени Люка, я так понимаю?

[rfgecnf]

гыыыыы, да, от Люка), потом сделаем за Империю)

[rfgecnf]

и так обязательно будет use the Force,Dude!)))

[x77]

значит, начинается на Татуине. с того, что он идёт покупать роботов. я правильно понимаю?

10. Покупка роботов
20. Починка Р2Д2
30. Робот сваливает - поиски робота
40. Перестрелка с этими дебилами в рояле на колёсах
50. Разговор с Оби Ван Кеноби
60. Сбегание на корабле с тем придуром и волосатым.
70. Спасение принцессы из звезды смерти
80. Штурм звезды смерти.

так, примерно? тут квестов не особо много получается, и непонятно, как в тексте перестрелки и пр. изображать.

[rfgecnf]

мм да, но обязательно надо бы рисунок поставить как Алдераан(кажись так) Звезда Смерти взрывает)

[rfgecnf]

тока бы Джордж Лукас в суд не подал)

[x77]

я себе так представляю, что есть просто текст на экране и в зависимости от возможных действий - набор кнопок. по нажатию на кнопку - следующее действие. возникает вопрос, а чём будут заключаться квесты. ну, пошёл он, купил робота, и что? где тут думать? и о чём, главное?

[rfgecnf]

а обязательно должен быть смысл? ну а в чём смысл фильма? победить империю, муками, старанием, шаг в неправильную сторону-труп

[x77]

Капустник, а мы своё сценарий сделаем. StarWars за ганьджубас. Империя запретила курить марихуанну. Звезда смерти - имперская секретная плантация. Оби-Ван-Кеноби - главный растаман, активист движения Legalize It, по суровой укурке собравший стебанутого робота, в которого зашил технологию производства бульбуляторов, пытающийся втянуть в растаманство юного Люка Скайвокера. Лия - глава звёздной системы, специализировавшейся на выращивании конопли в галактических масштабах. Борется с имперской монополией. Лукас у нас на коленях будет лицензию просить. ладно, это неважно.

ты мне лучше скажи, в чём квесты будут заключатся.

[x77]

Капустник, ну, хотелось бы, чтобы юзер не тупо жал кнопки "Дальше", "Дальше", "Дальше", а иногда юзал моск.

[rfgecnf]

......да уж, вопрос))  ну скажем например идёшь по планете там отряд штурмовиков, что делать? спрататься или попереть в лоб? или скажем космос, летит ракета, как увернуться или увеличить скорость?  что то вробе этого
лан я оффлайн до 19поем  и уроки(

[x77]

угу....

ну, можно так. сценарий хранить, как xml-файл. "игра" - по сути, просто плеер сценариев -  будет подгружать этот файл и воспроизводить. можно будет небольшой редактор сценариев потом прикрутить. т.е. задачу решить в общем виде. а потом писать любые сценарии и "играть" в них в плеере.

[rfgecnf]

с чего начнём?

[x77]

я сейчас сбегаю, и до понедельника уже не появлюсь. нужно следующее.

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

после этого можно написать простенький xml, из двух локаций всего, и начинать ваять интерфейс.

[rfgecnf]

мм впринципе думаю характеристики ненужны... а нобер доступных дейтвий, даж незнаю

[x77]

Капустник, с характеристиками интереснее. на успешные действия можно вешать увеличение какого-то навыка. сами действия:

1. переход в другую локацию
2. бой
3. взять
4. оглядеться

и т.д. много не надо, основные хотя бы.

[rfgecnf]

ну впринципе это же будет квест ебз графики, а чё писать просто в текстовом документе характеристики, иль где?

[x77]

Капустник, характеристики будут определять возможность совершить то или иное действие. например, можно гонки прикрутить. если этот ёжик летать не научится - не сможет потом звезду взорвать. ну и т.д.

а писать просто в отдельном окне где-нить, типа

Сила
Ловкость
Выносливость
Накуренность

и т.д.

[rfgecnf]

лан, подождём до понедельника, там посмотрим

[rfgecnf]

знаешь ,давай начнём лучьше с тетриса)

[Алексей++]

Капустник, характеристики будут определять возможность

....
....

Сила
Ловкость
Выносливость
Накуренность

и т.д.

напоминает "гопника " ) скинуть программку?

[rfgecnf]

гы, а я для тетриса сюжет придумал: мы жители нижниго народа! и однажды какой та казёл с неба начал кидать на нас фсякими фигурками! а еси будет полный экранчик появиться надпись: GAME OVER! вот такие дела а еси собирать их всести в одну линию они ищёзнут!

нда гнопик игра-жесть

[Алексей++]

Капустник, хе хе хе... тетрис - игра бесконечная и без сюжета. Истинно русская игра )) , изобретённая русским ))

[rfgecnf]

ну да изобрёл её русский человек) но сюжет есть даже в тетрисе(см журнал "Игромания") ыыы

[Алексей++]

игромания - отстой дремучий

[rfgecnf]

ну незнаю, незнаю , чатию больше года, меня устраивает

[MS]

Игромания - журнал для геймеров от 14 до 16, из программирования там только примеры в 2 строки

[rfgecnf]

2страницы)

[x77]

Капустник, ну фто? тетрис?

[rfgecnf]

ДА!

[x77]

тогда последний вопрос. насколько подробно описывать процесс? стоит ли, например, размусоливать про то же ООП, что-то объяснять, или просто приводить код?

[rfgecnf]

просо, сделать тетрис,без мусолиней

[x77]

ладно, поехали. боевая задача:

1. написать унаследованный от TStringGrid класс, скажем, TGameGrid, который будет предком для любой игры клеточной типа, вроде тетриса, сапёра, или, там, крестиков - ноликов.

2. написать класс TTetris, унаследованный от TGameGrid, который и будет, собственно, игрой.

3. сделать интерфейс, в котором будет юзаться этот класс (TTetris).

для простоты пункты 2 и 3 имеет смысл совместить. щас перекурю и будем ваять.

[x77]

примерный код для TGameGrid:

Код:

unit GameGridClass;

interface

uses
  Windows, Classes, Forms, Grids;

type
  TGameState = (gsNone, gsPlaying, gsUserWon, gsUserLoose);

  TGameGrid = class (TStringGrid)
  private
    fScore: integer;
    fState: TGameState;
    fSpeed: integer;
    fUseSpeed: boolean;
    procedure Wait (Ms: Cardinal);
  public
    property Score: integer read fScore write fScore default 0;
    property Speed: integer read fSpeed write fSpeed default 1000;
    property State: TGameState read fState default gsNone;
    property UseSpeed: boolean read fUseSpeed write fUseSpeed default TRUE;
    constructor Create (AOwner: TComponent); override;
    procedure Move; virtual; abstract;
    procedure Play; virtual;
    procedure Prepare; virtual; abstract;
  end;

implementation

{ TGameGrid }

constructor TGameGrid.Create(AOwner: TComponent);
begin
  inherited;
  fScore := 0;
  fSpeed := 1000;
  fState := gsNone;
  fUseSpeed := TRUE;
end;

procedure TGameGrid.Play;
begin
  while TRUE do begin
    if fState <> gsPlaying then
      Break;
    Move;
    if fUseSpeed then
      Wait (fSpeed);
  end;
end;

procedure TGameGrid.Wait(Ms: Cardinal);
var
  OldTickCount: Cardinal;
begin
  OldTickCount := GetTickCount;
  while GetTickCount - OldTickCount < Ms do
    Application.ProcessMessages;
end;

end.

пока никуда не прикручивал его, просто набросал логику любой "тетрисоподобной" игрушки. если есть вопросы - спрашивайте, я пока остальным займусь.

[x77]

шота молчать все, как рыбы об танк.... ладно, продолжим из любви к исскуству.

модуль TetrisGameClass:

Код:

unit TetrisGameClass;

interface

uses
  Classes, Graphics, SysUtils, Types, StdCtrls, Grids, GameGridClass, ExtCtrls;

const
  clFixed = clBtnFace;
  clEmpty = clWhite;
  clFigure = clBlue;
  clDropped = clGreen;


type
  TTetrisGame = class (TGameGrid)
  private
    procedure Freeze;
    procedure NewFigure;
    function CheckSpace (dx, dy: integer): boolean;
    procedure CheckState;
  protected
    procedure DeleteRow (ARow: integer); override;
  public
    constructor Create (AComponent: TComponent); override;
    procedure DrawCell (ACol, ARow: integer;
      ARect: TRect; AState: TGridDrawState); override;
    procedure FigureLeft;
    procedure FigureRight;
    procedure Move; override;
    procedure MoveFigure (dx, dy: integer);
    procedure Prepare; override;
  end;

implementation

{ TTetrisGame }

function TTetrisGame.CheckSpace(dx, dy: integer): boolean;
var
  i, j: integer;
begin
  Result := TRUE;
  for j := RowCount - dy - 1 downto 0 do begin
    for i := 1 to ColCount - 2 do begin
      if Cells [i, j] = '1' then begin
        if (Cells [i + dx, j + dy] = '0') or
          (Cells [i + dx, j + dy] = '2') then
          Result := FALSE;
      end;
    end;
  end;
end;

procedure TTetrisGame.CheckState;
var
  i, j: integer;
  AGameOver,
  AFilledRow: boolean;
begin
  j := RowCount - 2;
  while j >= 0 do begin
    AFilledRow := TRUE;
    for i := 1 to ColCount - 2 do
      if Cells [i, j] <> '2' then
        AFilledRow := FALSE;
    if AFilledRow then
      DeleteRow (j)
    else
      Dec (j);
  end;

  AGameOver := FALSE;
  for j := RowCount - 1 downto 0 do
    for i := 1 to ColCount - 2 do
      if (Cells [i, j] = '2') and (j < 4) then
        AGameOver := TRUE;
  if AGameOver then
    State := gsUserLoose;
end;

constructor TTetrisGame.Create(AComponent: TComponent);
begin
  inherited;
  FixedCols := 0;
  FixedRows := 0;
  ColCount := 11;
  RowCount := 21;
  DefaultColWidth := 16;
  DefaultRowHeight := 16;
  DefaultDrawing := FALSE;
  GridLineWidth := 0;
  ScrollBars := ssNone;
  Options := [];
  Width := (DefaultColWidth + GridLineWidth) * ColCount + 4;
  Height := (DefaultRowHeight + GridLineWidth) * RowCount + 4;
  Randomize;
end;


procedure TTetrisGame.DeleteRow(ARow: integer);
var
  i, j: integer;
begin
  for j := ARow downto 1 do
    for i := 1 to ColCount - 2 do
      Cells [i, j] := Cells [i, j - 1];
  for i := 1 to ColCount - 2 do
    Cells [i, 0] := '';
end;

procedure TTetrisGame.DrawCell(ACol, ARow: integer; ARect: TRect;
  AState: TGridDrawState);
var
  AValue: integer;
begin
  inherited;
  with Canvas do begin
    if Cells [ACol, ARow] <> '' then begin
      AValue := StrToInt (Cells [ACol, ARow]);
      case AValue of
        0: begin
          Brush.Color := clFixed;
          FillRect (ARect);
          Frame3D (Canvas, ARect, clWhite, clGray, 1);
        end;
        1: begin
          Brush.Color := clFigure;
          FillRect (ARect);
          Frame3D (Canvas, ARect, clAqua, clNavy, 1);
        end;
        2: begin
          Brush.Color := clDropped;
          FillRect (ARect);
          Frame3D (Canvas, ARect, clLime, clTeal, 1);
        end;
      end;
    end else begin
      Brush.Color := clEmpty;
      FillRect (ARect);
    end;
  end;

end;

procedure TTetrisGame.FigureLeft;
begin
  if CheckSpace (-1, 0) then
    MoveFigure (-1, 0);
end;

procedure TTetrisGame.FigureRight;
begin
  if CheckSpace (1, 0) then
    MoveFigure (1, 0);
end;

procedure TTetrisGame.Freeze;
var
  i, j: integer;
begin
  for j := 0 to RowCount - 1 do
    for i := 1 to ColCount - 2 do
      if Cells [i, j] = '1' then
        Cells [i, j] := '2';
end;

procedure TTetrisGame.Move;
begin
  if CheckSpace (0, 1) then
    MoveFigure (0, 1)
  else begin
    Freeze;
    CheckState;
    if State = gsPlaying then
      NewFigure;
  end;
end;

procedure TTetrisGame.MoveFigure(dx, dy: integer);
var
  i, j: integer;
begin
  for j := RowCount - 2 downto 0 do
    if dx < 0 then begin
      for i := 1 to ColCount - 2 do
        if Cells [i, j] = '1' then
          if Cells [i + dx, j + dy] = '' then begin
            Cells [i + dx, j + dy] := Cells [i, j];
            Cells [i, j] := '';
          end;
    end else begin
      for i := ColCount - 2 downto 1 do
        if Cells [i, j] = '1' then
          if Cells [i + dx, j + dy] = '' then begin
            Cells [i + dx, j + dy] := Cells [i, j];
            Cells [i, j] := '';
          end;
    end;
end;

procedure TTetrisGame.NewFigure;
var
  AFigure,
  ARotation,
  fLeft,
  fTop: integer;
begin
  AFigure := Random (8);
  ARotation := Random (4);
  fLeft := ColCount div 2 - 2;
  fTop := 0;
  case AFigure of
    0, 5..7: begin
      Cells [fLeft + 2, fTop] := '1';
      Cells [fLeft + 2, fTop + 1] := '1';
      Cells [fLeft + 2, fTop + 2] := '1';
      Cells [fLeft + 2, fTop + 3] := '1';
    end;
    1: begin
      Cells [fLeft + 1, fTop] := '1';
      Cells [fLeft + 2, fTop] := '1';
      Cells [fLeft + 1, fTop + 1] := '1';
      Cells [fLeft + 2, fTop + 1] := '1';
    end;
    2: begin
      Cells [fLeft + 1, fTop] := '1';
      Cells [fLeft + 2, fTop] := '1';
      Cells [fLeft + 2, fTop + 1] := '1';
      Cells [fLeft + 3, fTop + 1] := '1';
    end;
    3: begin
      Cells [fLeft + 2, fTop] := '1';
      Cells [fLeft + 3, fTop] := '1';
      Cells [fLeft + 1, fTop + 1] := '1';
      Cells [fLeft + 2, fTop + 1] := '1';
    end;
    4: begin
      Cells [fLeft + 1, fTop] := '1';
      Cells [fLeft + 2, fTop] := '1';
      Cells [fLeft + 3, fTop] := '1';
      Cells [fLeft + 2, fTop + 1] := '1';
    end;
  end;
end;

procedure TTetrisGame.Prepare;
var
  i, j: integer;
begin
  for i := 1 to ColCount - 2 do
    for j := 0 to RowCount - 2 do
      Cells [i, j] := '';
  for i := 0 to RowCount - 1 do begin
    Cells [0, i] := '0';
    Cells [ColCount - 1, i] := '0';
  end;
  for i := 1 to ColCount - 2 do
    Cells [i, RowCount - 1] := '0';
  NewFigure;
end;

end.

куча недоделок. например, генерится только 4 фигуры вместо 7 (лениво дописывать однотипные вещи), фигуры не умеют переворачиваться и "падать" вниз до конца по нажатию кнопки, не увеличивается скорость, ну и ещё парочка мелочей. но в целом фигуры генерятся, падают, двигаются вправо/влево, и при заполнении ряда он стирается. о, ещё подсчёт очков тоже лень писать.

сама программа выглядит так:

Код:

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GameGridClass, TetrisGameClass, StdCtrls;

type
  TFormMain = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    fTetris: TTetrisGame;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  fTetris := TTetrisGame.Create (Self);
  fTetris.Parent := Self;
  fTetris.Speed := 500;
  fTetris.Prepare;
end;

procedure TFormMain.Button1Click(Sender: TObject);
begin
  if fTetris.State <> gsPaused then
    fTetris.Prepare;
  fTetris.Play;
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fTetris.Stop;
  Action := caFree;
end;

procedure TFormMain.Button2Click(Sender: TObject);
begin
  fTetris.Pause;
end;

procedure TFormMain.Button3Click(Sender: TObject);
begin
  fTetris.FigureLeft;
end;

procedure TFormMain.Button4Click(Sender: TObject);
begin
  fTetris.FigureRight;
end;

end.

будет нечего делать - допишу остальное.

[x77]

ну и дабы закрыть тему...

готовый проект (сделано всё, кроме вращения - поставил заглушку, кому интересно - дописывайте )

ну и скриншот.

[rfgecnf]

ы

[rfgecnf]

слух ,а ты можешь мне объяснить как чиловеку каторый васче ничё нипанимает а?
создай то создай это я думаешь знаю чё это?))

[x77]

Капустник, я же спрашивал - надо объяснять? завтра будут комментарии

[_MK]

Простенькую? Эх. Давно это было. Вот. Простейшая игруша. Все на Api. Написал где-то за 1 час.

Код:

program Project;

{$R 'resourse\project.res' 'resourse\project.rc'}

uses
  Windows,
  Messages;

Const ClassName      = 'GameClass';
Const IconName       = 'ID_ICON';
Const TitleName      = 'Пятнашки 15 vs 15';
Const MenuName       = 'programMenuName';
Const ButtonClass    = 'BUTTON';
Const VictoryMessage = 'Поздравляем! Вы победили!'+ #13 + 'Хотите ли вы повторить?';
Const VictoryTitle   = 'Ура!';
Const BueBueMessage  = 'До свидания!';
Const BueBueTitle    = 'Вот и все..';

Const ButtonSize = 100;
Const GameSize   = 15;

Type TGameObject = record
    Gamehandle : HWND;
    Xpos,Ypos    : WORD;
End;

Var GameFirst : Boolean = TRUE;
Var GamePlay : array [0..GameSize] of TGameObject;

Procedure InitGameObject(hwndparent : HWND);
Const ButtonsName : array [0..14] of PAnsiChar = ('1','2','3','4','5','6','7','8','9','10','11','12','13','14','15');
Var X : Byte;
Begin
  For X := 0 to 14 do
    With GamePlay[X] do
      Begin
        Xpos := (X mod 4) * ButtonSize;
        Ypos := (X div 4) * ButtonSize;
      End;
  If GameFirst then
    Begin
      For X := 0 to 14 do
        With GamePlay[X] do
          Begin
            Gamehandle := CreateWindow(ButtonClass,ButtonsName[X],WS_VISIBLE or WS_CHILD,Xpos,Ypos,ButtonSize,ButtonSize,hwndparent,0,hInstance,NIL);
          End;
      GameFirst := False;
    End;
    GamePlay[GameSize].Xpos := (GameSize mod 4) * ButtonSize;
    GamePlay[GameSize].Ypos := (GameSize div 4) * ButtonSize;
End;

Procedure Swap(a,b : byte);
var XX,YY : WORD;
Begin
  XX := GamePlay[a].Xpos;
  GamePlay[a].Xpos  := GamePlay[b].Xpos;
  GamePlay[b].Xpos := XX;
  YY := GamePlay[a].Ypos;
  GamePlay[a].yPos  := GamePlay[b].YPos;
  GamePlay[b].YPos := YY;
End;

Procedure RandomizeGame;
Var A,B,C : Byte;
Begin
  randomize;
  For A := 1 to random(50) do
    Begin
      b := random(GameSize+1);
      c := random(GameSize+1);
      swap(c,b);
      With GamePlay[B] do MoveWindow(GameHandle,Xpos,Ypos,ButtonSize,ButtonSize,true);
      With GamePlay[C] do MoveWindow(GameHandle,Xpos,Ypos,ButtonSize,ButtonSize,true);
    End;
End;

Function CanDoIt(x,y : word) : Byte;
Begin
  If (x-ButtonSize = GamePlay[GameSize].Xpos) and (y = GamePlay[GameSize].YPos) then begin Result := 1; exit end;
  If (x+ButtonSize = GamePlay[GameSize].Xpos) and (y = GamePlay[GameSize].YPos) then begin Result := 2; exit end;
  If (y-ButtonSize = GamePlay[GameSize].Ypos) and (x = GamePlay[GameSize].XPos) then begin Result := 3; exit end;
  If (y+ButtonSize = GamePlay[GameSize].Ypos) and (x = GamePlay[GameSize].XPos) then begin Result := 4; exit end;
  Result := 255;
End;

Procedure CheckGameVictory(hwndParent : HWND);
Var X : Byte;
Begin
  For X := 0 to GameSize do
   With GamePlay[x] do
      If (Xpos <> (X mod 4) * ButtonSize) or (YPos <> (X div 4)*ButtonSize) then exit;

  If MessageBox(0,VictoryMessage,VictoryTitle,MB_YESNO) = IDYES then
    Begin
      InitGameObject(hwndParent);
    End
  else
    Begin
      MessageBox(0,BueBueMessage,BueBueTitle,MB_OK);
      SendMessage(hwndParent,WM_DESTROY,0,0);
    End;
End;


Procedure NewStep(SendHandle : HWND);
Var X : byte;
Begin
  For X := 0 to GameSize do
    If GamePlay[X].GameHandle = SendHandle then
      begin SendHandle := X;  break end;
  Case CanDoIt(GamePlay[SendHandle].Xpos,GamePlay[SendHandle].Ypos) of
   1..4 : swap(SendHandle,GameSize);
    else exit;
  End;
 With GamePlay[GameSize] do MoveWindow(GameHandle,XPos,YPos,ButtonSize,ButtonSize,TRUE);
 With GamePlay[SendHandle] do MoveWindow(GameHandle,XPos,YPos,ButtonSize,ButtonSize,TRUE);
End;

function MainWndProc(handle : HWND; uMsg : UINT; wparam : WPARAM; lparam : LPARAM) : LRESULT; WinApi;
const ID_EXIT = 2;
const ID_HELP = 3;
const ID_ABOUT = 4;
Begin
 case uMsg of
  WM_CREATE: Begin
              ZeroMemory(addr(GamePlay),SizeOf(GamePlay));
              InitGameObject(handle);
              RandomizeGame;
             End;
  WM_COMMAND: begin
                If lparam = 0 then
                  case loword(wparam) of
                    ID_ABOUT: ;
                    ID_HELP: ;
                    ID_EXIT: SendMessage(handle,WM_CLOSE,0,0);
                  end
                else begin NewStep(lparam);  CheckGameVictory(handle);  end
              end;
  WM_DESTROY: PostQuitMessage(0);
 else begin MainWndProc := DefWindowProc(handle, uMsg, wparam, lparam);  exit; end;
 end;
 MainWndProc := 0;
End;

Procedure RegisterWC;
Var WC   : WNDCLASSEX;
    icon : HICON;
Begin
  WC.cbSize := SizeOf(WC);
  WC.style := CS_HREDRAW or CS_VREDRAW ;
  WC.lpfnWndProc := addr(MainWndProc);
  WC.cbClsExtra := 0;
  WC.cbWndExtra := 0;
  WC.hInstance := hInstance;
  icon := LoadIcon(hInstance,IconName);
  WC.hIcon := Icon;
  WC.hIconSm := Icon;
  WC.hCursor := LoadCursor(hInstance,IDC_ICON);
  WC.hbrBackground := COLOR_BTNHIGHLIGHT;
  WC.lpszMenuName := MenuName;
  WC.lpszClassName := ClassName;
  RegisterClassEx(WC);
End;

Procedure CreateMyWindow;
Begin
  CreateWindow(ClassName,TitleName, WS_VISIBLE  or WS_SYSMENU, CW_USEDEFAULT,CW_USEDEFAULT,400,450, 0,0,hInstance,NIL);
End;

Procedure MainProcedure;
Var MyMsg :  MSG;
Begin
  while GetMessage(MyMsg,0, 0, 0) <> LongBool(0)  do
    begin
      TranslateMessage(MyMsg);
      DispatchMessage(MyMsg);
    end;
  ExitProcess(MyMsg.wParam);
End;

begin
  RegisterWC;
  CreateMyWindow;
  MainProcedure;
end.

--------------------project.rc-----------------------------------
;This Resource Script was generated by WinAsm Studio.

#define ID_FILE 1
#define ID_EXIT 2
#define ID_HELP 3
#define ID_ICON 1000
#define ID_ABOUT 4

ID_ICON ICON DISCARDABLE "Icon.ico"

programMenuName MENUEX DISCARDABLE
BEGIN
	POPUP "&File",ID_FILE
	BEGIN
		MENUITEM "Exit",ID_EXIT
	END
	MENUITEM "&About",ID_ABOUT
	MENUITEM "H&elp",ID_HELP
END

[_MK]

p.s Сейчас как раз пишу генератор квестов. Собираюсь прикрутить музыку. Возможность самому п-ть дввижки, вставлять картинки. etc... Напишу, думаю скину сюда.

[x77]

_MK, а генератор квестов для чего?

[x77]

Капустник, извини, несколько раз пытался начать всё откомментить, но понял - что делое гиблое. объяснение простого ключевого слова class само по себе тянет на небольшой реферат. будет проще, если ты задашь конкретные вопросы, если они у тебя есть. а я, в свою очередь, постараюсь ответить.

[_MK]

x77
Для создания текстовых квестов. Сама по себе идея не новая, но в реализации есть довольно интересные моменты, так к примеру, я собираюсь дать пользвателю возможность самому распологать кнопки, поля ввода-вывода, вводить новые характеристики (допустим силу ) описывающие персонажей, работать с этими характеристиками. По сути дела это то же программирование, но уже на сверхвысоком уровне (и в переделах игры).

[Алексей++]

Offtopic:

в посте #56 - Игоревский проект и скрин тетриса на Дельфи - может тоже в файлы пора ? )

Поставлю в угол.

[RXL]

Алексей1153++, можно.

[rfgecnf]

Ох, боже, это надо было же найти тот самый форум через 5 лет и посмотреть на всё это дело, повзрослев) Я тогда свалил, не сказав спасибо. Извиняюсь, спасибо за помощь 5 лет назад

[RXL]

rfgecnf, с возвращением!

[rfgecnf]

Спасибо) А вот "Гопника", которого выкладывали тут когда-то я до сих пор не могу пройти 

[Алексей++]

Спасибо) А вот "Гопника", которого выкладывали тут когда-то я до сих пор не могу пройти 

ну да, там рулетка ) Я прошёл как-то. В конце этого крутого-прекрутого декана надо запинать, а уже ближе к концу запина тебя ждёт большой сюрприз Это чтобы раззадорить тебя ))

Самое главное в игре - как можно больше бабосов заработать. Далее как лавина - прокачиваешься в тренажёрках, закупаешь побольше жратвы, крутизна прёт

[x77]

rfgecnf, пожалуйста