rei_12.pas

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

unit Rei_12;

interface

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

type
  TRei40_12 = 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 FmCls(Col: TColor);
    procedure DipDt(X1, Y1: Word; Dt: Byte);
    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 = 2;            //本次使用的复合图案总数

var
  Rei40_12: TRei40_12;
  //  定义载入用、去除模版用、粉刷图案用、显示用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Bpat_Bmap: TBitmap;
  Back_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  定义各种变量（Byte类型、Word类型、TRect类型）
  P, PX, PY, DX, DY, Cdip: Byte;
  Disp: Byte = 255;
  n, m, Sc: Word;
  Rect_L, Rect_M, Rect_D: TRect;
  //  复合图案数组
  SpSiz: array[0..(MaxSp * 2 - 1)] of Byte = (2,2, 31,17);
  SpPon: array[0..(MaxSp - 1)] of Word;
  SpDat: array[0..(4 + 31 * 17 - 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
  );

implementation

{$R *.DFM}

procedure TRei40_12.FormCreate(Sender: TObject);
var
  //  定义局部变量
  X, Y: Byte;
  Pn: Word;
begin
  //  设定Form属性
  Rei40_12.Height := 480;
  Rei40_12.Width := 640;
  Rei40_12.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 Pn := 0 to (MaxSp - 1) do
  begin
    SpPon[Pn] := Sc;
    Sc := Sc + SpSiz[Pn * 2] * SpSiz[Pn * 2 + 1];
  end;
  //  储存绘制用点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := Dyoko;
  Make_Bmap.Height := Dtate;
  //  将欲显示的图案绘制到Back_Bmap
  Back_Bmap := TBitmap.Create;
  Back_Bmap.Width := Dyoko + 32;
  Back_Bmap.Height := Dtate + 32;
  for Y := 0 to (Tate - 1) do
    for X := 0 to (Yoko - 1) do
      PatDi(7, X * 16 + 16, Y * 16 + 16, Back_Bmap);
  ChrDi(SpSiz[0], SpSiz[1], SpPon[0], 298, 88, Back_Bmap);
  ChrDi(SpSiz[2], SpSiz[3], SpPon[1], 66, 96, Back_Bmap);
end;

procedure TRei40_12.Timer1Timer(Sender: TObject);
var
  //  定义局部变量
  X, Y: Byte;
  Pn: Word;
begin
  //  化妆显示与画面去除
  case Disp of
    //  以黑色去除画面并进行初始设定
    1..4: begin
      FmCls(clBlack);
      Disp := Disp + 10;
      n := 0;
      m := 0;
      DX := 0;
      DY := 0;
    end;
    //  化妆显示(1)的处理
    11: begin
      Make_Bmap.Canvas.CopyMode := cmSrcCopy;
      X := n;
      Y := n;
      if n < Yoko then
        for X := n to (Yoko * 2 - 2 - n) do
          DipDt(X * 8, Y * 8, 8);
      if n < Tate then
        for Y := n to (Tate * 2 - 2 - n) do
          DipDt(X * 8, Y * 8, 8);
      if n < Yoko then
        for X := (Yoko * 2 - 1 - n) downto (n + 1) do
          DipDt(X * 8, Y * 8, 8);
      if n < Tate then
        for Y := (Tate * 2 - 1 - n) downto (n + 1) do
          DipDt(X * 8, Y * 8, 8);
      n := n + 1;
      if (n >= Yoko) or (n >= Tate) then
        Disp := 0;
      Rei40_12.Canvas.Draw(0, 0, Make_Bmap);
    end;
    //  化妆显示(2)的处理
    12: begin
      Make_Bmap.Canvas.CopyMode := cmSrcCopy;
      for Pn := 0 to (Yoko - 1) do
      begin
        DX := (DX + 36) mod Yoko;
        DY := (DY + 26) mod Tate;
        DipDt(DX * 16, DY * 16, 16);
      end;
      m := m + 1;
      if m = Tate then
        Disp := 0;
      Rei40_12.Canvas.Draw(0, 0, Make_Bmap);
    end;
    //  化妆显示(3)的处理
    13: begin
      if n < 16 then
      begin
        Bpat_Bmap.Canvas.CopyMode := cmNotSrcCopy;
        Rect_L := Rect(n * 8 + 32, 64, n * 8 + 40, 72);
        Rect_D := Rect(0, 0, 8, 8);
        Bpat_Bmap.Canvas.CopyRect(Rect_D, Load_Bmap.Canvas, Rect_L);
        Make_Bmap.Canvas.Brush.Bitmap := Bpat_Bmap;
        Make_Bmap.Canvas.CopyMode := cmMergeCopy;
        Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
        Rect_D := Rect(0, 0, DYoko, DTate);
        Make_Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_M);
        Make_Bmap.Canvas.Brush.Bitmap := Nil;
        n := n + 1;
      end
      else
        Disp := 0;
      Rei40_12.Canvas.Draw(0, 0, Make_Bmap);
    end;
    //  化妆显示(4)的处理
    14: begin
      Make_Bmap.Canvas.CopyMode := cmSrcCopy;
      m := m + 1;
      for Pn := 0 to (Tate * 4 - 1) do
      begin
        Rect_M := Rect(DYoko - m * 8 + 16, Pn * 4 + 16,
          DYoko + 16, Pn * 4 + 18);
        Rect_D := Rect(0, Pn * 4, m * 8, Pn * 4 + 2);
        Make_Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_M);
        Rect_M := Rect(16, Pn * 4 + 18, m * 8 + 16, Pn * 4 + 20);
        Rect_D := Rect(DYoko - m * 8, Pn * 4 + 2, DYoko, Pn * 4 + 4);
        Make_Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_M);
      end;
      if m = Yoko * 2 then
        Disp := 0;
      Rei40_12.Canvas.Draw(0, 0, Make_Bmap);
    end;
    //  执行後的画面去除
    255: begin
      FmCls(clBlack);
      Disp := 0;
      Cdip := 0;
    end;
  end;
end;

procedure TRei40_12.DipDt(X1, Y1: Word; Dt: Byte);
begin
  //  从显示画面将指定大小的正方形复制到绘制点阵图
  Rect_M := Rect(X1 + 16, Y1 + 16, X1 + 16 + Dt, Y1 + 16 + Dt);
  Rect_D := Rect(X1, Y1, X1 + Dt, Y1 + Dt);
  Make_Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_M);
end;

procedure TRei40_12.FmCls(Col: TColor);
begin
  //  以指定的颜色将绘制点阵图与画面去除
  Rect_D := Rect(0, 0, Dyoko, Dtate);
  Make_Bmap.Canvas.Brush.Color := Col;
  Make_Bmap.Canvas.FillRect(Rect_D);
  Rei40_12.Canvas.Draw(0, 0, Make_Bmap);
end;

procedure TRei40_12.Button1Click(Sender: TObject);
begin
  //  化妆显示(1)的指定
  Cdip := 1;
  if Disp = 0 then
    Disp := 1;
end;

procedure TRei40_12.Button2Click(Sender: TObject);
begin
  //  化妆显示(2)的指定
  Cdip := 1;
  if Disp = 0 then
    Disp := 2;
end;

procedure TRei40_12.Button3Click(Sender: TObject);
begin
  //  化妆显示(3)的指定
  Cdip := 1;
  if Disp = 0 then
    Disp := 3;
end;

procedure TRei40_12.Button4Click(Sender: TObject);
begin
  //  化妆显示(4)的指定
  Cdip := 1;
  if Disp = 0 then
    Disp := 4;
end;

procedure TRei40_12.Button5Click(Sender: TObject);
begin
  //  画面去除与初始设定
  FmCls(ClBlack);
  Disp := 0;
  Cdip := 0;
end;

procedure TRei40_12.ChrDi(Xsiz, Ysiz: Byte; Dpon: Word; X1, Y1: Integer;
  Bmap: TBitmap);
var
  //  定义局部变量
  CDX, CDY: Byte;
begin
  //  将指定的角色绘制至指定点阵图上（重叠显示适用）
  for CDY := 0 to (Ysiz - 1) do
    for CDX := 0 to (Xsiz - 1) do
    begin
      if (X1 + CDX * 16 >= 0) and (X1 + CDX * 16 <= DYoko + 16) and
        (Y1 + CDY * 16 >= 0) and (Y1 + CDY * 16 <= DTate + 16) then
          PatDi(SpDat[Dpon], X1 + CDX * 16, Y1 + CDY * 16, Bmap);
      Dpon := Dpon + 1;
    end;
end;

procedure TRei40_12.PatDi(Pnum: Byte; X1, Y1: Integer; Bmap: TBitmap);
begin
  //  将指定的图案绘制至指定点阵图的指定位置上（重叠显示适用）
  PX := (Pnum and $F) * 16;
  PY := Pnum and $F0;
  Rect_L := Rect(PX, PY, PX + 16, PY + 16);
  Rect_D := Rect(X1, Y1, X1 + 16, Y1 + 16);
  if Pnum <> 0 then
    if Pnum >= PtFull then
    begin
      Bmap.Canvas.CopyMode := cmSrcPaint;
      Bmap.Canvas.CopyRect(Rect_D, Xpat_Bmap.Canvas, Rect_L);
      Bmap.Canvas.CopyMode := cmSrcAnd;
      Bmap.Canvas.CopyRect(Rect_D, Load_Bmap.Canvas, Rect_L);
    end
    else begin
      Bmap.Canvas.CopyMode := cmSrcCopy;
      Bmap.Canvas.CopyRect(Rect_D, Load_Bmap.Canvas, Rect_L);
    end;
end;

procedure TRei40_12.ReDraw(Sender: TObject);
begin
  //  Form画面的重绘
  Rei40_12.Canvas.Draw(0, 0, Make_Bmap);
end;

procedure TRei40_12.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将载入用、去除用、粉刷用、显示画面用、绘制用的点阵图释放掉
  Load_Bmap.Free;
  Xpat_Bmap.Free;
  Bpat_Bmap.Free;
  Back_Bmap.Free;
  Make_Bmap.Free;
end;

end.