Delphi 经典游戏程序设计40例的学习例39 点阵图编辑器的世界

标签：begin end Sender 16 Delphi 点阵图 39 TObject procedure

unit R39;

interface

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

type
  TRei39 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Timer1: TTimer;
    Image1: TImage;
    MainMenu1: TMainMenu;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    File1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    SaveAs1: TMenuItem;
    N1: TMenuItem;
    Open2: TMenuItem;
    N2: TMenuItem;
    Eixt1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
   
    procedure Button5Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Open1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure Open2Click(Sender: TObject);
    procedure Eixt1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MbOff(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    procedure Dimap;

  public
    { Public declarations }
    Pnum: Byte;       //选定的图案编号
  end;
const
  Yoko = 37;
  Tate = 27;
  GmenX = Yoko * 16;
  GmenY = Tate * 16;

var
  Rei39: TRei39;
  LoadBmap: TBitmap;
  MakeBmap: TBitmap;
  RectL, RectP, RectS, RectD: TRect;
  P, PX, PY: Byte;         //图案编号与位置
  MapX, MapY: Byte;        //画面左上角的点阵图坐标
  Dir, Bkey,  PatOn, Esign: Byte;   //滚动方向0，停止，1-4上下左右
                                    //Bkey 1子画面窗口与图案显示
                                    //PatOn 1 按下鼠标左键
  QX, QY: Byte;                  //能够移动的方向编号
  Bname, Mname, Fname: string;


  File255: file;      //文件类型
  Bigmap: array[0..255, 0..255] of Byte;




implementation
  uses R39s;      //使用另外一个单元，

{$R *.dfm}

procedure TRei39.FormCreate(Sender: TObject);
var
  lx, ly: Byte;
begin
  Image1.Height := GmenY;
  Image1.Width := GmenX;
  Image1.Transparent := True;
  LoadBmap := TBitmap.Create;    //载入画板
  LoadBmap.LoadFromFile(GetCurrentDir + '\Pat_Sample.bmp');

  MakeBmap := TBitmap.Create;      //制作画板
  MakeBmap.Width := GmenX;
  MakeBmap.Height := GmenY;

  for ly := 0 to 255 do
    for lx := 0 to 255 do
      Bigmap[lx,ly] := 14;

  Dir := 0;
  Bkey := 1;
  Esign := 0;

  Bname := 'Map Pats(*.bmp)|*.bmp|All(*.*)|*.*|';
  Fname := 'Map(*.map)|*.map|All(*.*)|*.*|';



  Dimap;
end;

procedure TRei39.Dimap;
var
  lx,ly : Byte;
begin
  MapX := 0;
  MapY := 0;
  MakeBmap.Canvas.CopyMode := cmSrcCopy;
  for ly := 0 to (Tate - 1) do
    for lx := 0 to (Yoko - 1) do
      begin
        P :=  Bigmap[MapX + lx,MapY + ly];
        PX := (P and $F) * 16;
        Py := P and $F0;
        RectL := Rect(PX, PY, PX + 16,PY + 16);
        RectD := Rect(lx * 16, ly * 16, lx * 16 + 16,ly * 16 + 16);
        MakeBmap.Canvas.CopyRect(RectD,LoadBmap.Canvas,RectL);
      end;
  Rei39.Canvas.CopyMode := cmSrcCopy;
  Rei39.Canvas.Draw(0,0,MakeBmap);
end;

procedure TRei39.Timer1Timer(Sender: TObject);
var
  lx, ly: Byte;
begin
  if Bkey = 1 then     //显示字窗口
  begin
    Rei39s.Show;
    Rei39s.Image1.Canvas.CopyMode := cmSrcCopy;
    Rei39s.Image1.Canvas.Draw(0,0,LoadBmap);
    Bkey := 2;
  end;
  if Dir <> 0 then
  begin
    with MakeBmap do
      case Dir of
        1: begin    //向上移动
          RectS := Rect(0, 0, GmenX, GmenY - 16);
          RectD := Rect(0, 16, GmenX, GmenY);
          Canvas.CopyRect(RectD, Canvas, RectS);
          MapY := MapY - 1;
          for lx := 0 to (Yoko - 1) do
          begin
            P := Bigmap[((MapX + lx) and $FF), MapY];
            PX := (P and $F) * 16;
            PY := P and $F0;
            RectL := Rect(PX, PY, PX + 16,PY + 16);
            RectD := Rect(lx * 16, 0, lx * 16 + 16, 16);
            Canvas.CopyRect(RectD, LoadBmap.Canvas, RectL);
           end;
        end;
        2: begin
          RectS := Rect(0, 16, GmenX,GmenY);
          RectD := Rect(0, 0, GmenX, GmenY - 16);
          Canvas.CopyRect(RectD, Canvas, RectS);
          MapY := MapY + 1;
          for lx := 0 to (Yoko - 1) do
          begin
            P := Bigmap[((MapX + lx) and $FF), ((MapY + Tate - 1) and $FF)];
            PX := (P and $F) * 16;
            PY := P and $F0;
            RectL := Rect(PX, PY, PX + 16,PY + 16);
            RectD := Rect(lx * 16, GmenY - 16, lx * 16 + 16, GmenY);
            Canvas.CopyRect(RectD, LoadBmap.Canvas, RectL);
           end;
        end;
        3: begin
          RectS := Rect(0, 0, GmenX - 16,GmenY);
          RectD := Rect(16, 0, GmenX, GmenY);
          Canvas.CopyRect(RectD, Canvas, RectS);
          MapX := MapX - 1;
          for ly := 0 to (Tate - 1) do
          begin
            P := Bigmap[MapX, ((MapY + ly) and $FF)];
            PX := (P and $F) * 16;
            PY := P and $F0;
            RectL := Rect(PX, PY, PX + 16,PY + 16);
            RectD := Rect(0, ly * 16, 16, ly * 16 + 16);
            Canvas.CopyRect(RectD, LoadBmap.Canvas, RectL);
           end;
        end;

        4: begin
          RectS := Rect(16, 0, GmenX,GmenY);
          RectD := Rect(0, 0, GmenX - 16, GmenY);
          Canvas.CopyRect(RectD, Canvas, RectS);
          MapX := MapX + 1;
          for ly := 0 to (Tate - 1) do
          begin
            P := Bigmap[((MapX + Yoko -1) and $FF), ((MapY + ly) and $FF)];
            PX := (P and $F) * 16;
            PY := P and $F0;
            RectL := Rect(PX, PY, PX + 16,PY + 16);
            RectD := Rect(GmenX - 16, ly * 16, GmenX, ly * 16 + 16);
            Canvas.CopyRect(RectD, LoadBmap.Canvas, RectL);
           end;
        end;
      end;
  end;
  Rei39.Canvas.Draw(0,0,MakeBmap);
end;


procedure TRei39.Button5Click(Sender: TObject);
begin
  if Bkey = 2 then
  begin
    Rei39s.Hide;
    Bkey := 0;
  end
  else if Bkey = 0 then
    Bkey :=1;
end;

procedure TRei39.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    PatOn := 1;
    RectP := Rect((Pnum mod 16) * 16, (Pnum div 16) * 16,
      (Pnum mod 16) * 16 + 16, (Pnum div 16) * 16 + 16);
    RectD := Rect(X and $FFF0, Y and $FFF0, X and $FFF0 + 16,  //取16整数点？
      Y and $FFF0 + 16);
    MakeBmap.Canvas.CopyRect(RectD, LoadBmap.Canvas, RectP);
    Rei39.Canvas.CopyRect(RectD, LoadBmap.Canvas, RectP);
    QX := MapX + X div 16;
    QY := MapY + Y div 16;
    Bigmap[QX, QY] := Pnum;    //写入数组数据
    Esign := 1;
  end
  else if Button = mbright then
  begin
    QX := MapX + X div 16;
    QY := MapY + Y div 16;
    Pnum := Bigmap[QX, QY];
  end;
end;

procedure TRei39.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  ZeroX, ZeroY: string;
  NowX, NowY: Byte;
begin        //点阵图坐标显示
  if (X < GmenX) and (Y < GmenY) then
  begin
    NowX := MapX + X div 16;
    NowY := MapY + Y div 16;
  end
  else begin
    NowX := QX;
    NowY := QY;
  end;

  ZeroX := '0';
  ZeroY := '0';

  if NowX > 99 then  //显示前缀0
    ZeroX := ''
  else if NowX < 10 then
    ZeroX := '00'
  else if NowY > 99 then
    ZeroY := ''
  else if NowY < 10 then
    ZeroY := '00';

  Rei39.Caption := 'Map Editor : ( ' + ZeroX + IntToStr(NowX) +
    ',' + ZeroY + IntToStr(NowY) + ')';
      //点阵图的修改？
  if (PatOn = 1) and ((QX <> NowX) or (QY <> NowY)) then
    begin
      RectP := Rect((Pnum mod 16) * 16, (Pnum div 16) * 16,
        (Pnum mod 16) * 16 + 16, (Pnum div 16) * 16 + 16);
      RectD := Rect(X and $FFF0, Y and $FFF0,
        X and $FFF0 + 16, Y and $FFF0 + 16);
      MakeBmap.Canvas.CopyRect(RectD, LoadBmap.Canvas, RectP);
      Rei39.Canvas.Draw(0, 0, MakeBmap);
      Bigmap[NowX, NowY] := Pnum;
      QX := NowX;
      QY := NowY;
      Esign := 1;
    end;
end;

procedure TRei39.Open1Click(Sender: TObject);
var
  Dval: LongInt;
begin
  OpenDialog1.Filter := Fname;      //过滤文件名
  if OpenDialog1.Execute then
  begin
    Mname := OpenDialog1.FileName;     //取得文件名
    Fname := OpenDialog1.Filter;

    AssignFile(File255, OpenDialog1.FileName);
    Reset(File255, 1);                        //打开指定文件
    BlockRead(File255, Bigmap, SizeOf(Bigmap), Dval);  //读取记录
    CloseFile(File255);
    Dimap;                                           //显示文件
    Esign := 0;
  end;

end;

procedure TRei39.Save1Click(Sender: TObject);
begin
  if Mname <> '' then
  begin
    AssignFile(File255, Mname);
    Rewrite(File255, 1);               //打开文件，
    BlockWrite(File255, Bigmap, SizeOf(Bigmap));     //写入数据
    CloseFile(File255);
  end;

end;

procedure TRei39.SaveAs1Click(Sender: TObject);
begin
  SaveDialog1.Filter := Fname;
  SaveDialog1.FileName := Mname;
  SaveDialog1.Options := [ofOverwritePrompt];
  if SaveDialog1.Execute then
  begin
    Mname := SaveDialog1.FileName;
    Fname := SaveDialog1.Filter;
    AssignFile(File255, SaveDialog1.FileName);
    Rewrite(File255, 1);
    BlockWrite(File255, Bigmap,SizeOf(Bigmap));
    CloseFile(File255);
    Esign := 0;
  end;
end;

procedure TRei39.Open2Click(Sender: TObject);
begin
  OpenDialog1.Filter := Bname;
  if OpenDialog1.Execute then
  begin
    Bname := OpenDialog1.Filter;
    LoadBmap.LoadFromFile(OpenDialog1.FileName);
    Dimap;
    Rei39s.Hide;
    Bkey := 1;
  end;
end;

procedure TRei39.Eixt1Click(Sender: TObject);
begin
  if Esign <> 0 then  //有编辑过。
    begin
      if MessageDlg('是否结束 Map Editor',
        mtConfirmation, mbYesNoCancel, 0) = mrYes then
        Close;
    end
  else
    Close;
end;

procedure TRei39.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  LoadBmap.Free;
  MakeBmap.Free;
end;

procedure TRei39.MbOff(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Dir := 0;
  PatOn := 0;
end;

procedure TRei39.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Dir := 1;
end;

procedure TRei39.Button2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Dir := 2;
end;

procedure TRei39.Button3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Dir := 3;
end;

procedure TRei39.Button4MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Dir := 4;
end;

end.

unit R39s;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus;

type
  TRei39s = class(TForm)
    Image1: TImage;
    procedure Mselect(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Rei39s: TRei39s;

implementation

uses R39;       //使用R39单元

{$R *.dfm}

procedure TRei39s.Mselect(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Rei39.Pnum := (Y div 16) * 16 + X div 16;
end;

end.

通过对象树和观察器来建立对象的方法。

标签：begin,end,Sender,16,Delphi,点阵图,39,TObject,procedure
From： https://www.cnblogs.com/D7mir/p/16993001.html

Delphi 经典游戏程序设计40例的学习例39 点阵图编辑器的世界

相关文章

赞助商

阅读排行

Delphi 经典游戏程序设计40例 的学习 例39 点阵图编辑器的世界

相关文章

赞助商

阅读排行

Delphi 经典游戏程序设计40例的学习例39 点阵图编辑器的世界