rei_03.pas

Delphi经典游戏程序设计40例.pdf 中国铁道出版社出版 含源码

unit Rei_03;

interface

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

type
  TRei40_03 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ReDraw(Sender: TObject);
  private
    { Private 定义 }
  public
    { Public 定义 }
  end;

const
  Yoko = 37;   // 横向图样数
  Tate = 27;   // 直立图样数

var
  Rei40_03: TRei40_03;
  //   图像(1)用的数组
  Ptmap1: array[0..36, 0..26] of Byte = (
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2,0),
    (2,2,2,2,2,3,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2,0),
    (2,2,2,2,2,4,2,2, 2,2,2,2,2,2, 0,2,2,3,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2,12,2,2,4,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2,12,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,3,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,4,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,3,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,4,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,3, 2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,4, 2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2,12,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2,12,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,3,2, 0,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,4,2, 0,2,2,2,2,2, 0,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 0,2,2,2,2,2, 2,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 0,2,2,2,2,2, 2,2,3,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,3,2,2, 0,2,2,2,2,2, 2,2,4,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,4,2,2, 0,2,2,2,2,2, 2,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,5,6,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 0,2,2,3,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,3,2,2,2,12,2,2,4,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,4,2,2,2,12,2,2,2,2,2,0),
    (2,2,2,2,2,2,3,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 0,2,2,2,2,2,0),
    (2,2,2,2,2,2,4,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2,0),
    (2,2,2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2, 2,2,2,2,2,2,0)
   );
  //   图像(2)用的数组
  Ptmap2: array[0..36, 0..26] of Byte = (
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,17,17,17,17,17,17,17,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,18,18,18,18,18,18,18,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0,17,17,17,17,17,17,17,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0,18,18,18,18,18,18,18,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0,17,17,17,17,17,17,12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0,18,18,18,18,18,18,12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,17,17,
      17,17,17,17,17, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,18,18,
      18,18,18,18,18, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,12,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 7),
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 7)
   );
  //   定义载入图像、去除用模版图像与绘制用图像
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  // 定义各种变量（Byte类型、Trect类型）
  P, PX, PY, Xdip: Byte;
  Rect_L, Rect_M: TRect;

implementation

{$R *.DFM}

procedure TRei40_03.FormCreate(Sender: TObject);
begin
  //   设定Form属性
  Rei40_03.Height := 480;
  Rei40_03.Width := 640;
  Rei40_03.Canvas.CopyMode := cmSrcCopy;
  Button1.Height := 25;
  Button1.Left := 603;
  Button1.Top := 16;
  Button1.Width := 25;
  Button2.Height := 25;
  Button2.Left := 603;
  Button2.Top := 56;
  Button2.Width := 25;
  //   载入图样资料
  Load_Bmap := TBitmap.Create;
  Load_Bmap.LoadFromFile(GetCurrentDir + '\ExData\Pat_Sample.bmp');
  //   储存去除用图样模版点阵图
  Xpat_Bmap := TBitmap.Create;
  Xpat_Bmap.Width := 256;
  Xpat_Bmap.Height := 256;
  //   制作去除用图样模版点阵图
  Rect_L := Rect(0, 0, 256, 256);
  Xpat_Bmap.Canvas.CopyMode := cmSrcCopy;
  Xpat_Bmap.Canvas.CopyRect(Rect_L, Load_Bmap.Canvas, Rect_L);
  Xpat_Bmap.Canvas.Brush.Color := clBlack;
  Xpat_Bmap.Canvas.BrushCopy(Rect_L, Load_Bmap, Rect_L, clWhite);
  Xpat_Bmap.Canvas.CopyMode := cmMergePaint;
  Xpat_Bmap.Canvas.CopyRect(Rect_L, Load_Bmap.Canvas, Rect_L);
  //   储存绘制用点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := Yoko * 16;
  Make_Bmap.Height := Tate * 16;
  //   变量的初始设定
  Xdip := 0;
end;

procedure TRei40_03.Button1Click(Sender: TObject);
begin
  //   将Xpat_Bmap显示在Form上
  Rei40_03.Canvas.Draw(0, 0, Xpat_Bmap);
  Xdip := 1;
end;

procedure TRei40_03.Button2Click(Sender: TObject);
var
  X, Y: Byte;
begin
  //   将图像(1)(2)绘制在Make_Bmap并显示出来
  Make_Bmap.Canvas.CopyMode := cmSrcCopy;
  for Y := 0 to (Tate - 1) do
    for X := 0 to (Yoko - 1) do
    begin
      P := Ptmap1[X, Y];
      if P <> 0 then
      begin
        PX := (P and $F) * 16;
        PY := P and $F0;
        Rect_L := Rect(PX, PY, PX + 16, PY + 16);
        Rect_M := Rect(X * 16, Y * 16, X * 16 + 16, Y * 16 + 16);
        Make_Bmap.Canvas.CopyRect(Rect_M, Load_Bmap.Canvas, Rect_L);
      end;
    end;
  for Y := 0 to (Tate - 1) do
    for X := 0 to (Yoko - 1) do
    begin
      P := Ptmap2[X, Y];
      if P <> 0 then
      begin
        PX := (P and $F) * 16;
        PY := P and $F0;
        Rect_L := Rect(PX, PY, PX + 16, PY + 16);
        Rect_M := Rect(X * 16, Y * 16, X * 16 + 16, Y * 16 + 16);
        Make_Bmap.Canvas.CopyMode := cmSrcPaint;
        Make_Bmap.Canvas.CopyRect(Rect_M, Xpat_Bmap.Canvas, Rect_L);
        Make_Bmap.Canvas.CopyMode := cmSrcAnd;
        Make_Bmap.Canvas.CopyRect(Rect_M, Load_Bmap.Canvas, Rect_L);
      end;
    end;
  Rei40_03.Canvas.Draw(0, 0, Make_Bmap);
  Xdip := 0;
end;

procedure TRei40_03.ReDraw(Sender: TObject);
begin
  //   Form画面的重绘
  Rei40_03.Canvas.Draw(0, 0, Make_Bmap);
  if Xdip = 1 then
    Rei40_03.Canvas.Draw(0, 0, Xpat_Bmap);
end;

procedure TRei40_03.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //   释放载入用图像、去除用模版与绘制用点阵图
  Load_Bmap.Free;
  Xpat_Bmap.Free;
  Make_Bmap.Free;
end;

end.