www.pudn.com > Tank坦克游戏代码.rar > main.pas

unit main; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  MMSystem, ExtCtrls, ComCtrls, Menus, StdCtrls, Sprite; 
 
type 
  TGameStatus = (gsTitle, // 欢迎画面 
                 gsPlaying, // 游戏进行中 
                 gsSuccess, // 过关画面 
                 gsOver, // GAME OVER 
                 gsTerminate); // 程式即将关闭 
 
  TMainForm = class(TForm) 
    pnlView: TPanel; 
    pbxView: TPaintBox; 
    mnuMain: TMainMenu; 
    mnuGame: TMenuItem; 
    mnuExit: TMenuItem; 
    N1: TMenuItem; 
    mnuChooseLevel: TMenuItem; 
    mnuHelp: TMenuItem; 
    mnuAbout: TMenuItem; 
    mnuStartGame: TMenuItem; 
    N2: TMenuItem; 
    mnuRestart: TMenuItem; 
    mnuPrevLevel: TMenuItem; 
    mnuNextLevel: TMenuItem; 
    N3: TMenuItem; 
    tmrTitle: TTimer; 
    M1: TMenuItem; 
    mnuSuperMode: TMenuItem; 
    mnuUnlimitedBullet: TMenuItem; 
    N4: TMenuItem; 
    mnuDrawLayer1: TMenuItem; 
    mnuDrawLayer2: TMenuItem; 
    mnuDrawLayer3: TMenuItem; 
    mnuDrawLayer4: TMenuItem; 
    procedure pbxViewPaint(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure mnuStartGameClick(Sender: TObject); 
    procedure mnuChooseLevelClick(Sender: TObject); 
    procedure FormKeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure mnuAboutClick(Sender: TObject); 
    procedure mnuExitClick(Sender: TObject); 
    procedure mnuRestartClick(Sender: TObject); 
    procedure mnuNextLevelClick(Sender: TObject); 
    procedure tmrTitleTimer(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure FormKeyUp(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure mnuSuperModeClick(Sender: TObject); 
    procedure mnuDrawLayerClick(Sender: TObject); 
  private 
    FGameStatus: TGameStatus; // 游戏状态 
    FLevelNo: Integer; // 目前关卡 
    FTank: TMyTank; // 主角物件 
    FETankUsed: Integer; // 本关卡已出现的敌方坦克 
    FScore: Integer; // 分数 
     
    FBackBitmap: TBitmap; // 用来做 dobule-buffering 的 bitmap 
     
    procedure DrawBackBitmap; // 绘制背景 bitmap 
    procedure UpdateView; // 更新游戏画面 
    procedure UpdateControlStatus; 
     
    // 产生敌方坦克及宝物 
    procedure CreateETank(Kind: Integer); 
    procedure CreateGem(Kind: Integer); 
     
    procedure GameLoop; // 游戏主回圈 
     
    // 在游戏画面中央或正上面绘出字串及外围方框 
    procedure DrawStatusBox(S: string; TopOrCenter: Boolean); 
     
    procedure SetGameStatus(Value: TGameStatus); 
    procedure SetLevelNo(Value: Integer); 
     
    property GameStatus: TGameStatus read FGameStatus write SetGameStatus; 
    property LevelNo: Integer read FLevelNo write SetLevelNo; 
  public 
    { Public declarations } 
  end; 
   
var 
  MainForm: TMainForm; 
   
implementation 
 
uses util, tileunit, Mapunit, about, xFiles; 
 
{$R *.DFM} 
 
procedure TMainForm.UpdateView; 
begin 
  DrawBackBitmap; // 先画在内部的 bitmap 
  pbxView.Canvas.Draw(0, 0, FBackBitmap); // 再拷贝到画面上 
end; 
 
procedure TMainForm.pbxViewPaint(Sender: TObject); 
begin 
  UpdateView; 
end; 
 
procedure TMainForm.FormCreate(Sender: TObject); 
begin 
  FTank := TMyTank.Create; // 产生主角物件 
   
  Tiles := TTiles.Create; // 产生图库物件 
  Map := tmap.Create; // 关卡地图 
  try 
    FTank.LoadBits; // 读入主角图形 
 
    Tiles.LoadFromFile(AppDir + FN_TILE_ARCHIVE); // 读入图库 
  except 
    on E: Exception do 
      begin 
        ShowMessage(E.message); 
        PostMessage(Handle, WM_CLOSE, 0, 0); // 以 asynchronous 方式关闭视窗 
      end; 
  end; 
   
  // 根据常数来调整 pnlView 及视窗的大小 
  pnlView.ClientWidth := WORLD_WIDTH; 
  pnlView.ClientHeight := WORLD_HEIGHT; 
   
  ClientWidth := pnlView.Width; 
  ClientHeight := pnlView.Height; 
   
  FBackBitmap := TBitmap.Create; // 缓冲用 bitmap 
  FBackBitmap.Width := WORLD_WIDTH; 
  FBackBitmap.Height := WORLD_HEIGHT; 
   
  // 预备工作都做好了, 进入 title 画面 
  GameStatus := gsTitle; 
end; 
 
// 先将画面绘制在缓冲用 bitmap, 再复制到视窗上 
procedure TMainForm.DrawBackBitmap; 
var 
  Str: string; 
  R  : TRect; 
begin 
  if mnuDrawLayer1.Checked then // 绘制地形层 
    Map.DrawMap(LAYER_TERR, FBackBitmap.Canvas) 
  else begin // 若没画地形层, 就涂黑 
    FBackBitmap.Canvas.Brush.Color := clBlack; 
    FBackBitmap.Canvas.FillRect(FBackBitmap.Canvas.ClipRect); 
  end; 
 
  if mnuDrawLayer2.Checked then // 绘制地形物层 
    Map.DrawMap(LAYER_TERRITEM, FBackBitmap.Canvas); 
 
  if mnuDrawLayer3.Checked then // 绘制物品层 
    Map.DrawMap(LAYER_ITEM, FBackBitmap.Canvas); 
 
  // 若有宝物, 画出宝物 
  if Assigned(Gem) then Gem.Draw(FBackBitmap.Canvas); 
 
  DrawTanks(FBackBitmap.Canvas, False); // 画出地面上所有坦克 
 
  DrawBullets(FBackBitmap.Canvas); // 画出子弹 
 
  if mnuDrawLayer4.Checked then // 绘制高地形物层 
    Map.DrawMap(LAYER_HITERRITEM, FBackBitmap.Canvas); 
 
  // 画出"空中"所有坦克 
  DrawTanks(FBackBitmap.Canvas, True); 
 
  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('坦克大决战', True); 
      end; 
 
      gsOver: // Ouch, 军旗被干掉或主角死掉了 
        DrawStatusBox('任务失败', False); 
 
      else 
      begin 
        // 在右上角显示生命力及分数 
        {$IFDEF DEBUG} 
        Str := Format('(%d, %d) (%d, %d)',[FTank.X, FTank.Y, 
          FTank.tile_x, FTank.tile_y]); 
        {$ELSE} 
        Str := Format('装甲 %.2d 得分 %.4d',[FTank.HP, FScore]); 
        {$ENDIF} 
        TextOut(WORLD_WIDTH - TextWidth(Str) - 5, 5, Str); 
 
        // 在左上角显示关卡 
        Str := Format('任务 %d',[FLevelNo]); 
        TextOut(5, 5, Str); 
      end; 
    end; 
 
    // 过关画面 
    if FGameStatus = gsSuccess then 
      DrawStatusBox('任务成功 !!', False); 
  end; 
end; 
 
procedure TMainForm.SetGameStatus(Value: TGameStatus); 
var 
  I: Integer; 
begin 
  FGameStatus := Value; 
 
  // 根据新的游戏状态开关计时器 
  tmrTitle.Enabled := FGameStatus = gsTitle; 
 
  case FGameStatus of 
    gsTitle: 
    begin 
      LevelNo := 1; // 欢迎画面显示第一关地图 
 
      // 随机产生 MAX_TANK_ON_SCREEN 辆敌方坦克 
      for I := 1 to MAX_TANK_ON_SCREEN do 
        CreateETank(Random(5)); 
 
      FTank.Visible := False; // 将自己坦克藏起来 
      FTank.Active := False; // 自己坦克不要动 
    end; 
 
    gsPlaying: 
    begin 
      UpdateControlStatus; // 更新标题列及其它控制项 
      UpdateView; // 更新游戏画面 
 
      GameLoop; // 进入游戏主回圈 (游戏进行中都一直在此回圈内) 
    end; 
 
    gsSuccess: 
    begin 
    end; 
  end; 
 
  if FGameStatus <> gsTerminate then // 使用者是否欲关闭视窗 ?? 
  begin 
    UpdateControlStatus; // 更新标题列及其它控制项 
    UpdateView; // 更新游戏画面 
  end else 
    Close; // 关闭视窗 
end; 
 
procedure TMainForm.SetLevelNo(Value: Integer); 
begin 
  Map.LevelNo := Value; // 载入关卡地图 
  FTank.X := Map.Role_X; // 将主角摆在关卡指定的位置 
  FTank.Y := Map.Role_Y; 
   
  FLevelNo := Value; 
end; 
 
procedure TMainForm.UpdateControlStatus; 
const 
  StatusStr: array[TGameStatus] of string = ('Welcome', '', '任务成功 !!', 'Game Over', 'Terminating'); 
begin 
  if FGameStatus <> gsPlaying then 
    Caption := Format('%s - %s',[Application.Title, StatusStr[FGameStatus]]) 
  else 
    Caption := Format('%s - 任务 %d',[Application.Title, FLevelNo]); 
   
  // 开关各控制项的致能状态 
  mnuRestart.Enabled := FGameStatus = gsPlaying; 
  mnuStartGame.Enabled := FGameStatus <> gsPlaying; 
   
  mnuPrevLevel.Enabled := (FGameStatus = gsPlaying) and (LevelNo > 1); 
  mnuNextLevel.Enabled := (FGameStatus = gsPlaying); 
end; 
 
// 绘出状态框框, 同时在里面写字 
procedure TMainForm.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 := 20; 
     
    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 TMainForm.mnuStartGameClick(Sender: TObject); 
begin 
  LevelNo := LevelNo; 
  GameStatus := gsPlaying; 
end; 
 
// 让使用者选择关卡 
procedure TMainForm.mnuChooseLevelClick(Sender: TObject); 
var 
  S: string; 
begin 
  S := IntToStr(FLevelNo); 
  if InputQuery(Application.Title, 'Input Scenario No:', S) then 
  begin 
    LevelNo := StrToInt(S); 
 
    if GameStatus <> gsPlaying then 
      GameStatus := gsPlaying 
    else 
      PostMessage(0, WM_INIT_LEVEL, 0, 0); // 开始此关卡 
  end; 
end; 
 
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; 
    Shift: TShiftState); 
begin 
  if FGameStatus = gsPlaying then // 注意, 只有游戏中状态, 键盘控制才有效 
  begin 
    case Key of 
      VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT: 
      begin 
        case Key of 
          VK_UP: FTank.Direction := drUp; // 向上走 
             
          VK_DOWN: FTank.Direction := drDown; // 向下走 
             
          VK_LEFT: FTank.Direction := drLeft; // 向左走 
             
          VK_RIGHT: FTank.Direction := drRight; // 向右走 
        end; 
         
        FTank.Active := True; // 主角开始"动" 
      end; 
       
      VK_SPACE: 
      begin 
        FTank.FireBullet; // 发射子弹, 咻 ~~ 
      end; 
    end; 
  end; 
end; 
 
procedure TMainForm.mnuAboutClick(Sender: TObject); 
begin 
  with TAboutBox.Create(self) do 
    try 
      ShowModal; 
    finally 
      Free; 
    end; 
end; 
 
procedure TMainForm.mnuExitClick(Sender: TObject); 
begin 
  Close; 
end; 
 
procedure TMainForm.mnuRestartClick(Sender: TObject); 
begin 
  LevelNo := LevelNo; 
  PostMessage(0, WM_INIT_LEVEL, 0, 0); // 重新开始此关卡 
end; 
 
procedure TMainForm.mnuNextLevelClick(Sender: TObject); 
begin 
  case (Sender as TComponent).Tag of 
    0: LevelNo := LevelNo - 1; 
    1: LevelNo := LevelNo + 1; 
  end; 
  PostMessage(0, WM_INIT_LEVEL, 0, 0); // 开始新关卡 
end; 
 
// 欢迎画面时使用的计时器, 每 10 毫秒呼叫一次 
procedure TMainForm.tmrTitleTimer(Sender: TObject); 
begin 
  // 移动坦克及子弹 
  MoveTanks; 
  MoveBullets; 
   
  UpdateView; // 更新画面 
end; 
 
// 产生敌方坦克 
procedure TMainForm.CreateETank(Kind: Integer); 
type 
  TETankClass = class of TETank; // metaclass 
const 
  ETankClasses: array[0..4] of TETankClass = 
    (TETank1, TETank2, TETank3, TETank4, TETank5); 
var 
  ETank: TETank; 
begin 
  Inc(FETankUsed); // 递增此关卡已产生的敌方坦克 
 
  // 由 metaclass 变数建立新的敌方坦克 
  ETank := ETankClasses[Kind].Create; 
  ETank.LoadBits; 
end; 
 
// 产生宝物 
procedure TMainForm.CreateGem(Kind: Integer); 
begin 
  Gem := TGem.Create(TGemKind(Kind)); 
  Gem.LoadBits; 
  Gem.RandomPosition; // 随意摆置 
  // 宝物出现 30 秒后自动消失 
  SetTimer(Handle, TIMER_ID_GEM, 30 * 1000, nil); 
end; 
 
procedure TMainForm.GameLoop; 
var 
  bStopEnemy: Boolean; // 是否暂停敌方行动 
 
  // 关卡开始前的初始动作 
  procedure InitLevel; 
  begin 
    FScore := 0; 
    FETankUsed := 0; 
 
    // 主角出现, 不动 
    FTank.Visible := True; 
    FTank.Active := False; 
    FTank.Speed := MYTANK_DEFAULT_SPEED; 
    FTank.ResetStatus; 
 
    {$IFDEF DEBUG} // 测试时让主角不死身 
    FTank.MaxBulletNum := 100; 
    FTank.HP := 100; 
    {$ENDIF} 
 
    // 按目前选项设定坦克状态 
    FTank.SuperMode := mnuSuperMode.Checked; // 无敌模式 
    if mnuUnlimitedBullet.Checked then // 能够连发子弹 
      FTank.MaxBulletNum := 100 
    else 
      FTank.MaxBulletNum := 1; 
 
    // 将现存的子弹, 敌方坦克及宝物释放掉 
    FreeBullets; 
    FreeTanks; 
    if Assigned(Gem) then Gem.Free; 
 
    // 不要暂停敌人 
    bStopEnemy := False; 
 
    // 将所有计时器取消 
    KillTimer(Handle, TIMER_ID_GEM); 
    KillTimer(Handle, TIMER_ID_GEM_HAT); 
    KillTimer(Handle, TIMER_ID_GEM_HAT); 
    KillTimer(Handle, TIMER_ID_GEM_ARROW); 
  end; 
 
var 
  Msg      : TMsg; 
  iStopTime: Integer; 
begin 
  InitLevel; // 初始化 
 
  // 游戏回圈 
  while (FGameStatus = gsPlaying) do 
  begin 
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then // 取得讯息 
    begin 
      case Msg.message of 
        WM_QUIT: // 程式结束, 离开游戏回圈 
        begin 
          FGameStatus := gsTerminate; 
          Break; 
        end; 
 
        WM_DESTROY_OBJECT: // 要求释放某物件 
        begin 
          if TObject(Msg.WPARAM) = FTank then // 若死掉的是主角 
          begin 
            FTank.Visible := False; 
            FGameStatus := gsOver; // Game over 啰 ~~ 
            Break; // 离开游戏回圈 
          end; 
 
          // 若被摧毁的是敌方坦克, 则 Msg.LPARAM 代表其分数 
          Inc(FScore, Msg.LPARAM); 
 
          // 将坦克与与其有关系的子弹解除关系 
          FreeBulletsForTank(TTank(Msg.WPARAM)); 
 
          // 释放物件 
          TObject(Msg.WPARAM).Free; 
 
          // 若敌方坦克全部出现且死光光了, 则到下一关去 
          if (FETankUsed = MAX_ETANK_PER_SCENARIO) and (Length(Tanks) = 1) then 
          begin 
            // 这里应该加一些过场画面... 
            LevelNo := LevelNo + 1; 
            InitLevel; 
          end; 
        end; 
 
        WM_GAMEOVER: // 军旗被打掉了, 游戏结束 
        begin 
          FGameStatus := gsOver; 
          Break; 
        end; 
 
        WM_SPECIAL_CONDITION: // 进入特殊状态 
        begin 
          iStopTime := 10; // 特殊状态预设有效时间十秒钟 
 
          case Msg.WPARAM of 
            TIMER_ID_GEM_CLOCK: bStopEnemy := True;// 暂停敌人行动 
 
            TIMER_ID_GEM_HAT: FTank.SuperMode := True; // 无敌 
 
            TIMER_ID_GEM_ARROW: 
            begin   // 在军旗周围摆上打不破的铁墙, 且修复它 
              Map[LAYER_TERRITEM, 5, 11].TileNo := 3; 
              Map[LAYER_TERRITEM, 5, 11].DisposeBreakMap; 
              Map[LAYER_TERRITEM, 6, 11].TileNo := 3; 
              Map[LAYER_TERRITEM, 6, 11].DisposeBreakMap; 
              Map[LAYER_TERRITEM, 7, 11].TileNo := 3; 
              Map[LAYER_TERRITEM, 7, 11].DisposeBreakMap; 
              Map[LAYER_TERRITEM, 5, 12].TileNo := 3; 
              Map[LAYER_TERRITEM, 5, 12].DisposeBreakMap; 
              Map[LAYER_TERRITEM, 7, 12].TileNo := 3; 
              Map[LAYER_TERRITEM, 7, 12].DisposeBreakMap; 
 
              iStopTime := 20; // 铁墙持续二十秒 
            end; 
          end; 
          // 设定计时器 
          SetTimer(Handle, Msg.WPARAM, iStopTime * 1000, nil); 
        end; 
 
        WM_TIMER: // 计时器时间到 (特殊状态时间到) 
        begin 
          KillTimer(Handle, Msg.WPARAM); // 取消计时器 
 
          case Msg.WPARAM of 
            TIMER_ID_GEM: // 宝物摆够久了, 还不吃, 拿掉 
              if Assigned(Gem) then Gem.Free; 
 
            TIMER_ID_GEM_CLOCK: bStopEnemy := False; 
 
            TIMER_ID_GEM_HAT: 
              FTank.SuperMode := mnuSuperMode.Checked; 
 
            TIMER_ID_GEM_ARROW: // 在军旗周围摆回砖墙 
            begin 
              Map[LAYER_TERRITEM, 5, 11].TileNo := 2; 
              Map[LAYER_TERRITEM, 6, 11].TileNo := 2; 
              Map[LAYER_TERRITEM, 7, 11].TileNo := 2; 
              Map[LAYER_TERRITEM, 5, 12].TileNo := 2; 
              Map[LAYER_TERRITEM, 7, 12].TileNo := 2; 
            end; 
          end; 
        end; 
 
        WM_INIT_LEVEL: 
        begin 
          InitLevel; // 关卡重新开始 
        end; 
      end; 
 
      // 正常的讯息处理程序 
      TranslateMessage(Msg); 
      DispatchMessage(Msg); 
    end else if Focused then // 若视窗拥有输入焦点才动作 
    begin        
      // 若此关卡及目前敌方坦克都没达到上限, 
      // 则按照乱数"可能"出现敌方坦克 
      if (FETankUsed < MAX_ETANK_PER_SCENARIO) and 
        (Length(Tanks) < MAX_TANK_ON_SCREEN) and 
        (Random < PROBAB_ETANK_BORN) then 
        CreateETank(Random(5)); // 五种坦克任选一种 
 
      // 若目前没有宝物, 则按照乱数"可能"出现宝物 
      if not Assigned(Gem) and (Random < PROBAB_GEM_BORN) then 
        CreateGem(Random(6)); // 六种宝物任选一种 
 
      // 移动我方坦克及／或敌方坦克 
      if bStopEnemy then 
        FTank.Move 
      else 
        MoveTanks; 
 
      // 移动子弹 
      MoveBullets; 
 
      // 更新画面 
      UpdateView; 
    end else begin 
      // 若视窗没有取得输入焦点, 则将控制权交给其它执行绪, 
      // 直到有讯息进来 
      WaitMessage; 
    end; 
  end; 
end; 
 
procedure TMainForm.FormDestroy(Sender: TObject); 
begin 
  // 释放所有资源 
  FBackBitmap.Free; 
  FTank.Free; 
  Tiles.Free; 
  Map.Free; 
end; 
 
procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word; 
    Shift: TShiftState); 
begin 
  // 注意, 只有游戏中状态, 键盘控制才有效 
  if FGameStatus = gsPlaying then 
  begin 
    case Key of // 放开键盘, 我方坦克就停止动作 
      VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT: FTank.Active := False; 
    end; 
  end; 
end; 
 
procedure TMainForm.mnuSuperModeClick(Sender: TObject); 
begin 
  with (Sender as TMenuItem) do 
  begin 
    Checked := not Checked; 
 
    case Tag of 
      0: FTank.SuperMode := Checked; // 无敌模式 
 
      1: if Checked then // 能够连发子弹 
        FTank.MaxBulletNum := 100 
      else 
        FTank.MaxBulletNum := 1; 
    end; 
  end; 
end; 
 
procedure TMainForm.mnuDrawLayerClick(Sender: TObject); 
begin 
  (Sender as TMenuItem).Checked := not (Sender as TMenuItem).Checked; 
end; 
 
initialization 
  Randomize; // 重播乱数种子 
 
end.