526互联

通过MapEdit源程序的学习MAP文件 3, 改编程序，没有编辑功能，只显示MAP

发布时间 2023-03-31 16:45:18作者: D7mir
unit showmap;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, WIL, ComCtrls;

const
  UNITX = 48;
  UNITY = 32;
type

  TMapInfo = packed record             //这个好像不需要PACKED
    BkImg: Word;
    MidImg: Word;
    FrImg: Word;
    DoorIndex: byte;
    DoorOffset: byte;
    AniFrame: byte;
    AniTick: byte;
    Area: byte;
    Light: byte;
    end;
  

  TMapHeader = packed record          // MPA的头文件，需要PACKED，否则错误
    Width: Word;
    Height: word;
    Title: string[15];
    UpdateDate: TDateTime;
    Reserved: array[0..23] of Char;
  end;


  TForm1 = class(TForm)
    scrlbx1: TScrollBox;
    pnl1: TPanel;
    btnOpenMap: TButton;
    pb1: TPaintBox;
    dlgOpen1: TOpenDialog;
    lbl1: TLabel;
    lbl2: TLabel;
    chkTiles: TCheckBox;
    chkSmTiles: TCheckBox;
    chkObjects: TCheckBox;
    btnSaveTobmp: TButton;
    lbl3: TLabel;
    lbl4: TLabel;
    lbl5: TLabel;
    lbl6: TLabel;
    trckbr1: TTrackBar;
    lbl7: TLabel;
    pbar1: TProgressBar;
    lbl8: TLabel;
    btnRefresh: TButton;
    lbloj1: TLabel;
    lbloj2: TLabel;
    lbloj3: TLabel;
    lbloj4: TLabel;
    lbloj5: TLabel;
    lbloj6: TLabel;
    lbloj7: TLabel;
    lbloj8: TLabel;
    lbloj9: TLabel;
    lbloj10: TLabel;
    lbloj11: TLabel;
    lbloj12: TLabel;
    lbloj13: TLabel;
    lbloj14: TLabel;
    lbloj15: TLabel;
    lbloj16: TLabel;
    lbloj17: TLabel;
    lblTil: TLabel;
    lblSmT: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btnOpenMapClick(Sender: TObject);
    procedure pb1Paint(Sender: TObject);

    procedure btnSaveTobmpClick(Sender: TObject);
    procedure trckbr1Change(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }

    function LoadMapFile(flname: string): Boolean;
    procedure ShowTiles(Canvas: TCanvas; x, y: Integer);
    procedure ShowSmTiles(Canvas: TCanvas; x, y: Integer);
    procedure ShowObjects(Canvas: TCanvas; x, y: Integer);
    procedure clslbloj;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MArr : array[0..1000, 0..1000] of TMapInfo;
  MapWidth, MapHeight : Integer;
  BaseDir: string;
  Zoom: Real;
  wilTiles, wilSmTiles: TWMImages;
  wil1, wil2, wil3, wil4, wil5, wil6,wil7, wil8, wil9, wil10 : TWMImages;
  wil13, wil14, wil15: TWMImages;

implementation

{$R *.dfm}



procedure TForm1.FormCreate(Sender: TObject);
begin
  MapWidth := 1;
  MapHeight := 1;
  trckbr1Change(Sender);
  BaseDir := GetCurrentDir + '\';
  form1.Caption := BaseDir;
  clslbloj;
  if FileExists(BaseDir + 'Tiles.wil') then
  begin
    wilTiles := TWMImages.Create(Self);
    wilTiles.FileName :=BaseDir + 'Tiles.wil';
    wilTiles.Initialize;
    lblTil.Caption := 'Tiles';
    lblTil.Color := clGreen;
  end;

  if FileExists(BaseDir + 'SmTiles.wil') then
  begin
    wilSmTiles := TWMImages.Create(Self);
    wilSmTiles.FileName :=BaseDir + 'SmTiles.wil';
    wilSmTiles.Initialize;
    lblSmT.Caption := 'SmTiles';
    lblSmT.Color := clGreen;
  end;


  if FileExists(BaseDir + 'objects.wil') then
  begin
    wil1 := TWMImages.Create(Self);
    wil1.FileName :=BaseDir + 'objects.wil';
    wil1.Initialize;
    lbloj1.Color := clGreen;
  end;

 if FileExists(BaseDir + 'objects2.wil') then
  begin
    wil2 := TWMImages.Create(Self);
    wil2.FileName :=BaseDir + 'objects2.wil';
    wil2.Initialize;
    lbloj2.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects3.wil') then
  begin
    wil3 := TWMImages.Create(Self);
    wil3.FileName :=BaseDir + 'objects3.wil';
    wil3.Initialize;
    lbloj3.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects4.wil') then
  begin
    wil4 := TWMImages.Create(Self);
    wil4.FileName :=BaseDir + 'objects4.wil';
    wil4.Initialize;
    lbloj4.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects5.wil') then
  begin
    wil5 := TWMImages.Create(Self);
    wil5.FileName :=BaseDir + 'objects5.wil';
    wil5.Initialize;
    lbloj5.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects6.wil') then
  begin
    wil6 := TWMImages.Create(Self);
    wil6.FileName :=BaseDir + 'objects6.wil';
    wil6.Initialize;
    lbloj6.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects7.wil') then
  begin
    wil7 := TWMImages.Create(Self);
    wil7.FileName :=BaseDir + 'objects7.wil';
    wil7.Initialize;
    lbloj7.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects8.wil') then
  begin
    wil8 := TWMImages.Create(Self);
    wil8.FileName :=BaseDir + 'objects8.wil';
    wil8.Initialize;
    lbloj8.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects9.wil') then
  begin
    wil9 := TWMImages.Create(Self);
    wil9.FileName :=BaseDir + 'objects9.wil';
    wil9.Initialize;
    lbloj9.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects10.wil') then
  begin
    wil10 := TWMImages.Create(Self);
    wil10.FileName :=BaseDir + 'objects.wil';
    wil10.Initialize;
    lbloj10.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects13.wil') then
  begin
    wil13 := TWMImages.Create(Self);
    wil13.FileName :=BaseDir + 'objects13.wil';
    wil13.Initialize;
    lbloj13.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects14.wil') then
  begin
    wil14 := TWMImages.Create(Self);
    wil14.FileName :=BaseDir + 'objects14.wil';
    wil14.Initialize;
    lbloj14.Color := clGreen;
  end;

  if FileExists(BaseDir + 'objects15.wil') then
  begin
    wil15 := TWMImages.Create(Self);
    wil15.FileName :=BaseDir + 'objects15.wil';
    wil15.Initialize;
    lbloj15.Color := clGreen;
  end;




end;


function TForm1.LoadMapFile(flname: string): Boolean;
var
  i, fhandle: Integer;
  header: TMapHeader;

begin
  Result := False;
  if not FileExists(flname) then Exit;
  fhandle := FileOpen(flname, fmOpenRead or fmShareDenyNone);

  if fhandle > 0 then
  begin
    FillChar(MArr, SizeOf(MArr), #0);
    FileRead(fhandle, header, SizeOf(TMapHeader));

    lbl2.Caption := IntToStr(header.Width) + ' * ' + IntToStr(header.Height);
    lbl3.Caption := header.Title;
    lbl4.Caption := DateTimeToStr(header.UpdateDate);
    lbl5.Caption := header.Reserved;

    if (header.Width > 0) and (header.Height > 0) then
    begin
      MapWidth := header.Width;
      MapHeight := header.Height;
      for i := 0 to header.Width - 1 do
        FileRead(fhandle, MArr[i, 0], SizeOf(TMapInfo) * MapHeight);
      Result := True;
    end;
    FileClose(fhandle);
  end;
end;

procedure TForm1.btnOpenMapClick(Sender: TObject);

begin
  with dlgOpen1 do
  begin
    if Execute then
    begin
      if LoadMapFile(FileName) then
      begin

        lbl1.Caption := ExtractFileName(FileName);
        lbl6.Caption := 'Img not draw.';
        clslbloj;
        trckbr1.Position := 9;
        pb1.Refresh;

      end;
    end;
  end;

end;

procedure TForm1.pb1Paint(Sender: TObject);
var
  i, j, lcorner, tcorner: Integer;
begin
  pb1.Width := Round(MapWidth  * UNITX * Zoom);
  pb1.Height := Round(MapHeight * UNITY * Zoom);
  lbl8.Caption := IntToStr(pb1.Width) + ' * ' + IntToStr(pb1.Height);
  //ShowBackgroundTile
  lcorner := Trunc(scrlbx1.HorzScrollBar.Position div UNITX / Zoom) ;    //水平线
  tcorner := Trunc(scrlbx1.VertScrollBar.Position div UNITY / Zoom);    //垂直线

   for j := 0 to MapHeight - 1  do
    for i := 0 to MapWidth - 1  do
    begin
      Application.ProcessMessages;


      if (i >=  lcorner - 1)  and (i <= lcorner +  Round(scrlbx1.Width div UNITX / Zoom) + 2)  and
        (j >= tcorner - 1) and (j <= tcorner +  Round(scrlbx1.Height div UNITY / Zoom) + 10) then
      begin
      if chkTiles.Checked then
        ShowTiles(pb1.Canvas, i, j);
      if chkSmTiles.Checked then
        ShowSmTiles(pb1.Canvas, i, j);
      if chkObjects.Checked then
        ShowObjects(pb1.Canvas, i, j);
      end;

      end;


end;

// 大瓦片tiles 96 *　64
procedure TForm1.ShowTiles(Canvas: TCanvas; x, y: Integer);
var
  idx, xx, yy: Integer;
begin
  if (x mod 2 = 0) and (y mod 2 = 0) then
  begin
    idx :=  (MArr[x, y].BkImg and $7fff ) - 1;
    if idx >=  0 then
    begin
     lblTil.Caption := 'useTiles';
     xx := Round(x * UNITX * Zoom);
     yy := Round(y * UNITY * Zoom);
     wilTiles.DrawZoom(Canvas, xx, yy, idx, Zoom);
    end;

  end;
end;

procedure TForm1.ShowSmTiles(Canvas: TCanvas; x, y: Integer);
var
  idx, xx, yy : Integer;
begin
  idx :=  (MArr[x, y].MidImg and $7fff) - 1;
   if idx >= 0 then
   begin
     lblSmT.Caption := 'useSmTil';
     xx := Round(x * UNITX * Zoom);
     yy := Round(y * UNITY * Zoom);
     wilSmTiles.DrawZoomEx(Canvas, xx, yy, idx, Zoom, True);
   end;

end;

procedure TForm1.ShowObjects(Canvas: TCanvas; x, y: Integer);
var
  idx, xx, yy: Integer;
begin
  idx := (MArr[x, y].FrImg and $7fff) - 1 ;   // objects 48 * n
                                         //需要 +1位置放置
        if idx > 0 then
        begin

          xx := Round(x* UNITX * Zoom);
          yy := Round((y + 1)  * UNITY * Zoom);

          case (MArr[x, y].Area) of
          0: begin
            lbloj1.Caption := 'use01';
            wil1.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          1: begin
             lbloj2.Caption := 'use02';
            wil2.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          2: begin
            lbloj3.Caption := 'use03';
            wil3.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          3: begin
             lbloj4.Caption := 'use04';
            wil4.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          4: begin
             lbloj5.Caption := 'use05';
            wil5.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          5: begin
             lbloj6.Caption := 'use06';
            wil6.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          6: begin
             lbloj7.Caption := 'use07';
            wil7.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          7: begin
            lbloj8.Caption := 'use08';
            wil8.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          8: begin
            lbloj9.Caption := 'use09';
            wil9.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          9: begin
            lbloj10.Caption := 'use10';
            wil10.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          10: begin
            lbloj11.Caption := 'use*11';
          end;
          11: begin
            lbloj12.Caption := 'use*12';
          end;
          12: begin
            lbloj13.Caption := 'use13';
            wil13.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          13: begin
             lbloj14.Caption := 'use14';
            wil14.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          14: begin
            lbloj15.Caption := 'use15';
            wil15.DrawZoomEx(Canvas, xx, yy, idx, Zoom, False);
          end;
          15: begin
             lbloj16.Caption := 'use*16';
          end;
          16..255: begin
           lbloj17.Caption :='use*' +  IntToStr(MArr[x, y].Area);
          end;
        end;


      end;
end;



procedure TForm1.btnSaveTobmpClick(Sender: TObject);
var
  i, j: Integer;
  str: string;
  Bitmap: TBitmap;
begin
   if dlgOpen1.FileName <> '' then
   begin
     str := dlgOpen1.FileName + '.bmp';
     i := Round(MapWidth * UNITX * Zoom);
     j := Round(MapHeight * UNITY * Zoom);
     if (i <= 3000) and (j <= 3000) then
     begin
       Bitmap := TBitmap.Create;
       Bitmap.Width := i;
       Bitmap.Height := j;
       pbar1.Position := 0;
       pbar1.Max := MapHeight;
      for j := 0 to MapHeight - 1  do
        begin
          for i := 0 to MapWidth - 1  do
          begin
           Application.ProcessMessages;
           if chkTiles.Checked then
            ShowTiles(Bitmap.Canvas, i, j);
           if chkSmTiles.Checked then
             ShowSmTiles(Bitmap.Canvas, i, j);
           if chkObjects.Checked then
             ShowObjects(Bitmap.Canvas, i, j);
          end;
          pbar1.StepIt;
        end;


       Bitmap.SaveToFile(str);
       lbl6.Caption := 'Bmp have drawed.';
       pbar1.Position := 0;
       Bitmap.Free;
     end else
       lbl6.Caption := 'Bmp is to large.';
   end;

end;

procedure TForm1.trckbr1Change(Sender: TObject);
begin

  case trckbr1.Position of
    1:  Zoom := 0.015625;  
    2:  Zoom := 0.03125;
    3:  Zoom := 0.0625;
    4:  Zoom := 0.09375;
    5:  Zoom := 0.125;
    6:  Zoom := 0.25;
    7:  Zoom := 0.5;
    8:  Zoom := 0.75;
    9:  Zoom := 1.0;

  end;


  lbl7.Caption := FloatToStr(Zoom);

  
end;

procedure TForm1.btnRefreshClick(Sender: TObject);
begin
  pb1.Refresh;
end;

procedure TForm1.clslbloj;
begin
  lblTil.Caption := 'Tiles';
  lblSmT.Caption := 'smTiles';
  lbloj1.Caption := '1';
  lbloj2.Caption := '2';
  lbloj3.Caption := '3';
  lbloj4.Caption := '4';
  lbloj5.Caption := '5';
  lbloj6.Caption := '6';
  lbloj7.Caption := '7';
  lbloj8.Caption := '8';
  lbloj9.Caption := '9';
  lbloj10.Caption := '10';
  lbloj11.Caption := '*11';
  lbloj12.Caption := '*12';
  lbloj13.Caption := '13';
  lbloj14.Caption := '14';
  lbloj15.Caption := '15';
  lbloj16.Caption := '*16';
  lbloj17.Caption := '*17-255';
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if wilTiles <> nil then wilTiles.Free;
    if wilSmTiles <> nil then wilSmTiles.Free;
    if wil1 <> nil then wil1.Free;
    if wil2 <> nil then wil2.Free;
    if wil3 <> nil then wil3.Free;
    if wil4 <> nil then wil4.Free;
    if wil5 <> nil then wil5.Free;
    if wil6 <> nil then wil6.Free;
    if wil7 <> nil then wil7.Free;
    if wil8 <> nil then wil8.Free;
    if wil9 <> nil then wil9.Free;
    if wil10 <> nil then wil10.Free;
    if wil13 <> nil then wil13.Free;
    if wil14 <> nil then wil14.Free;
    if wil15 <> nil then wil15.Free;



end;

end.

 

重点：

MAP文件机构

TMapHeader = packed record
Width: Word;
Height: word;
Title: string[15];
UpdateDate: TDateTime;
Reserved: array[0..23] of Char;
end;

 

TMapInfo = packed record
BkImg: Word;
MidImg: Word;
FrImg: Word;
DoorIndex: byte;
DoorOffset: byte;
AniFrame: byte;
AniTick: byte;
Area: byte;
Light: byte;
end;

 重点文件

控件 WIL,

 

思路：

2023-3-27

1，显示头文件信息
TMapHeader = packed record
Width: Word;
Height: word;
Title: string[15];
UpdateDate: TDateTime;
Reserved: array[0..23] of Char;
end;
已经完成

3，可以放大缩小

2，加入图像控件可以保存大图片的。
GDIPLUS
'E:\mirClient\Mir1.76\Map\0125.map.bmp'

这个GDI+ 用了下，看起来并不是封装好的控件，也并不是图像控件。
而是对于一些函数的封装和应用。。。

我来试下 PAINTBOX.
PAINTBOX的CANVAS 没有保存到文件的函数。

测试得BITMAP的WIDTH HEIGHT 在3060 再大了就错误了

用IMAGE的CANVAS 画布可以装的下，
但是这个画布保存不了文件，
要保存到文件还是得进过BITMAP 于是又到了BITMAP大小限制的地方。
用了JPEG 不行， 其根子 是读取的图片文件的。

可以扫描CANVAS 写流数据直接到图片文件中，
这个难了我现在搞不定，需要用到太多的函数。

那我现在先缩小图片，最大限制到3060不就可以了吗，总比大图片显示不出来要强些。


3，可以放大缩小

delphi 常用函数(数学函数）round、trunc、ceil和floor
delphi 常用函数(数学)


2023年3月27日星期一16:44:03
加入缩小放大功能
17:48:08
放大缩小功能成功，发现按照2的倍数 不会出现白线，于是设置固定 倍数。


4, 显示使用的objects 文件序号。
DATA
1.5 ,1.76 : OBJECTS 2-7
1.8 , OBJECTS 2- 10

sf,ip ,通用版 2-10, 13-15;

 

2023年3月28日星期二
上午 8:50:26

1,只用1个objects wil.

这个没有成功，WIL控件里面的对象似乎不能很好被释放掉，
对于大地图需要多达几万次的对 WMIMAGEL类构建，析构，结果程序就崩掉了
只有使用多个WMIMAGE类了的对象了。。。最后程序关闭的时候析构掉。


还有些想法，比如使用自己编辑的MYWIL 单元，
按理说可以，但是发现自己编写的 MYWIL 单元里面的DRAWZOOM 函数是被彻底的改编了，需要的参数都不一样，
需要重新写，放弃了，
基本原理已经知道了，

感觉继续深入下去还是会放弃 DXD7这个控件，
会重新编写WIL单元，直接上 DX 的API 了。
这个里面就需要剔除掉DIB单元，是直接读取数据到BMP了。

下一步，带DXD7客户端了。。。