Delphi 经典游戏程序设计40例 的学习 例12 各种化妆显示画面特效

 

unit R12;

interface

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

type
  TRei12 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    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 declarations }
  end;

const
  Yoko = 37;         //横向图案数
  Tate = 27;         // 纵向图案数
  DYoko = Yoko * 16;  // 横向点数 16最小单位？
  Dtate = Tate * 16;
  PtFull = 16;     // 全面显示的（不要重叠显示）的图案数

  MaxSp = 2;      // 本次使用的复合图案总数


var
  Rei12: TRei12;
  LoadBmap,XpatBmap,BpatBmap,BackBmap,MakeBmap : TBitmap;
  // 载入，去除模板，笔刷图案，显示，绘制 点阵图
  // PX ,PY 在PatDi中用， 可以为局部变量。
  //在 TIMER中用，需要
  // p没有用用到，可以去掉

  //P,PX,PY,
  DX,DY,Cdip : Byte;


  // cdip   被赋值 0，1，但是并没有出现判断的地方，应该可以去掉
  // 测试可以去掉


   // 用来识别按钮，进入相应的TIMEER,的CASE 功能区  ，255为没有点击按钮用
  Disp:Byte = 255;

  //SC计算零件贴图指针数组的初始设置 ，应该可以放到 FORMCREAT 中
  // n,m TIMEER中做 循环计数器使用，需要退出TMINER 后仍有效，等待下次进入TIMER
  // 所以需要全局变量？
  // 但是 n,在11，13中用，而m 在12，14中用，似乎可以去掉一个。只用一个？
  //测试     确实可以只要一个
  n,{m,}Sc : Word;

  // 需要操作矩形块
  RectL,RectM,RectD: 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 TRei12.FormCreate(Sender: TObject);
var
  X,Y :Byte;       // 循环用，X,Y 坐标值   绘制BackBmap
  Pn: Word;      //循环用，MAXSP 值，复合图案数组的下标值

begin
  Rei12.Canvas.CopyMode := cmSrcCopy;
  //载入图案
  LoadBmap := TBitmap.Create;
  LoadBmap.LoadFromFile(GetCurrentDir + '\Pat_Sample.bmp');
  //存储去除用点阵图
  XpatBmap := TBitmap.Create;
  XpatBmap.Width := 256;
  XpatBmap.Height := 256;
  RectL := Rect(0,0,256,256);
  XpatBmap.Canvas.CopyMode := cmSrcCopy;
  XpatBmap.Canvas.CopyRect(RectL,LoadBmap.Canvas,RectL);
  XpatBmap.Canvas.Brush.Color := clBlack;
  XpatBmap.Canvas.BrushCopy(RectL,LoadBmap,RectL,clWhite);
  XpatBmap.Canvas.CopyMode := cmMergePaint;
  XpatBmap.Canvas.CopyRect(RectL,LoadBmap.Canvas,RectL);
  //笔刷点阵图
  BpatBmap := TBitmap.Create;
  BpatBmap.Width := 8;
  BpatBmap.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;
  //存储绘制用点阵图
  MakeBmap := TBitmap.Create;
  MakeBmap.Width := DYoko;
  MakeBmap.Height := Dtate;


   //将欲显示的图案绘制到BackBmap
  BackBmap := TBitmap.Create;
  BackBmap.Width := DYoko + 32;
  BackBmap.Height := Dtate + 32;

  for Y := 0 to (Tate -1 )  do
    for X := 0 to (Yoko -1 ) do

    //全部填充 7 图案，该图案是砖块。
    PatDi(7,X * 16 + 16,Y * 16 + 16,BackBmap);
    // 画图案0
  ChrDi(SpSiz[0],SpSiz[1],SpPon[0],298,88,BackBmap);
     // 画图案1
  ChrDi(SpSiz[2],SpSiz[3],SpPon[1],66,96,BackBmap);

end;

  //功能，以指定的颜色将绘制点阵图与画面去除
procedure Trei12.FmCls(Col:TColor);
begin
  RectD :=  Rect(0,0,DYoko,Dtate) ;
  MakeBmap.Canvas.Brush.Color := Col;
  MakeBmap.Canvas.FillRect(RectD);
  Rei12.Canvas.Draw(0,0,MakeBmap);


end;


procedure Trei12.DipDt(X1,Y1:Word;Dt:Byte );
// 从显示画面将指定大小的正方形复制到绘制点阵图
begin
  RectM := Rect(X1 + 16, Y1 + 16,X1 + 16 + Dt,Y1 + 16 + Dt);
  RectD := Rect(X1,Y1,X1 + Dt,Y1 + Dt);
  MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectM);

end;


 //将指定的角色（复合图案）绘制至指定点阵图上
procedure Trei12.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 Trei12.PatDi(Pnum:Byte;X1,Y1:Integer;Bmap:TBitmap);
var
  PX,PY : Byte;
begin
 PX := (Pnum and $F) * 16;    //PX ，PY可以为过程内局部变量码？
 PY := Pnum and $F0;
 RectL := Rect(PX,PY,PX + 16,PY + 16);
 RectD := Rect(X1,Y1,X1 + 16,Y1 + 16);
 if Pnum <> 0 then
 if  Pnum >= PtFull then

 begin
   Bmap.Canvas.CopyMode := cmSrcPaint;
   Bmap.Canvas.CopyRect(RectD,XpatBmap.Canvas,RectL);
   Bmap.Canvas.CopyMode := cmSrcAnd;
   Bmap.Canvas.CopyRect(RectD,LoadBmap.Canvas,RectL);

 end
 else begin
   Bmap.Canvas.CopyMode := cmSrcCopy;
   Bmap.Canvas.CopyRect(RectD,LoadBmap.Canvas,RectL);
 end;

end;

procedure TRei12.tmr1Timer(Sender: TObject);
var

  // 定义局部变量
  X,Y :Byte;    // x,y ,坐标循环需要
  Pn :Word;    //   内部循环计数，
begin

   //化妆显示与画面去除
  case Disp of
     // 以黑色去除画面并进行初始设置
     // 很有技巧啊，TIMEER是interval 间隔进入。点击第一次进入1..4 初始化一次，
     //再进入 个功能执行完，执行期间用DISP 锁定进入特定11，12，13，14
     // ，
   1..4: begin
     FmCls(clBlack);
     Disp := Disp + 10;
     n := 0 ;
     //m := 0;
     DX := 0 ;
     DY := 0 ;

   end;
           // 化妆显示1的处理   ,x,y,x,y 转圈显示
   11: begin
     MakeBmap.Canvas.CopyMode := cmSrcCopy;
     X := n;
     Y := n;

     if  n < Yoko then
     //Yoko 的像素为16，而DipDt 的显示块像素为8 ,所以需要将止数乘2
     // -2 是因为n 从 0 开始，需要-1,即是(YOKO-1)*2  ???好像不对？？？
     //或者是- 1 计数减1  -1 位置减1
     //都是自己猜的。   也许对照着图片示意就要理解的快点。
     //首先要理解 循环的 要点，是大于后终止循环吗


       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
       //这里递减循环，为什么要+1?
        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;
       Rei12.Canvas.Draw(0,0,MakeBmap);


   end;
          //倾斜麻点显示效果
   12: begin
      MakeBmap.Canvas.CopyMode := cmSrcCopy;
      for Pn := 0 to (Yoko - 1) do

      begin
        //这里为什么要取余？ 取余是为了避免越界
         //还有一个累加？  累加就是变化
         //DX,DY需要留到下个IMTER次用，所以的全局
        DX := (DX + 36) mod Yoko;
        DY := (DY + 26) mod Tate;
        DipDt(DX * 16,DY * 16 ,16);

      end;


      n := n + 1;
      if n = Tate then
       Disp := 0 ;
       Rei12.Canvas.Draw(0,0,MakeBmap);
   end;

   13 : begin
     if n < 16 then
     begin
       //笔刷图案也在载入图案中
       BpatBmap.Canvas.CopyMode := cmNotSrcCopy;
                // 40 = 32 + 8 ，72 = 64 + 8

       RectL := Rect(n * 8 + 32,64,n * 8 + 40,72);
       RectD := Rect(0,0,8,8);
       BpatBmap.Canvas.CopyRect(RectD,LoadBmap.Canvas ,RectL);

       MakeBmap.Canvas.Brush.Bitmap := BpatBmap;
       // CMMERGERCOPY 将原图像和笔刷图案以AND 方式合并并传送出去
       MakeBmap.Canvas.CopyMode := cmMergeCopy;
       RectM := Rect(16,16,DYoko + 16,Dtate + 16);
       RectD := Rect(0,0,DYoko,Dtate);

       //改变的笔刷，还是COPYRECT，
       MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectM);
       //释放笔刷图案
       MakeBmap.Canvas.Brush.Bitmap := nil;
       n := n + 1;
     end
     else
       Disp := 0 ;
     Rei12.Canvas.Draw(0,0,MakeBmap);

     end;

  14 : begin
     MakeBmap .Canvas.CopyMode := cmSrcCopy;
     n := n + 1;
       // PN  Y轴上，分2 点  那么可以改 4点？
     for Pn := 0 to (Tate * 2 -1 ) do
       begin
         // 整体移动16
       {
       RectM := Rect(DYoko - m * 8 + 16,Pn * 4 + 16,DYoko + 16,Pn * 4 + 18);
       RectD := Rect(0,Pn * 4,m * 8 ,Pn * 4 + 2);
       MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectM);

       RectM := Rect(16,Pn * 4 + 18,m * 8 + 16,Pn * 4 + 20);
       RectD := Rect(DYoko - m * 8,Pn * 4 + 2,DYoko,Pn * 4 + 4);
       MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectM);
       }

       RectM := Rect(DYoko - n * 8 + 16,Pn * 8 + 16,DYoko + 16,Pn * 8 + 20);
       RectD := Rect(0,Pn * 8,n * 8 ,Pn * 8 + 4);
       MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectM);

       RectM := Rect(16,Pn * 8 + 20,n * 8 + 16,Pn * 8 + 24);
       RectD := Rect(DYoko - n* 8,Pn * 8 + 4,DYoko,Pn * 8 + 8);
       MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectM);


       end;
     // M  移动8 点。 X  轴上
       if n = Yoko * 2 then
       Disp := 0;
       Rei12.Canvas.Draw(0,0,MakeBmap);

     end;
  255 :
    begin
    FmCls(clBlack);
    Disp := 0 ;
     //Cdip := 0 ;

    end;

   end;
end;

procedure TRei12.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  LoadBmap.Free;
  XpatBmap.Free;
  BpatBmap.Free;
  BackBmap.Free;
  MakeBmap.Free;
end;

procedure TRei12.Button1Click(Sender: TObject);
begin
  //Cdip := 1;
  if Disp = 0 then
    Disp := 1;
end;

procedure TRei12.Button2Click(Sender: TObject);
begin
  //Cdip := 1;
  if Disp = 0 then
    Disp := 2;
end;

procedure TRei12.Button3Click(Sender: TObject);
begin
  //Cdip  := 1;
  if Disp = 0 then
  Disp := 3;
end;

procedure TRei12.Button4Click(Sender: TObject);
begin
  //Cdip := 1;
  if Disp = 0 then
  Disp := 4;

end;

procedure TRei12.Button5Click(Sender: TObject);
begin
  FmCls(clBlack);
  Disp := 0 ;
  //Cdip := 0 ;
end;
    // form画面重新绘制， 没有redraw ?
procedure TRei12.FormPaint(Sender: TObject);
begin
  Rei12.Canvas.Draw(0,0,MakeBmap);
end;

end.

 

 

很久没有学习了，

又开始捡起来学习了，

坚持吧。