标签：Canvas 16 19 32 Delphi MakeBmap 40 可大可小 procedure
unit rei09;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TR09 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
tmr1: TTimer;
procedure FormCreate(Sender: TObject);
procedure tmr1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure MakeSpot;
procedure SbanDi(Sary:array of Byte; 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; //592
DTate = Tate * 16; //432
PtFull = 16;
var
R09: TR09;
LoadBmap,XpatBmap,BackBmap,SpotBmap,MakeBmap : TBitmap;
PX,PY :Byte;
n,SpotR: Word;
SpotX,SpotY : Integer;
RectL,RectB,RectS,RectM,RectD : TRect;
MoveS : Byte =0;
Xadd:ShortInt=2;
Yadd:ShortInt=2;
Radd : ShortInt = 0;
Spr00 : array[0..(31*17+1)] of Byte =(
31, 17,
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,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 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, 0, 0,19,19,19,19,19,19, 0, 0, 0,19,19,19,19,19, 0,
0,19,19,19,19,19,19,19,
19, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19,
0,19, 0, 0,19, 0, 0,19,
19, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19,
0, 0, 0, 0,19, 0, 0, 0,
19, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19,
0, 0, 0, 0,19, 0, 0, 0,
19, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19,
0, 0, 0, 0,19, 0, 0, 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,19, 0, 0, 0,
0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19,
0, 0, 0, 0,19, 0, 0, 0,
0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19,
0, 0, 0, 0,19, 0, 0, 0,
0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19,
0, 0, 0, 0,19, 0, 0, 0,
19, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19,
0, 0, 0, 0,19, 0, 0, 0,
0,19,19,19,19,19, 0, 0,19,19,19, 0, 0, 0, 0, 0, 0,19,19,19,19,19, 0,
0, 0, 0,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, 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 TR09.FormCreate(Sender: TObject);
var
X,Y :Byte;
begin
//装载图案
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);
//背景点阵图
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
PatDi(15,X*16+16,Y*16 +16,BackBmap);
// 绘制SPR00 图案
SbanDi( Spr00,66,96,BackBmap);
//制作用点阵图，涂黑
MakeBmap := TBitmap.Create;
MakeBmap.Width := BackBmap.Width;
MakeBmap.Height := BackBmap.Height;
MakeBmap.Canvas.Brush.Color := clBlack;
RectM := Rect(0,0,MakeBmap.Width,MakeBmap.Height);
MakeBmap.Canvas.FillRect(RectM);
//圆形模板 点阵图
SpotBmap := TBitmap.Create;
SpotBmap.Width := DYoko +32;
// 神奇的地方，此点阵图 高度 为Dyoko 宽度 ,否则最大圆 放 不下
SpotBmap.Height := DYoko +32;
SpotR := 16 *6;
// 画圆
MakeSpot;
//图形初始坐标
SpotX := DYoko div 2;
SpotY := DTate div 2;
end;
procedure TR09.MakeSpot;
begin //在圆形模板点阵图上 制作圆形
//涂黑
SpotBmap.Canvas.Brush.Color := clBlack;
RectS := Rect(0,0,SpotR *2 + 32, SpotR *2 +32);
SpotBmap.Canvas.FillRect(RectS);
//画圆
SpotBmap.Canvas.Pen.Color := clWhite;
SpotBmap.Canvas.Brush.Color := clWhite;
SpotBmap.Canvas.Ellipse(16,16,SpotR *2 +16,SpotR * 2 +16);
end;
procedure TR09.SbanDi(Sary:array of Byte; X1,Y1:Integer;Bmap:TBitmap);
var
X,Y : Byte;
begin
n := 2;
for Y :=0 to (Sary[1]-1) do
for X := 0 to (Sary[0] -1 ) do
begin
if (X1 + X *16 >=0) and ( X1 + X *16<= DYoko + 16) and
(Y1 + Y*16 >= 0) and (Y1 + Y*16 <= DTate +16) then
PatDi(Sary[n],X1 + X *16,Y1 + Y*16,Bmap);
n := n+ 1;
end;
end;
procedure TR09.PatDi(Pnum:Byte;X1,Y1:Integer;Bmap:TBitmap);
begin
PX := (Pnum and $F ) * 16;
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 TR09.tmr1Timer(Sender: TObject);
var
Spx1,Spy1,Spx2,Spy2,Sbx1,Sbx2,Sby1,Sby2 :Integer;
begin
//移动，坐标 越界判断
if MoveS =1 then
begin
SpotX := SpotX + Xadd;
SpotY := SpotY + Yadd;
if SpotX <= 0 then
begin
SpotX :=0 ;
Xadd := - Xadd;
end
else if SpotX >= DYoko then
begin
SpotX :=DYoko;
Xadd := - Xadd;
end;
if SpotY <=0 then
begin
SpotY :=0 ;
Yadd := - Yadd ;
end
else if SpotY >= Dtate then
begin
SpotY := DTate;
Yadd := - Yadd ;
end;
end;
//改变半径
if Radd <> 0 then
begin
SpotR := SpotR + Radd;
if (SpotR >=1 ) and (SpotR <= (SpotBmap.Width -32)div 2) then
MakeSpot
else begin
SpotR := SpotR - Radd; //这里为什么要计算一下？ 最小和最大恢复一下？ 然后停止半径改变？
Radd :=0;
end;
end;
//圆形模板内的背景复制到绘制点阵图
Spx1 := SpotX - SpotR ;
Spy1 := SpotY - SpotR ;
Spx2 := SpotX + SpotR ;
Spy2 := SpotY + SpotR ;
//越界裁剪
if Spx1 <0 then
Spx1 := 0 ;
if Spy1 < 0 then
Spy1 :=0;
// MakeBmap.Width = BackBmap.Width = DYoko + 32
if Spx2 >(MakeBmap.Width -32) then
Spx2 := MakeBmap.Width -32;
if Spy2 > (MakeBmap.Height - 32 ) then
Spy2 := MakeBmap.Height-32 ;
RectB := Rect(Spx1 + 16,Spy1 + 16,Spx2 + 16,Spy2 + 16);
RectM := Rect(Spx1 + 16,Spy1 + 16,Spx2 + 16,Spy2 + 16);
MakeBmap.Canvas.CopyMode := cmSrcCopy;
MakeBmap.Canvas.CopyRect(RectM,BackBmap.Canvas ,RectB );
//将圆形模板图样复制 到绘制点阵图
Sbx1 := 0 ;
Sby1 := 0 ;
Sbx2 := SpotR *2 + 32;
Sby2 := SpotR *2 + 32;
//圆形越界只用裁剪部分 ，相对论？ 裁剪的 圆形模板
if (SpotX - SpotR ) <0 then
Sbx1 := -(SpotX - SpotR ) ;
if (SpotY - SpotR )< 0 then
Sby1 := -(SpotY - SpotR );
if (SpotX + SpotR )> (MakeBmap.Width -32) then
Sbx2 := Sbx2 - (SpotX + SpotR -(MakeBmap.Width -32));
if (SpotY + SpotR ) > (MakeBmap.Height -32) then
Sby2 := Sby2 - (SpotY + SpotR - (MakeBmap.Height -32 ));
MakeBmap.Canvas.CopyMode := cmSrcAnd;
RectS := Rect(Sbx1 ,Sby1,Sbx2,Sby2 );
RectM := Rect(Spx1 ,Spy1,Spx2 + 32,Spy2 + 32);
MakeBmap.Canvas.CopyRect(RectM,SpotBmap.Canvas,RectS );
R09.Canvas.CopyMode := cmSrcCopy;
RectM := Rect(16,16, DYoko + 16,DTate + 16) ;
RectD := Rect(0,0,DYoko,DTate);
R09.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectM ) ;
end;
procedure TR09.Button1Click(Sender: TObject);
begin
Radd := 1;
end;
procedure TR09.Button2Click(Sender: TObject);
begin
Radd := -1;
end;
procedure TR09.Button3Click(Sender: TObject);
begin
Radd := 0 ;
end;
procedure TR09.Button4Click(Sender: TObject);
begin
MoveS := MoveS xor 1;
end;
procedure TR09.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LoadBmap.Free;
XpatBmap.Free;
BackBmap.Free;
SpotBmap.Free;
MakeBmap.Free;
end;
end.
patdi ,sbandi 贴图
makespot 画圆
在 time1里面 执行所有的动作。
圆形模板要裁剪
会有一个越界的现象，这个时候需要对 圆形模板进行裁剪
可以拿2张纸来进行 理解，
想象力不行，不能在脑袋里抽象 的想象。
基本是 对着书敲代码的，并没有自己编写。
开始圆形模板要设置成
标签：Canvas,16,19,32,Delphi,MakeBmap,40,可大可小,procedure 来源： https://www.cnblogs.com/D7mir/p/15863014.html
本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享； 2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关； 3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关； 4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除； 5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。