rei_02.pas

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

unit Rei_02;

interface

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

type
  TRei40_02 = 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_02: TRei40_02;
  //   图样阵列1
  Ptmap1: array[0..(37 * 27 - 1)] of Byte = (
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
      7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7,7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
      7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 7,
    7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 7,
    7, 7, 7, 8, 9, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
      7, 7, 7, 7, 7, 7, 7, 8, 9, 7, 7, 7, 7, 7,
    7, 1, 1,10,11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 1, 1, 1, 1,10, 11, 1, 1, 1, 1, 7,
    7, 1, 1,10,11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 9, 7, 7, 7,
      7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1,
      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 7,
    7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1,
      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 8, 9, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
      7, 7, 7, 7, 7, 7, 8, 9, 7, 7, 7, 7, 7, 7,
    7, 1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 1, 7,
    7, 1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 1, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
      8, 9, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     10,11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 7,
    7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     10,11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 8, 9, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
      7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 7,
    7, 1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
      7, 7, 7, 8, 9, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1,10,11, 1, 1, 1, 1, 1, 1, 1, 1, 7,
    7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1,10,11, 1, 1, 1, 1, 1, 1, 1, 1, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 8, 9, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
      7, 7, 7, 7, 7, 7, 7, 8, 9, 7, 7, 7, 7, 7,
    7, 1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 7,
    7, 1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 1, 1, 1, 1,10,11, 1, 1, 1, 1, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
      7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
      7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7
  );
  //   图样阵列2
  Ptmap2: 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,12,12),
    (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,12,12),
    (2,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,4,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (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,12,12),
    (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,12,12),
    (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,12,12),
    (2,2,2,2,4,2,2,2,2,2,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,2,3,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,2,4,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,4,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,3,2,2,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,4,2,2,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2,12,12,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2,12,12,12,12),
    (2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,2,2,2, 2, 2, 2,12,12,12,12,12,12),
    (2,2,2,2,2,2,2,2,4,2,2,2,2,2,2,2,2,2, 2, 2, 2,12,12,12,12,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2,12,12,12,12),
    (2,2,2,5,6,2,2,2,2,2,2,2,2,2,2,2,2,2, 2, 2, 2, 2, 2,12,12,12,12),
    (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,12,12),
    (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,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,4,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,12, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,12, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,12, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,12, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,12, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,4,2,2,2,2,2,2,2,2,2,2,2,2,2,2,12, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,12, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,3,2,2,2,2,2,2,2,2,2,2,12,12,12,12,12,12,12,12,12),
    (2,2,2,2,2,2,2,4,2,2,2,2,2,2,2,2,2,2,12,12,12,12,12,12,12,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (2,2,2,2,2,2,2,2,2,2,2,4,2,2,2,2,2,2, 2, 2, 2, 2, 2, 2, 2,12,12),
    (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,12,12),
    (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,12,12)
   );
  //   定义载入用与绘图用的点阵图
  Load_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //   定义各种变量（Byte类型、Trect类型）
  P, PX, PY, GX, GY: Byte;
  Rect_L, Rect_M: TRect;

implementation

{$R *.DFM}

procedure TRei40_02.FormCreate(Sender: TObject);
begin
  //   设定Form属性
  Rei40_02.Height := 480;
  Rei40_02.Width := 640;
  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');
  //   储存描绘用的点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := Yoko * 16;
  Make_Bmap.Height := Tate * 16;
end;

procedure TRei40_02.Button1Click(Sender: TObject);
var
  X, Y: Byte;
begin
  //   将阵列1的图样描绘至Make_Bmap上并将其显示在Form上
  Make_Bmap.Canvas.CopyMode := cmSrcCopy;
  for Y := 0 to (Tate - 1) do
    for X := 0 to (Yoko - 1) do
    begin
      P := Ptmap1[Y * Yoko + X];
      if P <> 0 then
      begin
        PX := (P mod 16) * 16;
        PY := (P div 16) * 16;
        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;
  Rei40_02.Canvas.CopyMode := cmSrcCopy;
  Rei40_02.Canvas.Draw(0, 0, Make_Bmap);
end;

procedure TRei40_02.Button2Click(Sender: TObject);
var
  X, Y: Byte;
begin
  //   将阵列1的图样描绘至Make_Bmap上并将其显示在Form上
  Make_Bmap.Canvas.CopyMode := cmSrcCopy;
  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 mod 16) * 16;
        PY := (P div 16) * 16;
        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;
  Rei40_02.Canvas.CopyMode := cmSrcCopy;
  Rei40_02.Canvas.Draw(0, 0, Make_Bmap);
end;

procedure TRei40_02.ReDraw(Sender: TObject);
begin
  //   Form画面的再描绘
  Rei40_02.Canvas.CopyMode := cmSrcCopy;
  Rei40_02.Canvas.Draw(0, 0, Make_Bmap);
end;

procedure TRei40_02.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //   将载入用与描绘用的点阵图释放掉
  Load_Bmap.Free;
  Make_Bmap.Free;
end;

end.