urunning.pas

一个dos游戏的源代码

//极限1000米
//Author: CrazyWill
//Email: [e-mail]

unit uRunning;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ExtCtrls, StdCtrls, IniFiles,
  uInclude, uSprite, uMap, uArrow, uCut, uFire, MPlayer;

type

  TForm_Run = class(TForm)
    Label1: TLabel;
    pnlView: TPanel;
    pbxView: TPaintBox;
    Timer1: TTimer;
    MediaPlayer1: TMediaPlayer;
    MediaPlayer2: TMediaPlayer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    Map: TMap;
    Sprite: TSprite;
    Cut: TCut;
    Arrows: array[1..MaxArrowNumber] of TArrow;
    Fires: array[1..MaxFireNumber] of TFire;

    FBackBitmap: TBitmap; // dobule-buffering

    FGameStatus: TGameStatus; // 游戏状态

    procedure Init;
    procedure InitGame;
    procedure UpdateView;
    procedure DrawBackBitmap;
    procedure DrawStatusBox(S: string; TopOrCenter: Boolean);
    procedure UpdateControlStatus;

    procedure SetGameStatus(Value: TGameStatus);

    procedure GameLoop; // 游戏主循环

    //碰撞检查
    function CheckCollisions: Boolean;

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form_Run: TForm_Run;
  sound: Boolean;

implementation

uses uRun;

{$R *.dfm}

procedure TForm_Run.UpdateView;
begin
  DrawBackBitmap; // 先画在内存的bitmap上
  pbxView.Canvas.Draw(0, 0, FBackBitmap); // 再复制到屏幕
end;

// 先将画面绘制在缓冲用 bitmap, 再复制到屏幕

procedure TForm_Run.DrawBackBitmap;
var
  Str: string;
  R: TRect;
  i: integer;
begin
  Map.Draw(FBackBitmap.Canvas);
  for i := 1 to MaxArrowNumber do
    Arrows[i].Draw(FBackBitmap.Canvas);
  Sprite.Draw(FBackBitmap.Canvas);

  for i := 1 to MaxFireNumber do
    Fires[i].Draw(FBackBitmap.Canvas);
  Cut.Draw(FBackBitmap.Canvas);

  //    FBackBitmap.Canvas.Brush.Color := clBlack;
  //    FBackBitmap.Canvas.FillRect(FBackBitmap.Canvas.ClipRect);

  with FBackBitmap.Canvas do
  begin
    Font.Color := clWhite;
    Font.name := 'FixedSys';
    Font.Style := [fsBold];
    Font.Size := 12;
    Brush.Style := bsClear;

    case FGameStatus of
      gsTitle: //画出上面的标题大字及下方的作者名称
        begin
          R := Rect(0, 0, WORLD_WIDTH,
            WORLD_HEIGHT - TextHeight('и'));
          DrawText(Handle, '“潮之阳”软件工作室', -1, R,
            DT_BOTTOM or DT_CENTER or DT_SINGLELINE);
          DrawStatusBox('极限1000米', True);
        end;

      gsOver:
        DrawStatusBox('Game Over', False);

    else
      begin
        //右上角显示生命力及行程
        Str := Format('生命力：%d  行程：%d',
          [Sprite.HP, Map.CurrentMetre]);
        TextOut(WORLD_WIDTH - TextWidth(Str) - 5, 5, Str);
      end;
    end;

    //过关画面
    if FGameStatus = gsSuccess then
      DrawStatusBox('Success!', False);
  end;
end;

procedure TForm_Run.Init;
var
  ini: TINIFILE;
  Filename: string;

begin
  Filename := ExtractFilePath(Paramstr(0)) + GameIniFilename;

  try
    ini := TINIFILE.Create(Filename);
  except
    showmessage('打开INI文件出错');
    close;
  end;

  IniDirectory := ini.ReadString('Game', 'IniDirectory', IniDirectory);
  IniDirectory := ExtractFilePath(Paramstr(0)) + IniDirectory + '\';

  ////  IniFilename := ini.ReadString('Game', 'IniFilename', IniFilename);

  ini.Destroy;

  ini := TINIFILE.Create(IniDirectory + IniFilename);

  CurrentSkinName := ini.ReadString('Base', 'SkinName', CurrentSkinName);
  Transparent_Color := ini.ReadInteger('Base', 'Transparent_Color', clBlack);
  WORLD_WIDTH := ini.ReadInteger('Map', 'Width', WORLD_WIDTH);
  WORLD_HEIGHT := ini.ReadInteger('Map', 'Height', WORLD_HEIGHT);

  MapRollSpeed := ini.ReadInteger('Map', 'Speed', MapRollSpeed);

  ini.Destroy;
end;

procedure TForm_Run.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i: integer;
begin
  if (FGameStatus = gsPlaying) or (FGameStatus = gsPause) then
  begin
    Action := caNone; /// 禁用窗口右上角的X按钮退出程序
    Exit; /// 退出必须按ESC键正常退出
  end;

  SetGameStatus(gsPause);

  Timer1.Enabled := false;

  FBackBitmap.Destroy;

  for i := 1 to MaxFireNumber do
    Fires[i].Destroy;
  for i := 1 to MaxArrowNumber do
    Arrows[i].Destroy;
  Cut.Destroy;
  Sprite.Destroy;
  Map.Destroy;

  MediaPlayer1.Close;

  Form_Main.Close;
end;

procedure TForm_Run.FormCreate(Sender: TObject);
var
  i: integer;
  fn: string;
begin
  init;

  Map := TMap.Create;
  Sprite := TSprite.Create;
  Cut := TCut.Create;

  for i := 1 to MaxArrowNumber do
    Arrows[i] := TArrow.Create;

  for i := 1 to MaxFireNumber do
    Fires[i] := TFire.Create;

  pnlView.ClientWidth := Map.Width;
  pnlView.ClientHeight := Map.Height;

  pbxView.Width := Map.Width;
  pbxView.Height := Map.Height;

  self.ClientWidth := Map.Width;
  self.ClientHeight := Map.Height;

  self.Top := (SCREEN.Height - self.Height) div 2;
  self.Left := (SCREEN.Width - self.Width) div 2;

  FBackBitmap := TBitmap.Create;
  FBackBitmap.Width := Map.Width;
  FBackBitmap.Height := Map.Height;

  InitGame;

  UpdateView;

  Timer1.Enabled := true;

  SetGameStatus(gsTitle);

  Sprite.Active := false;
  Map.Active := true;
  Cut.Active := true;
  Arrows[1].Active := true;

  fn := ExtractFilePath(Paramstr(0)) + 'RUN.MID';
  if FileExists(fn) then
  begin
    MediaPlayer1.FileName := fn;
    MediaPlayer1.Open;
    sound := True;
  end
  else
    sound := False;

end;

procedure TForm_Run.Timer1Timer(Sender: TObject);
var
  i: integer;
begin
  if Sprite.Active then
  begin
    Map.Roll;
    Cut.Cut;
    if Map.Active then
    begin
      for i := 1 to MaxArrowNumber do
        Arrows[i].X := Arrows[1].X - MapRollSpeed;
      for i := 1 to MaxFireNumber do
        Fires[i].X := Fires[i].X - MapRollSpeed;
    end;

    for i := 1 to MaxArrowNumber do
      Arrows[i].Roll;
    for i := 1 to MaxFireNumber do
      Fires[i].Drop;

    Sprite.Move;
  end
  else
  begin
    if Map.Active then
    begin
      Map.Roll;
      Cut.Cut;
      for i := 1 to MaxArrowNumber do
      begin
        Arrows[i].X := Arrows[1].X - MapRollSpeed;
        Arrows[i].Roll;
      end;
      for i := 1 to MaxFireNumber do
      begin
        Fires[i].X := Fires[i].X - MapRollSpeed;
        Fires[i].Drop;
      end;

      Sprite.RollBack;
    end
  end;

  CheckCollisions;

  UpdateView;
end;

procedure TForm_Run.DrawStatusBox(S: string; TopOrCenter: Boolean);
var
  R: TRect;
  TextSize: TSize;
begin
  with FBackBitmap, FBackBitmap.Canvas do
  begin
    Font.Color := clWhite; //设置字体属性
    Font.name := 'FixedSys';
    Font.Style := [fsBold];
    Font.Size := 36;

    TextSize := TextExtent(S);
    // first calculate the necessary rectangle
    R := Rect(0, 0, TextSize.cx, TextSize.cy);
    OffsetRect(R, (Width - TextSize.cx) div 2, (Height - TextSize.cy) div 2);
    // 将框框置于画面中央

    if TopOrCenter then
    begin
      R.Top := 24; // 将框框摆在上方中间
      R.Bottom := R.Top + TextSize.cy;
    end;

    InflateRect(R, 10, 10); //描绘外框，宽度为10
    Pen.Width := 4;
    Pen.Color := clWhite;
    Pen.Style := psSolid;
    Brush.Color := clBlue;
    Brush.Style := bsSolid;
    Rectangle(R.Left, R.Top, R.Right, R.Bottom);
    //  将字画出来，置中对齐
    DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_CENTER or DT_SINGLELINE
      or
      DT_VCENTER);
  end;
end;

procedure TForm_Run.SetGameStatus(Value: TGameStatus);
var
  fn: string;
begin
  FGameStatus := Value;

  //根据新的游戏状态开关定时器
  Timer1.Enabled := (FGameStatus = gsPlaying);

  case FGameStatus of
    gsTitle:
      begin
        Sprite.Active := false;
        Map.Active := false;

      end;

    gsPlaying:
      begin
        Sprite.Active := False;
        Map.Active := True;

        UpdateControlStatus; //更新标题栏及菜单
        UpdateView; //更新游戏画面

        GameLoop; //  进入游戏主循环（游戏进行中程序一直在此循环内）
        /////////////////////////////
      end;