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

unit main; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  Menus, StdCtrls, ExtCtrls, Spin, Grids, ExtDlgs, Math, TileUnit, ComCtrls; 
 
type 
  TMainForm = class(TForm) 
    mnuMain: TMainMenu; 
    F1: TMenuItem; 
    H1: TMenuItem; 
    mnuAbout: TMenuItem; 
    mnuExit: TMenuItem; 
    N1: TMenuItem; 
    mnuOpen: TMenuItem; 
    mnuSave: TMenuItem; 
    mnuNew: TMenuItem; 
    dlgOpen: TOpenDialog; 
    dlgSave: TSaveDialog; 
    mnuSaveAs: TMenuItem; 
    N3: TMenuItem; 
    dlgOpenPicture: TOpenPictureDialog; 
    tvwTiles: TTreeView; 
    stbMain: TStatusBar; 
    pnlRight: TPanel; 
    Splitter1: TSplitter; 
    grdTile: TDrawGrid; 
    lblTileNo: TLabel; 
    lblDimension: TLabel; 
    GroupBox1: TGroupBox; 
    cbxCanPass: TCheckBox; 
    cbxBulletCanPass: TCheckBox; 
    cbxCanBreak: TCheckBox; 
    mnuTiles: TMenuItem; 
    mnuAdd: TMenuItem; 
    mnuRemove: TMenuItem; 
    cbxFlag: TCheckBox; 
    procedure mnuExitClick(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure mnuNewClick(Sender: TObject); 
    procedure mnuOpenClick(Sender: TObject); 
    procedure mnuSaveClick(Sender: TObject); 
    procedure grdTileDrawCell(Sender: TObject; ACol, ARow: Integer; 
      Rect: TRect; State: TGridDrawState); 
    procedure mnuAboutClick(Sender: TObject); 
    procedure grdTileSelectCell(Sender: TObject; ACol, ARow: Integer; 
      var CanSelect: Boolean); 
    procedure tvwTilesChange(Sender: TObject; Node: TTreeNode); 
    procedure mnuAddClick(Sender: TObject); 
    procedure mnuRemoveClick(Sender: TObject); 
  private 
    FFileName: string; 
    FFirstNo: Integer; 
     
    procedure BackupAttr(Col, Row: Integer); 
    procedure RestoreAttr(Col, Row: Integer); 
     
    procedure UpdateControlStatus; 
  public 
    { Public declarations } 
  end; 
   
var 
  MainForm: TMainForm; 
   
implementation 
 
uses util, about, xFiles; 
 
{$R *.DFM} 
 
procedure TMainForm.mnuExitClick(Sender: TObject); 
begin 
  Close; 
end; 
 
procedure TMainForm.FormCreate(Sender: TObject); 
begin 
  Tiles := TTiles.Create; // 建立圖庫物件 
 
  mnuNewClick(nil); 
end; 
 
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
  Tiles.Free; 
end; 
 
procedure TMainForm.mnuNewClick(Sender: TObject); 
begin 
  Tiles.FreeTiles; // 新的圖庫 
  FFileName := ''; 
  FFirstNo := -1; 
  tvwTiles.Items.Clear; 
 
  UpdateControlStatus; 
end; 
 
procedure TMainForm.mnuOpenClick(Sender: TObject); 
begin 
  with dlgOpen do 
    if Execute then // 開啟舊檔對話盒 
      try 
        mnuNewClick(nil); // 先釋放圖庫內容 
 
        // 載入圖庫 
        Tiles.LoadFromFile(Filename); 
        // 讀取圖片群組描述 
        ReadComponentResFile(ChangeFileExt(Filename, '.TVW'), 
          tvwTiles); 
 
        FFileName := Filename; // 讀取地形圖庫成功 
 
       // 若末選擇任何群組, 則幫他選擇第一個節點         
        if tvwTiles.Selected = nil then 
          tvwTiles.Selected := tvwTiles.Items[0]; 
      finally 
        UpdateControlStatus; 
      end; 
end; 
 
procedure TMainForm.mnuSaveClick(Sender: TObject); 
begin 
  // 若是"另存新檔" 或還未指定檔名, 就先問使用者檔名 
  if ((Sender as TComponent).Tag = 1) or (FFileName = '') then 
  begin 
    dlgSave.Filter := dlgOpen.Filter; 
    // 詢問使用者檔名, 若按取消就離開 
    if not dlgSave.Execute then Exit; 
    FFileName := dlgSave.Filename; // 將檔名記起來 
  end; 
 
  BackupAttr(grdTile.Col, grdTile.Row); // 儲存目前圖片屬性 
 
  Tiles.SaveToFile(FFileName); // 儲存圖庫 
  // 儲存圖片群組描述 
  WriteComponentResFile(ChangeFileExt(FFileName, '.TVW'), 
    tvwTiles); 
  UpdateControlStatus; // 更新視窗標題 
end; 
 
procedure TMainForm.UpdateControlStatus; 
var 
  sFileName: string; 
begin 
  sFileName := FFileName; 
  if sFileName = '' then sFileName := 'Untitled'; 
  Caption := Format('%s - %s',[Application.Title, sFileName]); 
   
  stbMain.SimpleText := Format('圖片總數: %d',[Tiles.TileNum]); 
   
  mnuSave.Enabled := Tiles.TileNum <> 0; 
  mnuSaveAs.Enabled := Tiles.TileNum <> 0; 
   
  grdTile.Invalidate; 
end; 
 
procedure TMainForm.grdTileDrawCell(Sender: TObject; ACol, 
    ARow: Integer; Rect: TRect; State: TGridDrawState); 
var 
  No: Integer; // 對應的圖片編號 
begin 
  if tvwTiles.Selected = nil then Exit; // 一定要選擇某群組才行 
 
  // 此格所對應的圖片編號 = 首張圖片編號 + ARow * 橫軸數目 + ACol 
  No := Integer(tvwTiles.Selected.Data) + 
    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.grdTileSelectCell(Sender: TObject; ACol, 
    ARow: Integer; var CanSelect: Boolean); 
begin 
  BackupAttr(grdTile.Col, grdTile.Row); 
  RestoreAttr(ACol, ARow); 
 
  lblTileNo.Caption := Format('編號: %d (%d - %d)',[FFirstNo, FFirstNo, FFirstNo + Tiles[FFirstNo].xNum * Tiles[FFirstNo].yNum - 1]); 
end; 
 
procedure TMainForm.BackupAttr(Col, Row: Integer); 
var 
  No: Integer; 
begin 
  if FFirstNo = -1 then Exit; 
 
  No := FFirstNo + Row * grdTile.ColCount + Col; // 計算原本選擇的圖片編號 
 
  // 將使用者設定的圖片屬性寫回去 
  Tiles[No].Attr := []; 
 
  // 可以穿越的地形 
  if cbxCanPass.Checked then Tiles[No].Attr := Tiles[No].Attr + [taCanpass]; 
  if cbxBulletCanPass.Checked then Tiles[No].Attr := Tiles[No].Attr + [taBulletCanpass]; 
  if cbxCanBreak.Checked then Tiles[No].Attr := Tiles[No].Attr + [taCanBreak]; 
  if cbxFlag.Checked then Tiles[No].Attr := Tiles[No].Attr + [taFlag]; 
end; 
 
procedure TMainForm.RestoreAttr(Col, Row: Integer); 
var 
  No: Integer; 
begin 
  if FFirstNo = -1 then Exit; 
 
  No := FFirstNo + Row * grdTile.ColCount + Col; // 計算即將選擇的圖片編號 
 
  // 將所選擇的圖片屬性由 checkbox 元件表現出來 
  cbxCanPass.Checked := taCanpass in Tiles[No].Attr; 
  cbxBulletCanPass.Checked := taBulletCanpass in Tiles[No].Attr; 
  cbxCanBreak.Checked := taCanBreak in Tiles[No].Attr; 
  cbxFlag.Checked := taFlag in Tiles[No].Attr; 
end; 
 
procedure TMainForm.mnuAboutClick(Sender: TObject); 
begin 
  with TAboutBox.Create(self) do 
    try 
      ShowModal; 
    finally 
      Free; 
    end; 
end; 
 
procedure TMainForm.tvwTilesChange(Sender: TObject; Node: TTreeNode); 
var 
  No: Integer; 
begin 
  if tvwTiles.Selected = nil then Exit; 
 
  // 儲回目前值 
  BackupAttr(grdTile.Col, grdTile.Row); 
 
  No := Integer(tvwTiles.Selected.Data); 
  if No < Tiles.TileNum then 
  begin 
    grdTile.ColCount := Tiles[No].xNum; 
    grdTile.RowCount := Tiles[No].yNum; 
 
    grdTile.Row := 0; 
    grdTile.Col := 0; 
 
    FFirstNo := No; 
    lblDimension.Caption := Format('大小: %d x %d',[Tiles[FFirstNo].xNum, Tiles[FFirstNo].yNum]); 
 
    RestoreAttr(0, 0); 
  end; 
 
  UpdateControlStatus; 
end; 
 
procedure TMainForm.mnuAddClick(Sender: TObject); 
 
  procedure AddTreeNode(const Filename: string; FirstNo: Integer); 
  begin 
    // 在樹狀檢視元件中加入此圖片群組的節點（描述） 
    // 圖片群組描述預設值為加入的 BMP 圖形檔檔名 
    with tvwTiles.Items.Add(nil, 
      ExtractFileNameNoExt(ExtractFileName(Filename))) do 
    begin 
      Data := Pointer(FirstNo);  // 記錄此群組對應的第一張圖片編號 
    end; 
 
    // 若末選擇任何群組, 則幫他選擇第一個節點 
    if tvwTiles.Selected = nil then 
      tvwTiles.Selected := tvwTiles.Items[0]; 
  end; 
 
var 
  Bits         : TBitmap; // 欲加入的 bitmap 
  X, Y, FirstNo: Integer; 
  xNum, yNum   : Integer; // 圖形切割後的橫軸及縱軸圖片數目 
  Tile         : TTile;   // 產生的新圖片 
begin 
  if dlgOpenPicture.Execute then 
    try 
      Bits := TBitmap.Create; // 產生及載入欲加入圖庫的 bitmap 
      Bits.LoadFromFile(dlgOpenPicture.Filename); 
 
      // 若 bitmap 比單張圖片的尺寸還小, 無法處理 
      if (Bits.Width < TILE_WIDTH) or (Bits.Height < TILE_HEIGHT) then 
        raise Exception.Create('Bitmap is too small'); 
 
      // 最大是 5 x 5 的圖片群組 
      xNum := Min(5, Bits.Width div TILE_WIDTH); 
      yNum := Min(5, Bits.Height div TILE_HEIGHT); 
 
      // 依序切割出 xNum * yNum 個圖片 
      for Y := 0 to yNum - 1 do 
        for X := 0 to xNum - 1 do 
        begin 
          Tile := TTile.Create;  // 產生圖片物件 
          // 將對應的圖形複製到圖片的 bitmap 上 
          Tile.Bitmap.Canvas.CopyRect(TILE_RECT, Bits.Canvas, 
            Rect(X * TILE_WIDTH, Y * TILE_HEIGHT, 
            (X + 1) * TILE_WIDTH, (Y + 1) * TILE_HEIGHT)); 
 
          Tile.FirstTile := (X = 0) and (Y = 0); // 是不是群組頭頭 
          Tile.xNum := xNum;  // 是群組頭頭的話, 負責記錄 
          Tile.yNum := yNum;  // 圖片群組的橫軸及縱軸圖片數目 
 
          // 將產生的新圖片加入圖庫中 
          if Tile.FirstTile then 
            FirstNo := Tiles.AddTile(Tile) // 取得此群組的頭頭編號 
          else 
            Tiles.AddTile(Tile); 
        end; 
 
      // 將群組描述加入樹狀檢視元件 
      AddTreeNode(dlgOpenPicture.Filename, FirstNo); 
 
      UpdateControlStatus; 
    finally 
      Bits.Free;  // 原始影像沒有用了, 釋放掉 
    end; 
end; 
 
procedure TMainForm.mnuRemoveClick(Sender: TObject); 
var 
  I, No: Integer; 
begin 
  if tvwTiles.Selected = nil then Exit; // 一定要選定某個群組才行 
 
  // 取得目前圖片群組首張圖片編號 
  No := Integer(tvwTiles.Selected.Data); 
 
  // 將整個圖片群組的圖片都設為"棄置" 
  for I := 0 to Tiles[No].xNum * Tiles[No].yNum - 1 do 
    Tiles[No + I].Disposed := True; 
 
  tvwTiles.Selected.Delete; // 將圖片群組描述砍掉 
  UpdateControlStatus; 
end; 
 
end.