unit R13; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type TRei13 = 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 FmDip; //procedure DipDt(X1,Y1:Word;Dt:Byte ); // 在绘制点阵图上依指定的大小及颜色来绘制四方形 procedure ClsBox(X1,Y1,X2,Y2:Word;Col : TColor ); //将指定的角色(复合图案)绘制至指定点阵图上 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 Rei13: TRei13; LoadBmap,XpatBmap,BpatBmap,BackBmap,MakeBmap : TBitmap; // 载入,去除模板,笔刷图案,显示,绘制 点阵图 // PX ,PY 在PatDi中用, 可以为局部变量。 //在 TIMER中用,需要 // p没有用用到,可以去掉 P,PX,PY,nX,nY,Lp,Cdip : Byte; // cdip 被赋值 0,1,但是并没有出现判断的地方,应该可以去掉 // 测试可以去掉 // 原来12程序里面的cdip , 其实是在13程序中被用到的, // 用来识别按钮,进入相应的TIMEER,的CASE 功能区 ,255为没有点击按钮用 Cls:Byte = 255; //SC计算零件贴图指针数组的初始设置 ,应该可以放到 FORMCREAT 中 // n,m TIMEER中做 循环计数器使用,需要退出TMINER 后仍有效,等待下次进入TIMER // 所以需要全局变量? // 但是 n,在11,13中用,而m 在12,14中用,似乎可以去掉一个。只用一个? //测试 确实可以只要一个 m,{m,}Sc : Word; // 需要操作矩形块 RectL,RectM,RectS,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 ) ; } // 复合图案数组 SpSiz: array[0..(MaxSp * 2 - 1)] of Byte = (2,2, 31,21); SpPon: array[0..(MaxSp - 1)] of Word; SpDat: array[0..(4 + 31 * 21 - 1)] of Byte = ( 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 TRei13.FormCreate(Sender: TObject); var X,Y :Byte; // 循环用,X,Y 坐标值 绘制BackBmap Pn: Word; //循环用,MAXSP 值,复合图案数组的下标值 begin Rei13.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 图案,该图案是砖块。 // 填充15 该图案是草地 PatDi(15,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 TRei13.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 TRei13.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 Trei13.FmDip; begin RectM := Rect(16,16,DYoko + 16,Dtate + 16); RectD := Rect(0,0,DYoko ,Dtate ); MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectM); Rei13.Canvas.Draw(0,0,MakeBmap); end; // 在绘制点阵图上依指定的大小及颜色来绘制四方形 procedure trei13.ClsBox(X1,Y1,X2,Y2:Word;Col : TColor); begin RectD := Rect(X1,Y1,X2,Y2); MakeBmap.Canvas.Brush.Color := Col; MakeBmap.Canvas.FillRect(RectD); end; //将指定的角色(复合图案)绘制至指定点阵图上 procedure TRei13.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 TRei13.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 TRei13.tmr1Timer(Sender: TObject); var // 定义局部变量 X,Y ,Gd:Byte; // x,y ,坐标循环需要 n:Word; // 内部循环计数, begin //化妆显示与画面去除 case Cls of // 以黑色去除画面并进行初始设置 // 很有技巧啊,TIMEER是interval 间隔进入。点击第一次进入1..4 初始化一次, //再进入 个功能执行完,执行期间用DISP 锁定进入特定11,12,13,14 // , nX,nY ,需要 全局使用?变量M 可以用局部变量,M测试得全局变量 1..4: begin FmDip; Cls := Cls + 10; m := 0 ; nX := 0 ; nY := 0 ; end; // 显示1的处理 ,x,y,x,y 转圈消除 , M 用来计数消除了一圈,也用来定位XY 11: begin MakeBmap.Canvas.CopyMode := cmSrcCopy; X := m; Y := m; if m < Yoko then for X := m to (Yoko * 2 - 2 - m ) do ClsBox(X * 8,Y * 8,X * 8 + 8,Y * 8 + 8,clBlack); if m < Tate then for Y := m to ( Tate * 2 - 2 - m) do ClsBox(X * 8 ,Y * 8 ,X * 8 + 8,Y * 8 + 8,clBlack); if m < Yoko then for X := (Yoko * 2 - 1 - m) downto (m +1 ) do ClsBox(X * 8 ,Y * 8 ,X * 8 + 8,Y * 8 + 8,clBlack); if m < Tate then for Y := (Tate * 2 - 1 -m) downto (m +1 ) do ClsBox(X * 8 ,Y * 8 ,X * 8 + 8,Y * 8 + 8,clBlack); m := m + 1; //锁定操作 if (m >= Yoko ) or (m >= Tate ) then Cls := 0; Rei13.Canvas.Draw(0,0,MakeBmap); end; //倾斜麻点消除效果 ,算了这个效果有点复杂,更多的讲的是技巧,不研究了 12: begin X := nX; Y := nY; if m < 16 then // m 用来计数,灰度颜色0-15 Lp := m else Lp := 15; for Gd := Lp downto 0 do begin BpatBmap.Canvas.CopyMode := cmSrcCopy; RectL := Rect(Gd * 8 + 32,64,Gd * 8 + 40,72); RectD := Rect(0,0,8,8); BpatBmap.Canvas.CopyRect(RectD,LoadBmap.Canvas,RectL); MakeBmap.Canvas.Brush.Bitmap := BpatBmap; //设置刷子 MakeBmap.Canvas.CopyMode := cmMergeCopy; for n := 0 to (Yoko - 1) do begin X := (X + 36) mod Yoko ; Y := (Y + 26) mod Tate ; RectD := Rect(X * 16,Y * 16,X * 16 + 16,Y * 16 + 16); MakeBmap.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectD); end; MakeBmap.Canvas.Brush.Bitmap := nil; if Gd = 15 then begin nX := X; nY := Y; end; end; m := m + 1; if m = Tate +15 then //这里为什么要加15? 为什么要加到这么大 27 + 15 Cls := 0 ; Rei13.Canvas.Draw(0,0,MakeBmap); end; 13 : begin if m < 16 then begin //笔刷图案也在载入图案中 //BpatBmap.Canvas.CopyMode := cmNotSrcCopy; BpatBmap.Canvas.CopyMode := cmSrcCopy; // 40 = 32 + 8 ,72 = 64 + 8 RectL := Rect(m * 8 + 32,64,m * 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; m := m + 1; end else Cls := 0 ; Rei13.Canvas.Draw(0,0,MakeBmap); end; 14 : begin MakeBmap .Canvas.CopyMode := cmSrcCopy; // PN Y轴上,分2 点 那么可以改 4点? for n := 0 to (Tate * 4 -1 ) do begin RectS := Rect(m * 8,n * 4,DYoko - 8 ,n * 4 + 2); RectD := Rect(m * 8 + 8,n * 4,DYoko,n * 4 + 2); MakeBmap.Canvas.CopyRect(RectD,makeBmap.Canvas,RectS); ClsBox(m * 8,n * 4,m * 8 + 8,n * 4 + 2,clBlack); RectS := Rect(8,n * 4 + 2,DYoko - m * 8,n * 4 + 4); RectD := Rect(0,n * 4 + 2,DYoko - m * 8-8 ,n * 4 + 4); MakeBmap.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectS); ClsBox(DYoko - m * 8 - 8 ,n * 4 + 2,DYoko - m * 8,n * 4 + 4,clBlack); end; // M 移动8 点。 X 轴上 m := m + 1; if m = Yoko * 2 then Cls := 0; Rei13.Canvas.Draw(0,0,MakeBmap); end; 255 : begin FmDip; Cls := 0 ; Cdip := 1 ; end; end; end; procedure TRei13.FormClose(Sender: TObject; var Action: TCloseAction); begin LoadBmap.Free; XpatBmap.Free; BpatBmap.Free; BackBmap.Free; MakeBmap.Free; end; procedure TRei13.Button1Click(Sender: TObject); begin //Cdip := 1; if Cls = 0 then Cls := 1; end; procedure TRei13.Button2Click(Sender: TObject); begin //Cdip := 1; if Cls = 0 then Cls := 2; end; procedure TRei13.Button3Click(Sender: TObject); begin //Cdip := 1; if Cls = 0 then Cls := 3; end; procedure TRei13.Button4Click(Sender: TObject); begin //Cdip := 1; if cls = 0 then Cls := 4; end; procedure TRei13.Button5Click(Sender: TObject); begin // FmCls(clBlack); FmDip; Cls := 0 ; //Cdip := 0 ; end; // form画面重新绘制, 没有redraw ? procedure TRei13.FormPaint(Sender: TObject); begin Rei13.Canvas.Draw(0,0,MakeBmap); end; end.
和例12是相反的功能,结构上一样,所以就在例12的程序上改了一下。