rei_14.pas

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

unit Rei_14;

interface

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

type
  TRei40_14 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure ReDraw(Sender: TObject);
  private
    { Private 定义 }
    procedure DiBack0;
    procedure DiBack1;
    procedure FmDip;
    procedure DiBox(X1, Y1, X2, Y2: Word);
    procedure ChrDi(Xsiz, Ysiz: Byte; Dpon: Word; X1, Y1: Integer;
      Bmap: TBitmap);
    procedure PatDi(Pnum: Byte; X1, Y1: Integer; Bmap: TBitmap);
  public
    { Public 定义 }
  end;

const
  Yoko = 37;           //显示的横向图案数
  Tate = 27;           //显示的纵向图案数
  DYoko = Yoko * 16;   //显示的横向点数
  DTate = Tate * 16;   //显示的纵向点数
  PtFull = 16;         //全面显示（不要重叠显示）的图案数
  MaxSp = 4;           //本次使用的复合图案总数

var
  Rei40_14: TRei40_14;
  //  定义载入用、去除模版用、原有图像用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Bpat_Bmap: TBitmap;
  Back0_Bmap: TBitmap;
  Back1_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  定义各种变量（Byte类型、Word类型、TRect类型、Integer类型、数组类型）
  P, PX, PY, nX, nY: Byte;
  Backs: Byte = 0;
  Chan: Byte = 255;
  m, Sc: Word;
  Rect_L, Rect_M, Rect_B, Rect_S, Rect_D: TRect;
  //  复合图案数组
  SpSiz: array[0..(MaxSp * 2 - 1)] of Byte = (2,2, 31,17, 2,2, 31,21);
  SpPon: array[0..(MaxSp - 1)] of Word;
  SpDat: array[0..(8 + 31 * 38 - 1)] of Byte = (
    28,29,30,31,
    19,19,19,19,19,19,19,19,19,19,19,19,19,19, 0, 0,
      0,19,19,19,19,19,19,19,19,19,19,19,19,19,19,
    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, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0,12,12,12,12,12, 0, 0, 0,12,12,12,12,12, 0, 0,
      0,12,12,12,12,12, 0, 0,12,12,12,12,12,12, 0,
    12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0,12,12, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    0,12,12,12,12,12, 0, 0, 0,12,12,12,12,12, 0, 0,
      0,12,12,12,12,12, 0, 0,12,12,12,12,12,12, 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, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,
      19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,
    32,33,48,49,
    12,12,12,12,12,12,12,12,12,12,12,12,12,12, 0, 0,
      0,12,12,12,12,12,12,12,12,12,12,12,12,12,12,
    12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,12, 0, 0,
      0,12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,12,
    12,12,12,12,12,12,12,12,12,12,12,12,12,12, 0, 0,
      0,12,12,12,12,12,12,12,12,12,12,12,12,12,12,
    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, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      0,19,19,19,19,19, 0, 0,19, 0, 0, 0, 0, 0,19,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0,19, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0,19, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19,19, 0, 0, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0,19, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0,19, 0,
    19,19,19,19,19,19,19, 0, 0,19,19,19,19,19, 0, 0,
      0,19,19,19,19,19, 0, 0,19, 0, 0, 0, 0, 0,19,
    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, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,
      12,12,12,12,12,12,12,12,12,12,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, 2, 2, 2, 2, 2, 2,12,
    12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,
      12,12,12,12,12,12,12,12,12,12,12,12,12,12,12
  );

implementation

{$R *.DFM}

procedure TRei40_14.FormCreate(Sender: TObject);
var
  //  定义局部变量
  n: Word;
begin
  //  设定Form属性
  Rei40_14.Height := 480;
  Rei40_14.Width := 640;
  Rei40_14.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;
  Button3.Height := 25;
  Button3.Left := 603;
  Button3.Top := 96;
  Button3.Width := 25;
  Button4.Height := 25;
  Button4.Left := 603;
  Button4.Top := 136;
  Button4.Width := 25;
  Button5.Height := 25;
  Button5.Left := 603;
  Button5.Top := 192;
  Button5.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);
  //  储存粉刷用点阵图
  Bpat_Bmap := TBitmap.Create;
  Bpat_Bmap.Width := 8;
  Bpat_Bmap.Height := 8;
  //  子画面指标数组的初始设定
  Sc := 0;
  for n := 0 to (MaxSp - 1) do
  begin
    SpPon[n] := Sc;
    Sc := Sc + SpSiz[n * 2] * SpSiz[n * 2 + 1];
  end;
  //  储存原有图案(1)用的点阵图
  Back0_Bmap := TBitmap.Create;
  Back0_Bmap.Width := Dyoko;
  Back0_Bmap.Height := Dtate;
  //  储存原有图案(2)用的点阵图
  Back1_Bmap := TBitmap.Create;
  Back1_Bmap.Width := Dyoko;
  Back1_Bmap.Height := Dtate;
  //  将原有图案(1)(2)绘制在各自的点阵图上用的点阵图
  DiBack0;
  DiBack1;
  //  储存绘制点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := Dyoko + 32;
  Make_Bmap.Height := Dtate + 32;
end;

procedure TRei40_14.Timer1Timer(Sender: TObject);
var
  //  定义局部变量
  X, Y: Byte;
  n: Word;
begin
  //  图案的化妆交换显示
  case Chan of
   //  变量的初始设定
    1..4: begin
      Chan := Chan + 10;
      m := 0;
      nX := 0;
      nY := 0;
    end;
    //  交换显示(1)的处理
    11: begin
      if Yoko > Tate then
      begin
        X := DYoko div 2 - (Yoko - Tate + m + 1) * 8;
        Y := DTate div 2 - (m + 1) * 8;
      end
      else begin
        X := DYoko div 2 - (m + 1) * 8;
        Y := DTate div 2 - (Tate - Yoko + m + 1) * 8;
      end;
      DiBox(X, Y, DYoko - X, DTate - Y);
      m := m + 1;
      if (m >= Yoko) or (m >= Tate) then
      begin
        Chan := 0;
        Backs := Backs xor 1;
      end;
      Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
      Rect_D := Rect(0, 0, DYoko, DTate);
      Rei40_14.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
    end;
    //  交换显示(2)的处理
    12: begin
      X := nX;
      Y := nY;
      if m > 0 then
      begin
        for n := 0 to (Yoko - 1) do
        begin
          X := (X + 36) mod Yoko;
          Y := (Y + 26) mod Tate;
          DiBox(X * 16, Y * 16, X * 16 + 16, Y * 16 + 16);
        end;