Delphi 经典游戏程序设计40例 的学习 例13 各种卸妆效果的处理
作者：互联网
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的程序上改了一下。
标签：13,12,end,16,19,Delphi,Canvas,40,MakeBmap 来源： https://www.cnblogs.com/D7mir/p/16479575.html