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

unit mapunit; 
 
interface 
 
uses Windows, SysUtils, Graphics, Classes, tileunit, util; 
 
type 
  // 圖格破碎表格 
  PBreakMap = ^TBreakMap; 
  TBreakMap = array[0..3, 0..3] of Boolean; // 4 x 4 = 16 個小圖格, "破"or"沒破" 
   
  // 地圖圖格 
  TCell = class 
  private 
    FTileNo: Integer; // 圖格所放置的圖片編號 
    FLayer, FX, fy: Integer; // 圖層, 座標 
     
    FBreakPtr: PBreakMap; // 圖格破碎表格 
    FRect: TRect; // 圖格所佔區域, 會隨圖格破碎而變更 
     
    function GetTileAttr: TTileAttr; 
    procedure SetTileAttr(const Value: TTileAttr); 
     
    function GetTileBitmap: TBitmap; // 取得圖片 bitmap 
     
    function GetCanPass: Boolean; // 這個圖格能否通過 ? 
  protected 
  public 
    constructor Create(Layer, X, Y: Integer); 
    destructor Destroy; override; 
     
    // 載入及儲存 
    procedure LoadFromStream(Stream: TStream); 
    procedure SaveToStream(Stream: TStream); 
     
    // 重新計算圖格所佔區域 
    procedure CalcRect; 
     
    // 圖格破碎處理方法 
    procedure AllocBreakMap; // 建立圖格破碎表格 
    procedure DisposeBreakMap; // 釋放圖格破碎表格 
    procedure SetBreakMap(X, Y: Integer); // 設定圖格破碎表格 
    procedure BreakBy(ARect: TRect); // 依矩形區域設定圖格破碎表格 
     
    property TileNo: Integer read FTileNo write FTileNo; 
    property TileAttr: TTileAttr read GetTileAttr write SetTileAttr; 
    property TileBitmap: TBitmap read GetTileBitmap; 
     
    property Rect: TRect read FRect; 
     
    property CanPass: Boolean read GetCanPass; 
  end; 
   
  // 地圖 
  TMapArray = array[0..TILE_NUM_Y - 1, 0..TILE_NUM_X - 1] of TCell; 
   
  tmap = class 
  private 
    FMaps: array[0..LAYER_MAX] of TMapArray; // (LAYER_MAX + 1) 層地圖 
     
    FLevelNo: Integer; // 目前載入的關卡編號 
     
    FRole_X, FRole_Y: Integer; // 角色的起始位置 
     
    FBreakBitmap: TBitmap; // 用於破碎圖格的貼圖動作 
     
    procedure SetLevelNo(const Value: Integer); 
    function GetCell(Layer, X, Y: Integer): TCell; 
     
    procedure SetRole_X(const Value: Integer); 
    procedure SetRole_Y(const Value: Integer); 
  protected 
  public 
    constructor Create; 
    destructor Destroy; override; 
     
    function GetFileName: string; // 根據關卡編號, 傳回對應的檔名 
     
    procedure LoadFromFile; 
    procedure SaveToFile; 
     
    // 將某地圖層畫在 Canvas 上 
    procedure DrawMap(Layer: Integer; Canvas: TCanvas); 
     
    // 重設整張地圖, 或只重設某一層 
    procedure ResetAllMap; 
    procedure ResetMap(Layer: Integer); 
     
    property LevelNo: Integer read FLevelNo write SetLevelNo; 
     
    // 取得某格的地形及物品圖片編號, 這是預設屬性 
    property Cell[Layer, X, Y: Integer]: TCell read GetCell; default; 
     
    // 取得初始的角色位置 
    property Role_X: Integer read FRole_X write SetRole_X; 
    property Role_Y: Integer read FRole_Y write SetRole_Y; 
  end; 
   
var 
  Map: tmap; 
   
implementation 
 
uses xFiles; 
 
constructor TCell.Create(Layer, X, Y: Integer); 
begin 
  inherited Create; 
   
  FLayer := Layer; 
  FX := X; 
  fy := Y; 
   
  FBreakPtr := nil; 
   
  CalcRect; // 計算所佔用區域 
end; 
 
destructor TCell.Destroy; 
begin 
  DisposeBreakMap; 
   
  inherited Destroy; 
end; 
 
// 根據座標及破碎表格計算所佔用區域 
procedure TCell.CalcRect; 
  label // goto 所使用的標籤, Ouch !! 
  OutLoop1, OutLoop2, OutLoop3, OutLoop4; 
var 
  X, Y: Integer; 
begin 
  if not Assigned(FBreakPtr) then // 若沒有破碎表格, 則佔用區域很好算 
    FRect := Classes.Rect(TILEWIDTH[FX], TILEHeight[fy], TILEWIDTH[FX + 1], TILEHeight[fy + 1]) 
  else 
  begin 
    // 但若有破碎表格, 則佔用區域要針對上下左右分別取得 
    FRect := Classes.Rect(0, 0, 0, 0); 
     
    // 最左邊 
    for X := 0 to 3 do 
      for Y := 0 to 3 do 
        if not FBreakPtr^[Y, X] then 
        begin 
          FRect.Left := TILEWIDTH[FX] + X * SM_TILE_WIDTH; 
          goto OutLoop1; 
        end; 
     
    OutLoop1: 
       
      // 最右邊 
      for X := 3 downto 0 do 
        for Y := 0 to 3 do 
          if not FBreakPtr^[Y, X] then 
          begin 
            FRect.Right := TILEWIDTH[FX] + (X + 1) * SM_TILE_WIDTH; 
            goto OutLoop2; 
          end; 
     
    OutLoop2: 
       
      // 最上邊 
      for Y := 0 to 3 do 
        for X := 0 to 3 do 
          if not FBreakPtr^[Y, X] then 
          begin 
            FRect.Top := TILEHeight[fy] + Y * SM_TILE_HEIGHT; 
            goto OutLoop3; 
          end; 
     
    OutLoop3: 
       
      // 最下邊 
      for Y := 3 downto 0 do 
        for X := 0 to 3 do 
          if not FBreakPtr^[Y, X] then 
          begin 
            FRect.Bottom := TILEHeight[fy] + (Y + 1) * SM_TILE_HEIGHT; 
            goto OutLoop4; 
          end; 
     
    OutLoop4: 
  end; 
end; 
 
// 從資料流讀取圖格 
procedure TCell.LoadFromStream(Stream: TStream); 
var 
  bHasBreakPtr: Boolean; 
begin 
  with Stream do 
  begin 
    read (FTileNo, sizeof(Integer)); 
     
    read (bHasBreakPtr, sizeof(Boolean)); 
    if bHasBreakPtr then // 若有破碎表格, 則讀取之 
    begin 
      AllocBreakMap; 
      read (FBreakPtr^, sizeof(TBreakMap)); 
    end else DisposeBreakMap; 
     
    CalcRect; // 重新計算所佔用區域 
  end; 
end; 
 
// 將圖格寫入資料流 
procedure TCell.SaveToStream(Stream: TStream); 
var 
  bHasBreakPtr: Boolean; 
begin 
  with Stream do 
  begin 
    write (FTileNo, sizeof(Integer)); 
     
    bHasBreakPtr := Assigned(FBreakPtr); 
    write (bHasBreakPtr, sizeof(Boolean)); 
    if bHasBreakPtr then // 若有破碎表格, 則寫入之 
      write (FBreakPtr^, sizeof(TBreakMap)); 
  end; 
end; 
 
function TCell.GetTileAttr: TTileAttr; 
begin 
  Result := Tiles[FTileNo].Attr; 
end; 
 
procedure TCell.SetTileAttr(const Value: TTileAttr); 
begin 
  Tiles[FTileNo].Attr := Value; 
end; 
 
// 取得置於圖格的圖片 
function TCell.GetTileBitmap: TBitmap; 
begin 
  Result := Tiles[FTileNo].Bitmap; 
end; 
 
// 建立圖格破碎表格 
procedure TCell.AllocBreakMap; 
begin 
  if not Assigned(FBreakPtr) then 
    New(FBreakPtr); 
  FillChar(FBreakPtr^, sizeof(TBreakMap), 0); 
end; 
 
// 釋放圖格破碎表格 
procedure TCell.DisposeBreakMap; 
begin 
  if Assigned(FBreakPtr) then 
  begin 
    Dispose(FBreakPtr); 
    FBreakPtr := nil; 
  end; 
end; 
 
// 設定圖格破碎表格 
procedure TCell.SetBreakMap(X, Y: Integer); 
begin 
  if not Assigned(FBreakPtr) then 
    AllocBreakMap; 
   
  FBreakPtr^[Y, X] := True; // (X, Y) 格破掉了 
   
  CalcRect; // 重新計算所佔用區域 
end; 
 
// 依矩形區域設定圖格破碎表格 
procedure TCell.BreakBy(ARect: TRect); 
var 
  X, Y : Integer; 
  R, R1: TRect;   
begin 
  if not Assigned(FBreakPtr) then // 若此時還沒有破碎表格, 就建一個 
    AllocBreakMap; 
   
  // 與 ARect 取交集, 有交集的小格則設為破掉 
  for Y := 0 to 3 do 
    for X := 0 to 3 do 
    begin 
      // 計算小格的矩形區域 
      R1 := Classes.Rect(TILEWIDTH[FX] + X * SM_TILE_WIDTH, TILEHeight[fy] + Y * SM_TILE_HEIGHT, 
        TILEWIDTH[FX] + (X + 2) * SM_TILE_WIDTH, TILEHeight[fy] + (Y + 2) * SM_TILE_HEIGHT); 
       
      // 若有交集, 則讓它破掉 
      if IntersectRect(R, ARect, R1) then 
        FBreakPtr^[Y, X] := True; 
    end; 
   
  CalcRect; // 重新計算所佔用區域 
end; 
 
// 此圖格是否能通過 
function TCell.GetCanPass: Boolean; 
begin 
  Result := (TileNo = 0) or (tacanpass in TileAttr); 
end; 
 
{ TMap class } 
 
constructor tmap.Create; 
var 
  L, X, Y: Integer; 
begin 
  inherited Create; 
   
  FLevelNo := 0; 
   
  // 建立每一層的所有圖格 
  for L := 0 to LAYER_MAX do 
    for Y := 0 to TILE_NUM_Y - 1 do 
      for X := 0 to TILE_NUM_X - 1 do 
        FMaps[L][Y, X] := TCell.Create(L, X, Y); 
   
  // 用於破碎圖格貼圖動作的 bitmap 
  FBreakBitmap := TBitmap.Create; 
  FBreakBitmap.Width := SM_TILE_WIDTH; 
  FBreakBitmap.Height := SM_TILE_HEIGHT; 
  FBreakBitmap.Transparent := True; 
  FBreakBitmap.TransparentColor := TRANSPARENT_COLOR; 
end; 
 
destructor tmap.Destroy; 
var 
  L, X, Y: Integer; 
begin 
  for L := 0 to LAYER_MAX do 
    for Y := 0 to TILE_NUM_Y - 1 do 
      for X := 0 to TILE_NUM_X - 1 do 
        FMaps[L][Y, X].Free; 
   
  FBreakBitmap.Free; 
   
  inherited Destroy; 
end; 
 
function tmap.GetFileName: string; 
begin 
  Result := Format('%s%s%d%s',[AppDir, FN_MAP_PREFIX, FLevelNo, FN_MAP_EXT]); 
end; 
 
// 從檔案讀取地圖 
procedure tmap.LoadFromFile; 
var 
  fs     : TFileStream; 
  I, X, Y: Integer;     
begin 
  fs := TFileStream.Create(GetFileName, fmOpenRead); 
  with fs do 
    try 
      CheckSignature(fs, SIG_MYFILE); // 檢查檔頭標籤 
      CheckSignature(fs, ClassName); // 檢查副檔頭標籤 
       
      // 讀取角色初始位置 
      read (FRole_X, sizeof(Integer)); 
      read (FRole_Y, sizeof(Integer)); 
       
      // 讀取每一層的所有圖格資料 
      for I := 0 to LAYER_MAX do 
        for Y := 0 to TILE_NUM_Y - 1 do 
          for X := 0 to TILE_NUM_X - 1 do 
            FMaps[I][Y, X].LoadFromStream(fs); 
    finally 
      Free; 
    end; 
end; 
 
// 將地圖寫入檔案 
procedure tmap.SaveToFile; 
var 
  fs     : TFileStream; 
  S      : string;      
  I, X, Y: Integer;     
begin 
  fs := TFileStream.Create(GetFileName, fmCreate or fmOpenWrite); 
  with fs do 
    try 
      write (SIG_MYFILE, Length(SIG_MYFILE)); 
      S := ClassName; 
      write (S[1], Length(S)); 
       
      // 寫入角色初始位置 
      write (FRole_X, sizeof(Integer)); 
      write (FRole_Y, sizeof(Integer)); 
       
      // 寫入每一層的所有圖格資料       
      for I := 0 to LAYER_MAX do 
        for Y := 0 to TILE_NUM_Y - 1 do 
          for X := 0 to TILE_NUM_X - 1 do 
            FMaps[I][Y, X].SaveToStream(fs); 
    finally 
      Free; 
    end; 
end; 
 
procedure tmap.SetLevelNo(const Value: Integer); 
begin 
  FLevelNo := Value; 
  LoadFromFile; 
end; 
 
// 將指定的地圖層畫在 Canvas 上 
procedure tmap.DrawMap(Layer: Integer; Canvas: TCanvas); 
   
  procedure DrawBrokenCell(X, Y: Integer); 
  var 
    M, N: Integer; // 繪製破碎的小圖格 
  begin 
    // 若為破碎圖格, 則一一將仍存在的小圖格貼上 
    for N := 0 to 3 do 
      for M := 0 to 3 do 
      begin 
        // 若此小圖格破掉了就不用畫 
        if FMaps[Layer][Y, X].FBreakPtr[N, M] then continue; 
 
        // 先複製到另一個 bitmap 
        FBreakBitmap.Canvas.CopyRect(Rect(0, 0, SM_TILE_WIDTH, 
          SM_TILE_HEIGHT), FMaps[Layer][Y, X].TileBitmap.Canvas, 
          Rect(M * SM_TILE_WIDTH, N * SM_TILE_HEIGHT, 
          (M + 1) * SM_TILE_WIDTH, (N + 1) * SM_TILE_HEIGHT)); 
 
        // 再貼到畫布上, 以達成透明貼圖效果 
        Canvas.Draw(TILEWIDTH[X] + M * SM_TILE_WIDTH, 
          TILEHeight[Y] + N * SM_TILE_HEIGHT, FBreakBitmap); 
      end; 
  end; 
 
var 
  X, Y: Integer; // 繪製圖格 
begin 
  if Layer = LAYER_TERR then // 若為地形層, 則直接貼圖 
    for Y := 0 to TILE_NUM_Y - 1 do // 對於每一圖格 
      for X := 0 to TILE_NUM_X - 1 do 
        BitBlt(Canvas.Handle, TILEWIDTH[X], TILEHeight[Y], 
        TILE_WIDTH, TILE_Height, FMaps[Layer][Y, X].TileBitmap.Canvas.Handle, 0, 0, SRCCOPY) 
  else 
  begin 
    // 對於其它地圖層, 則採用透明貼圖 
    for Y := 0 to TILE_NUM_Y - 1 do // 對於每一圖格 
      for X := 0 to TILE_NUM_X - 1 do 
      begin 
        // 編號為 0 表示沒放圖片 
        if FMaps[Layer][Y, X].TileNo = 0 then continue; 
 
        // 若圖格是完整的 
        if not Assigned(FMaps[Layer][Y, X].FBreakPtr) then 
          Canvas.Draw(TILEWIDTH[X], TILEHeight[Y], 
          FMaps[Layer][Y, X].TileBitmap) 
        else 
          DrawBrokenCell(X, Y); // 繪出破碎圖格 
      end; 
  end; 
end; 
 
// 重設地圖 
procedure tmap.ResetAllMap; 
var 
  I: Integer; 
begin 
  for I := 0 to LAYER_MAX do 
    ResetMap(I); 
   
  FRole_X := 0; 
  FRole_Y := 0; 
end; 
 
// 重設指定的地圖層 
procedure tmap.ResetMap(Layer: Integer); 
var 
  X, Y: Integer; 
begin 
  for Y := 0 to TILE_NUM_Y - 1 do 
    for X := 0 to TILE_NUM_X - 1 do 
      FMaps[Layer][Y, X].TileNo := 0; 
end; 
 
function tmap.GetCell(Layer, X, Y: Integer): TCell; 
begin 
  Result := FMaps[Layer][Y, X]; 
end; 
 
procedure tmap.SetRole_X(const Value: Integer); 
begin 
  FRole_X := Value; 
end; 
 
procedure tmap.SetRole_Y(const Value: Integer); 
begin 
  FRole_Y := Value; 
end; 
 
end.