www.pudn.com > Tank拊親蚔牁測鎢.rar > MAIN.PAS

unit main; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls, ExtCtrls, Grids, Menus, Math, Sprite, ComCtrls; 
 
type 
  TMainForm = class(TForm) 
    pnlView: TPanel; 
    pbxView: TPaintBox; 
    mnuMain: TMainMenu; 
    F1: TMenuItem; 
    mnuChooseLevel: TMenuItem; 
    N1: TMenuItem; 
    mnuExit: TMenuItem; 
    H1: TMenuItem; 
    mnuAbout: TMenuItem; 
    E1: TMenuItem; 
    mnuEditTerr: TMenuItem; 
    mnuEditItem: TMenuItem; 
    mnuEditRole: TMenuItem; 
    N2: TMenuItem; 
    mnuShowGrid: TMenuItem; 
    mnuShowSpeicalArea: TMenuItem; 
    mnuResetMap: TMenuItem; 
    V1: TMenuItem; 
    stbMain: TStatusBar; 
    N4: TMenuItem; 
    mnuRemoveItem: TMenuItem; 
    mnuSave: TMenuItem; 
    N3: TMenuItem; 
    mnuRestoreLevel: TMenuItem; 
    mnuEditTerrItem: TMenuItem; 
    mnuEditHiTerrItem: TMenuItem; 
    Splitter1: TSplitter; 
    pnlRight: TPanel; 
    Splitter2: TSplitter; 
    grdTile: TDrawGrid; 
    tvwTiles: TTreeView; 
    mnuResetAllMap: TMenuItem; 
    mnuDrawEditLayerOnly: TMenuItem; 
    procedure FormCreate(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure pbxViewPaint(Sender: TObject); 
    procedure mnuEditRoleClick(Sender: TObject); 
    procedure mnuExitClick(Sender: TObject); 
    procedure pbxViewMouseMove(Sender: TObject; Shift: TShiftState; X, 
      Y: Integer); 
    procedure mnuShowSomething(Sender: TObject); 
    procedure mnuResetMapClick(Sender: TObject); 
    procedure mnuRemoveItemClick(Sender: TObject); 
    procedure mnuChooseLevelClick(Sender: TObject); 
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
    procedure mnuSaveClick(Sender: TObject); 
    procedure mnuAboutClick(Sender: TObject); 
    procedure pbxViewMouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure pbxViewMouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure mnuRestoreLevelClick(Sender: TObject); 
    procedure grdTileDrawCell(Sender: TObject; ACol, ARow: Integer; 
      Rect: TRect; State: TGridDrawState); 
    procedure tvwTilesChange(Sender: TObject; Node: TTreeNode); 
  private 
    FEditLayer: Integer; // 目前編輯模式 
    FLevelNo: Integer; // 目前編輯的關卡 
    FModified: Boolean; // 載入關卡後是否更動過 
     
    FTank: TMyTank; // 角色物件 
    FBackBitmap: TBitmap; // double-buffering 用的背景 bitmap 
     
    FCursorX, FCursorY: Integer; // 滑鼠游標位置 
    FButtonPressed: TMouseButton; // 滑鼠按鍵狀態 
     
    function GetCursorW: Integer; 
    function GetCursorH: Integer; 
     
    procedure DrawBackBitmap; // 繪製背景 bitmap 
    procedure UpdateView; // 更新編輯畫面 
    procedure UpdateControlStatus; 
 
    procedure SetLevelNo(Value: Integer); 
     
    procedure MySaveFile; // 儲存地圖檔案 
    function AskSaveMap: Boolean; // 確認是否儲存地圖 
    function ValidateMap: Boolean; // 檢查地圖是否合法 
     
    property LevelNo: Integer read FLevelNo write SetLevelNo; 
  public 
    { Public declarations } 
  end; 
   
var 
  MainForm: TMainForm; 
   
implementation 
 
uses util, tileunit, Mapunit, about, xFiles, xUtils; 
 
{$R *.DFM} 
 
procedure TMainForm.FormCreate(Sender: TObject); 
begin 
  FEditLayer := 0; // 預設為地形編輯模式 
  FButtonPressed := mbMiddle; // 表示目前滑鼠鍵沒有按著 
 
  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; 
 
  // 讀入圖庫描述資料 
  ReadComponentResFile(ChangeFileExt(AppDir + FN_TILE_ARCHIVE, '.TVW'), tvwTiles); 
  tvwTiles.Selected := tvwTiles.Items.GetFirstNode; 
 
  // According tile num and size, adjust dimension of pnlView 
  pnlView.ClientWidth := WORLD_WIDTH; 
  pnlView.ClientHeight := WORLD_HEIGHT; 
 
  ClientHeight := pnlView.Height + stbMain.Height; 
 
  FBackBitmap := TBitmap.Create; // 緩衝用 bitmap 
  FBackBitmap.Width := TILE_WIDTH * TILE_NUM_X; 
  FBackBitmap.Height := TILE_HEIGHT * TILE_NUM_Y; 
 
  LevelNo := 1; 
  UpdateControlStatus; 
 
  // 滑鼠游標位置 
  FCursorX := -1; 
  FCursorY := -1; 
end; 
 
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
  FBackBitmap.Free; 
  FTank.Free; 
  Tiles.Free; 
  Map.Free; 
end; 
 
procedure TMainForm.UpdateView; 
begin 
  DrawBackBitmap; 
  pbxView.Canvas.Draw(0, 0, FBackBitmap); 
end; 
 
procedure TMainForm.pbxViewPaint(Sender: TObject); 
begin 
  UpdateView; 
end; 
 
procedure TMainForm.DrawBackBitmap; 
var 
  X, Y: Integer; 
begin 
  if (FEditLayer = LAYER_TERR) or not mnuDrawEditLayerOnly.Checked then Map.DrawMap(LAYER_TERR, FBackBitmap.Canvas) // 繪製地形層 
  else begin // 若沒畫地形層, 就塗黑 
    FBackBitmap.Canvas.Brush.Color := clBlack; 
    FBackBitmap.Canvas.FillRect(FBackBitmap.Canvas.ClipRect); 
  end; 
  if (FEditLayer = LAYER_TERRITEM) or not mnuDrawEditLayerOnly.Checked then Map.DrawMap(LAYER_TERRITEM, FBackBitmap.Canvas); // 繪製地形物層 
  if (FEditLayer = LAYER_ITEM) or not mnuDrawEditLayerOnly.Checked then Map.DrawMap(LAYER_ITEM, FBackBitmap.Canvas); // 繪製物品層 
 
  // 如果使用者想看格線, 就將格線畫出來 
  if mnuShowGrid.Checked then 
    with FBackBitmap.Canvas do 
    begin 
      Pen.Color := clBlack; 
      Pen.Style := psSolid; 
      Pen.Width := 1; 
 
      // 先畫橫線 
      for Y := 0 to TILE_NUM_Y - 1 do 
      begin 
        MoveTo(0, Y * TILE_HEIGHT); 
        LineTo(TILE_NUM_X * TILE_WIDTH, Y * TILE_HEIGHT); 
      end; 
 
      // 再畫直線 
      for X := 0 to TILE_NUM_X - 1 do 
      begin 
        MoveTo(X * TILE_WIDTH, 0); 
        LineTo(X * TILE_WIDTH, TILE_NUM_Y * TILE_HEIGHT); 
      end; 
    end; 
 
  // 使用者想看不可行走區域 
  if mnuShowSpeicalArea.Checked then 
    with FBackBitmap.Canvas do 
    begin 
      Pen.Color := clRed; 
      Pen.Width := 1; 
      Pen.Style := psDash; 
      Brush.Style := bsClear; 
 
      for Y := 0 to TILE_NUM_Y - 1 do // 逐一檢查 
        for X := 0 to TILE_NUM_X - 1 do 
          if not Map[LAYER_TERRITEM, X, Y].CanPass then 
          begin // 外框加上右上畫到左下的紅色虛線 
            Rectangle(X * TILE_WIDTH, Y * TILE_HEIGHT, (X + 1) * TILE_WIDTH - 1, (Y + 1) * TILE_HEIGHT - 1); 
            MoveTo((X + 1) * TILE_WIDTH, Y * TILE_HEIGHT); 
            LineTo(X * TILE_WIDTH, (Y + 1) * TILE_HEIGHT); 
          end; 
    end; 
 
  FTank.Draw(FBackBitmap.Canvas); // 畫出角色圖案 
  if (FEditLayer = LAYER_HITERRITEM) or not mnuDrawEditLayerOnly.Checked then Map.DrawMap(LAYER_HITERRITEM, FBackBitmap.Canvas); // 繪製高地形物層 
end; 
 
procedure TMainForm.UpdateControlStatus; 
const 
  LayerDesc: array[0..4] of string = ('地形', '地形物', '物品', '高地形物', '主角'); 
begin 
  Caption := Format('%s - 任務 %d (編輯狀態: %s)',[Application.Title, FLevelNo, LayerDesc[FEditLayer]]); 
 
  grdTile.Invalidate; 
end; 
 
procedure TMainForm.SetLevelNo(Value: Integer); 
begin 
  try 
    // 讀取地圖檔及角色位置 
    Map.LevelNo := Value; 
  except 
    // 若讀取地圖檔失敗, 清除整張地圖 
    Map.ResetAllMap; 
 
    // 擺上磚牆 
    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; 
 
    // 擺上旗子 
    Map[LAYER_TERRITEM, 6, 12].TileNo := 5; 
  end; 
  FTank.X := Map.Role_X; // 將角色位置由 Map 物件中抄出來 
  FTank.Y := Map.Role_Y; 
 
  FLevelNo := Value; 
  FModified := False; // 地圖尚未更動（當然:p） 
  UpdateControlStatus; 
  UpdateView; // 別忘了更新遊戲畫面 
end; 
 
procedure TMainForm.mnuEditRoleClick(Sender: TObject); 
var 
  bEnable: Boolean; 
begin 
  (Sender as TMenuItem).Checked := True; 
  FEditLayer := (Sender as TMenuItem).Tag; // 設定選取的編輯模式 
 
  UpdateControlStatus; 
  UpdateView; 
end; 
 
procedure TMainForm.mnuExitClick(Sender: TObject); 
begin 
  Close; 
end; 
 
procedure TMainForm.pbxViewMouseMove(Sender: TObject; Shift: TShiftState; 
    X, Y: Integer); 
begin 
  // 已經跑出範圍外了... 
  if (X < 0) or (X >= TILE_WIDTH * TILE_NUM_X) or (Y < 0) or 
    (Y >= TILE_HEIGHT * TILE_NUM_Y) then Exit; 
 
  FCursorX := X div TILE_WIDTH; // 換算座標, 以圖格為單位 
  FCursorY := Y div TILE_HEIGHT; 
 
  pbxViewMouseDown(Sender, FButtonPressed, Shift, X, Y); // 可以拉曳置放物品的效果 
 
  UpdateView; // 重繪遊戲畫面 
 
  // 畫出目前所選取的區域外框 
  with pbxView.Canvas do 
  begin 
    Pen.Width := 2; 
    Pen.Color := clBlue; 
    Brush.Style := bsClear; 
    Rectangle(FCursorX * TILE_WIDTH, FCursorY * TILE_HEIGHT, 
      (FCursorX + GetCursorW) * TILE_WIDTH, (FCursorY + GetCursorH) * TILE_HEIGHT); 
  end; 
 
  stbMain.SimpleText := Format('位置: (%d, %d) 大小: (%d, %d)',[FCursorX, FCursorY, GetCursorW, GetCursorH]); 
end; 
 
procedure TMainForm.mnuShowSomething(Sender: TObject); 
begin 
  (Sender as TMenuItem).Checked := not (Sender as TMenuItem).Checked; 
  UpdateView; 
end; 
 
procedure TMainForm.mnuResetMapClick(Sender: TObject); 
begin 
  case (Sender as TComponent).Tag of 
    0: if FEditLayer <= LAYER_MAX then Map.ResetMap(FEditLayer); 
    1: Map.ResetAllMap; 
  end; 
  UpdateView; 
end; 
 
procedure TMainForm.mnuRemoveItemClick(Sender: TObject); 
begin 
  if (FCursorX = -1) or (FCursorY = -1) then Exit; 
 
  if FEditLayer <= LAYER_MAX then 
    Map[FEditLayer, FCursorX, FCursorY].TileNo := 0; 
  UpdateView; 
end; 
 
procedure TMainForm.mnuChooseLevelClick(Sender: TObject); 
var 
  S: string; 
begin 
  if not AskSaveMap then Exit; 
 
  S := IntToStr(FLevelNo); 
  if InputQuery(Application.Title, 'Input Level No:', S) then 
    LevelNo := StrToInt(S); 
end; 
 
function TMainForm.AskSaveMap: Boolean; 
begin 
  Result := True; 
  if not FModified then Exit; 
 
  // 確認是否儲存目前編輯的地圖檔案 
  case YesNoCancelBox(Format('Do you want to save this map (level %d) ?',[FLevelNo])) of 
    mrYes: MySaveFile; 
 
    mrNo:; 
 
    mrCancel: Result := False; 
  end; 
end; 
 
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
begin 
  if not AskSaveMap then CanClose := False; 
end; 
 
procedure TMainForm.MySaveFile; 
begin 
  if not FModified then Exit; 
  if not ValidateMap then Exit; 
 
  Map.Role_X := FTank.X; 
  Map.Role_Y := FTank.Y; 
  Map.SaveToFile; 
  FModified := False; 
end; 
 
procedure TMainForm.mnuSaveClick(Sender: TObject); 
begin 
  MySaveFile; 
end; 
 
// 檢查地圖是否合法 
function TMainForm.ValidateMap: Boolean; 
var 
  X, Y     : Integer; 
  FlagCount: Integer; 
begin 
  Result := False; 
 
  for Y := 0 to TILE_NUM_Y - 1 do 
    for X := 0 to TILE_NUM_X - 1 do 
    begin 
      // 看看有幾支旗子 
      if taFlag in Tiles[Map[LAYER_TERRITEM, X, Y].TileNo].Attr then Inc(FlagCount); 
    end; 
 
  if FlagCount = 0 then 
  begin 
    ShowMessage('沒有放軍旗, 不行'); 
    Exit; 
  end; 
 
  Result := True; 
end; 
 
procedure TMainForm.mnuAboutClick(Sender: TObject); 
begin 
  with TAboutBox.Create(self) do 
    try 
      ShowModal; 
    finally 
      Free; 
    end; 
end; 
 
procedure TMainForm.pbxViewMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
var 
  No    : Integer; 
  MX, MY: Integer; 
begin 
  // 記錄按下的滑鼠鍵, 配合 OnMouseMove 事件處理方法 
  // 產生拉曳設定效果 
  FButtonPressed := Button; 
 
  if Button = mbMiddle then Exit; // 滑鼠中鍵不做任何事 
 
  if Button = mbLeft then // 左鍵是設定 
  begin 
    if tvwTiles.Selected = nil then Exit; // 沒有選定任何群組 
 
    No := Integer(tvwTiles.Selected.Data); // 圖片群組的頭頭編號 
 
    // 左上角, 正上方及右上角三處是敵方坦克的出生點, 不能放東西 
    if (FEditLayer <> LAYER_TERR) and (FCursorY = 0) and 
      ((FCursorX = 0) or (FCursorX = TILE_NUM_X div 2 + 1) or 
      (FCursorX = TILE_NUM_X - 1)) then Exit; 
 
    if FEditLayer <= LAYER_MAX then 
    begin 
      for MY := 0 to GetCursorH - 1 do // 將新地形擺上 
        for MX := 0 to GetCursorW - 1 do 
          Map[FEditLayer, FCursorX + MX, FCursorY + MY].TileNo := 
          No + Tiles[No].xNum * (MY + grdTile.Selection.Top) + 
          (MX + grdTile.Selection.Left); 
    end else 
    begin 
      // 角色不可以擺在不可走動的地形上 
      if not Map[LAYER_TERRITEM, FCursorX, FCursorY].CanPass then 
        Exit; 
 
      FTank.X := FCursorX * TILE_WIDTH; // 設定主角初始位置 
      FTank.Y := FCursorY * TILE_HEIGHT; 
    end; 
  end else // 右鍵是清除 
  begin 
    if FEditLayer > LAYER_MAX then Exit; // 角色不用清除 
 
    for MY := 0 to GetCursorH - 1 do 
      for MX := 0 to GetCursorW - 1 do // 清除此地形 
        Map[FEditLayer, FCursorX + MX, FCursorY + MY].TileNo := 0; 
  end; 
 
  FModified := True; // 此地圖已更改 
  UpdateView; // 更新地圖畫面 
end; 
 
procedure TMainForm.pbxViewMouseUp(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
begin 
  FButtonPressed := mbMiddle; // 設定為 mbMiddle 表示使用者已放開滑鼠鍵 
end; 
 
procedure TMainForm.mnuRestoreLevelClick(Sender: TObject); 
begin 
  LevelNo := LevelNo; 
end; 
 
procedure TMainForm.grdTileDrawCell(Sender: TObject; ACol, ARow: Integer; 
    Rect: TRect; State: TGridDrawState); 
var 
  No  : Integer; 
  X, Y: Integer; 
begin 
  if FEditLayer > LAYER_MAX then Exit; 
  if tvwTiles.Selected = nil then Exit; 
 
  No := Integer(tvwTiles.Selected.Data); 
  if (ARow * grdTile.ColCount + ACol >= Tiles[No].xNum * Tiles[No].yNum) then Exit; 
 
  Inc(No, ARow * grdTile.ColCount + ACol); 
  if No >= Tiles.TileNum then Exit; 
 
  with grdTile.Canvas do // 將對應的圖形畫出來 
    Draw(Rect.Left, Rect.Top, Tiles[No].Bitmap); 
end; 
 
procedure TMainForm.tvwTilesChange(Sender: TObject; Node: TTreeNode); 
var 
  No: Integer; 
begin 
  if tvwTiles.Selected = nil then Exit; 
 
  No := Integer(tvwTiles.Selected.Data); // 取得目前圖格群組編號 
 
  with grdTile, grdTile.Selection do 
  begin 
    RowCount := Tiles[No].yNum; // 設定 grid 大小, 顯示整個圖格群組 
    ColCount := Tiles[No].xNum; 
 
    Left := 0; 
    Top := 0; 
    Right := Tiles[No].xNum - 1; 
    Bottom := Tiles[No].yNum - 1; 
  end; 
 
  grdTile.Invalidate; 
end; 
 
// 取得選擇區域的寬及高 
function TMainForm.GetCursorW: Integer; 
begin 
  with grdTile.Selection do 
    Result := Right - Left + 1; 
end; 
 
function TMainForm.GetCursorH: Integer; 
begin 
  with grdTile.Selection do 
    Result := Bottom - Top + 1; 
end; 
 
end.