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

[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]

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