D
delphifool
Unregistered / Unconfirmed
GUEST, unregistred user!
本人由于长时间在外找工作,毕业设计一直没做,快交成果了,请大家来帮忙,谢谢各位了!我把部分代码给大家看看,请大家帮忙调试下,并将最后可以运行的代码交给我。本人QQ264088812,我要做的是个三维物体,我知道不会做,如果有人有现成的做好的,我想能否让兄弟我用下,兄弟我终身感激。
下面的部分代码是我从一本书找到的,是个三维动画演示,请大家帮忙调试下,调试完了请跟我说下,谢谢各位大虾了!
定义常量
设置动画演示的状态
const
MsgColorForeGroud=CIAqua;
MSGColorBACKGroud=CIGray;
SpeedAnim=25; //豪秒单位
maxpoints=2047; //动画显示的点数
inter_frame=300; //在再次开始变形前的时间间隔
morph_sp=100; //变形的时间
steps=1+morph_sp; //变形的时间
zo=1.8; //透视投影
viewdist=zo*100;
cycle_pal=4; //“调色板”循环的速度
pal_colours=236; //在调色板中循环颜色的实际数目
pal_coloursml=235;
sqr3maxpoint=11;
sqr3maxpointpl=sqr3maxpoint+1;
sqr3maxpoint3=12*12*12;
MsgSize=21;
maxframes=5; //最大侦数为6
定义flakestruc结构;
type
pflakestruc=^flakestruc;
flakestruc=record
x,y,z:Single;
dx,dy,dz:Single;
end;
数学函数
定义视图的投影方式、旋转方式等。
const
tablesize=1023;
tablesizepl=tablesize=1;
var
cosine:array[0..tablesize] of single;
sine:array[0..tablesize] of single;
{geometry}
rotyxz0_0,rotyxz0_1,rotyxz0_2,
rotyxz1_0,rotyxz1_1,rotyxz1_2,
rotyxz2_1,rotyxz2_2,rotyxz2_3:single;
procedure setup_tables;
var
lp1:integer;
n:Single;
begin
for lp1:=0 to tablesize do begin
n:=(2*pi*lp1/tablesizepl);
cosine[lp1]:=cos
;
sine[lp1]:=sin
;
end;
end;
{------------------------------------------}
procedure yxz_rotation(x,y,z:integer);{unrolled matrix multiply}
var t1,t2,t3,t4,t5,t6,m1,m2,m3:single;
begin
t1:=cosine[x];
t2:=cosine[y];
t3:=cosine[z];
t4:=sine[x];
t5:=sine[y];
t6:=sine[z];
m1:=(t2*t3);
m2:=(t4*t5);
m3:=(t2*t6);
rotyxz0_0:=m1-((m2*t6));
rotyxz0_1:=-((t1*t6));
rotyxz0_2:=((t3*t5))+((m3*t4));
rotyxz1_0:=m3+((t3*m2));
rotyxz1_1:=((t1*t3));
rotyxz1_2:=((t5*t6))-((m1*t4));
rotyxz2_1:=-((t1*t5));
rotyxz2_2:=t4;
rotyxz2_3:=((t1*t2));
end;
头文件
uses
{Borland}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,Buttons,Stdctrls,Extctrls,
{使用TDIBULtra类和TDIBType类}
DIBULtra,DIBType,
{RXTimer可以使计时更加精确}
TimerRX;
成员变量和成员函数
为TAbout窗口添加下面的成员变量和成员函数
type
TAbout=class(TForm)
procedure FormShow(Sender:TObject);
procedure FormCreate(Sender:TObject);
procedure FormClick(Sender:Tobject);
procedure FormPaint(Sender:Tobject);
procedure FormClose(Sender:Tobject;var Action:TCloseAction);
private
{Private declarations}
//Allocation of 294 kilo-octets for this array!
flakearray:array[0..maxframes,0..maxpoints] of flakestruc;
flakeCol:array[0..maxpoints] of byte;// 2 kilo for this one
{screen variables}
xmid,ymid:integer;
{animation control}
bigloop:integer;
framepause:integer;
frameloop:integer;
framenum:integer;
xrotspeed:integer;
yrotspeed:integer;
zrotspeed:integer;
xrotoff:integer;
yrotoff:integer;
zrotoff:integer;
xr,yr,zr:integer;
xo,yo:Single;
MsgCur:Integer;
MsgFrac:Integer;
MsgWidth:Integer;
MsgDpl:Integer;
ToRect:Trect;
DIBRect:TRect;
Move:TRxTimer;
DIB:TDIBUltra;
procedure Setup_graphics;
procedure compute_and_draw_DIB(frame,stepnum:integer;framechange,skip:boolean);
procedure Stabilize;
procedure Animation(Sender:Tobject);
public
{Public declarations}
end;
在【object inspector】的“events”标签页中,为窗口TAbout添加OnCreat消息函数,用来初始化设置窗口
begin
Move:=TRxTimer.Create(nil);
Move.Enabled:=False;
DIB:=TDIBUltra.Create(ClientWidth,ClientHeight-30,DUpf8,@PaletteToAnimate8Bits);
ToRect:=Rect(0,30,DIB.Width,DIB.Height+30);
DIBRect:=Rect(0,0,DIB.Width,DIB.Height);
xmid:=DIB.Width div 2;
ymid:=DIB.Height div 2;
MsgDpl:=3;
MsgCur:=1;//Premier message
DIB.Canvas.Font.Name:=MsgFonte;
DIB.Canvas.Font.Height:=-MsgSize;
DIB.BrushColor:=CLBlack;
MsgFrac:=-DIB.Width;
MsgWidth:=DIB.Canvas.TextWidth(AboutMsg[MsgCur]);
setup_tables; //初始化数学计算值
setup_graphics; //初始化3D物体
Stabilize; //初始化动画的值
end;
在【object inspector】的“events”标签页中,为窗口TABOUT添加onshow消息函数,用来初始化动画效果。
procedure TAbout.FormShow(Sender:Tobject);
begin
//MAJ du RXTimer
k we are Ready for the animation
Move.Interval:=SpeedAnim;
Move.Enabled:=True;
Move.OnTimer:=Animation;
End;
在【object inspector】的“events”标签页中,为窗口TAbout添加onpaint消息函数,用来绘制动画图形。
procedure TAbout.FormPaint(Sender:Tobject);
var n:integer;
s:String;
begin
s:='DRYSIM 2.0.2.0';
canvas.Font.Name:=Times;
canvas.Font.Height:=26;
canvas.Brush.Style:=bsClear;
n:=(Width-Canvas.TextWidth(s)) div 2;
Canvas.Font.Color:=ClRed;
Canvas.TextOut(n+1,4,s);
Canvas.Font.Color:=ClWhite;
Canvas.TextOut(n,3,s);
//绘制图形
Canvas.CopyRect(ToRect,DIB.Canvas,DIBRect);
end;
在【object inspector】的“events”标签页中,为窗口TAbout添加onclick消息函数,用来关闭TAbout窗口。
procedure TAbout.FormClick(Sender:Tobject);
begin
ModalResult:=mrok;//SElf.Free调用FormClose.Action:=caFree
end;
在【object inspector】的“events”标签页中,为窗口TAbout添加onclose消息函数,用来释放内存。
procedure TAbout.FormClose(Sender:Tobject;var Action:TCloseAction);
begin
Move.Free;
DIB.Free;
Action:=caFree;
end;
成员函数的实现
下面介绍TABout各成员函数的实现
//该函数计算DIB的尺寸,并绘制DIB图形
procedure TAbout.compute_and_draw_DIB(frame,stepnum:integer;framechange,skip:boolean);
var x1,y1,lp1:word;
xt,yt,zt:Single;
tx,ty,tz:Single;
begin
//DIB消息
Inc(MsgFrac,MsgDpl);
If(MsgFrac>=MsgWidth)Then
Begin//处理DIB消息
Inc(MsgCur);If(MsgCur>AboutMessages) Then MegCur:=1;
MsgFrac:=-DIB.Width;
MsgWidth:=DIB.Canvas.TextWidth(AboutMsg[MsgCur]);
End;
//设置DIB值
DIB.Canvas.Font.Color:=MsgColorForeGround;
DIB.Canvas.Brush.Style:=bsSolid;
DIB.Canvas.TextOut(-MsgFrac,05,AboutMsg[msgCur]);
//重新计算点的位置
for lpl:=0 to maxpoints do begin
with flakearray[frame,lpl] do begin
tx:=x+(dx*stepnum);
ty:=y+(dy*stepnum);
tz:=z+(dz*stepnum);
xt:=((rotyxz0_0*tx))+((rotyxz0_1*ty))+((rotyxz0_2*tz))+xo;
yt:=((rotyxz1_0*tx))+((rotyxz1_1*ty))+((rotyxz1_2*tz))+yo;
zt:=((rotyxz2_1*tx))+((rotyxz2_2*ty))+((rotyxz2_3*tz))+zo;
x1:=Round((xt*viewdist)/zt)+xmid;
y1:=Round((yt*viewdist)/zt)+ymid;
DIB.DirectPlot(x1,y1,flakeCol[lpl]);//col 10-246
end;
end;
//复制位图文件
Cancas.CopyRect(ToRect,DIB.Canvas,DIBRect);
end;
//该函数用于停止动画效果
procedure TAbout.Stabilize;
var lpl,lp2: integer;
f1,f2:integer;
begin
bigloop:=48;
xrotspeed:=0;
yrotspeed:=5;
zrotspeed:=0;
framepause:=0; //counter
frameloop:=0; //counter
framenum:=0; //counter
for lpl:=0 to maxframes do begin
f1:=lpl;
f2:=(lpl+1) mod (maxframes+1);
for lp2:=0 to maxpoints do begin
with flakearray[f1,lp2] do begin
dx:=(flakearray[f2,lp2].x-x)/steps;
dy:=(flakearray[f2,lp2].y-y)/steps;
dz:=(flakearray[f2,lp2].z-z)/steps;
end;
end;
end;
end;
//实现动画效果
procedure TAbout.Animation(Sender:TObject);
var
framechange:boolean;
Color
ointer;
begin
Inc(bigloop,1);
Bigloop:=Bigloop AND TableSize;
framechange:=false;
if framepause>=0 then inc(framepause)
else inc(frameloop);
if frameloop>=inter_frame then begin
framepause:=-1;
frameloop:=1;
end;
if frameloop>=morph_sp then begin
frameloop:=0;
framepause:=0;
inc(framenum);framechange:=true;
if framenum>maxframes then framenum:=0;
end;
xo:=0;
yo:=0;
xr:=(32+4*xrotoff+xrotspeed*bigloop) and tablesize;
yr:=(32+4*yrotoff+yrotspeed*bigloop) and tablesize;
zr:=(0+4*zrotoff+zrotspeed*bigloop) and tablesize;
yxz_rotation(xr,yr,zr);
//即使分辨率不是8位,也修改颜色
Color:=@flakeCol;
asm//Colors rolling, by Seb
MOV EDX,Color;
MOV ECX,(MaxPoints-1)
@DO:
MOVZX EAX, BYTE PTR[EDX+ECX]
ADD EAX,Cycle_Pal
CMP EAX,(10+pal_colours)
JB @COLOROK
MOV EAX,10
COLOROK:
MOV[EDX+ECX],AL
LOOP @DO
END;//Idem:Forn:=maxpoints-1 down to0 Begin inc(flakeCol[n],cycle_pal);
if (flakeCol[n]>(10+pal_colours)) Then flakeCol[n]:=10; End;
DIB.ClearAll;
compute_and_draw_DIB(framenum,frameloop,framechange,false);
//实现调色板。也可以使用下面的代码:
//If (Screen.Resolution=pf8Bit) Then Begin
SelectPalette(Canvas.Handle,DIB.Hpalette,false);
RealizePalette(Canvas.Handle);
//如果屏幕分辨率不是8位,调用RealizePalette返回0是不起作用的
end;
//装载图象
procedure TAbout.Setup_graphics;
var lp0,lp1,lp2:integer;
a,r:Single;
r1,r2,cp,sp:Single;
i,j,n,m:integer;
points_here:integer;
pp_seg,seg:integer;
phi,theta:Single;
paper:TDIBUltra;
begin//frames 0..5 generated in a seconde
for lpl:=0 to (MaxPoints-1) do flakecol[lpl]:=10+((lpl div 8) mod pal_colours);
flakeCol[MaxPoints]:=0;//最后的点是不可见的
Paper:=TDIBUltra.Create(450,30,DUpf1,Nilpalette);//图象为450*30
for lp0:=0 to 2 do begin
points_here:=0;
//得到字体的属性
Paper.Canvas.Font.Height:=Banner[lp0].FSize;
Paper.Canvas.Font.Style:=Banner[lp0].FStyle;
Paper.Canvas.Font.Name:=Banner[lp0].FName;
Paper.Canvas.Brush.Color:=CLBlack;
Paper.Canvas.Brush.Style:=bsSolid;
Paper.Canvas.Font.Color:=CLWhite;
Paper.Canvas.FillRect(Rect(0,0,Paper.Width,Paper.Height+1));
n:=Paper.Canvas.TextWidth(Banner[lp0].Text);
m:=Banner[lp0].FSize;
Paper.Canvas.TextOut(0,0,Banner[lp0].Text);
//Constantes
a:=2*pi/360;
r:=2*pi/(n*1);//1=>The formed circle is 100% the TextWidth
i:=lp0*2;
for lp1:=0 to (n-1) do begin // So you have to left some spaces at the end of your banner
for lp2:=0 to (m-1) do begin
if Boolean(Paper.Pixels[(n-lp1),lp2]) then begin
with flakearray[i,points_here] do begin
r1:=a*(lp2-m/2);
r2:=r*(n-lp1);
x:=cos(r2)*cos(r1);
z:=sin(r2)*cos(r1);
y:=sin(r1);
end;
inc(points_here);
end;
end;
end;//将剩余的点放置在小球上
{$IFDEF BANNER_CONCEPTION}
ShowMessage('Your message :'#13'"'+Banner[lp0].Text+'"'#13+'use'+IntToStr(points_here)+'pixel!'#13
+'You can still use'+IntToStr(maxpoints-points_here)+'pixels.');
{$ENDIF}
//place the last points(not used in this frame) under the last point(wich is black):
For n:=points_here To (Maxpoints-1) Do flakearray[i,n]:=flakearry[i,MaxPoints];
end;
Paper.Free;
//绘制立方体
phi:=1.2/(sqr3maxpoint);
for lp0:=0 to sqr3maxpoint Do
for lp1:=0 to sqr3maxpoint Do Begin m:=sqr3maxpointp1*(sqr3maxpointp1*lp0+lp1);
for lp2:=0 to sqr3maxpoint Do
with flakearray[5,m+lp2] Do Begin
x:=0.6-Phi*lp0;
z:=0.6-Phi*lp1;
y:=0.6-Phi*lp2;
End;
End;
//place the last points (not used in this frame) under the last point (wich is black):
For n:=sqr3maxpoint3 To (MaxPoints-1) Do flakearray[5,n]:=flakearray[5,MaxPoints];
//System.Move(flakearray[5,0],flakearray[5,sqr3maxpoint3],SizeOf(flakestruc)*(maxpoints-sqr3maxpoint3+1));
{//Old cube figure;by john
//frame 5-random cube
for lp1:=0 to maxpoints do begin
with flakearray[5,lp1] do begin
x:=(0.57*2)*random(256)/255-0.57;
z:=(0.57*2)*random(256)/255-0.57;
y:=(0.57*2)*random(256)/255-0.57;
c:=10+pal_colours*(sqrt(x*x+y*y+z*z)/sqrt(sqr(0.57)*3));
end;
end;
}
//frame 3- two spheres
//Seb Modif:I separate the spheres computing to have a nice rolling color effect
points_here:=0;
seg:=32;
pp_seg:=(maxpoints+1) div (seg*2);
n:=0;
for lp2:=0 to seg-1 do begin
theta:=2*pi*(n+0.5)/pp_seg;
m:=0;
for lp1:=0 to seg-1 do begin
phi:=pi*(m+0.5)/seg;
with flakearray[1,points_here] do begin
x:=cos(theta)*sin(phi);
y:=sin(theta)*sin(phi);
z:=cos(phi);
inc(points_here);
end;
m:=m+1;
end;
n:=n+1;
end;
m:=0;
for lp1:=0 to seg-1 do begin
phi:=pi*(m+0.5)/seg;
n:=0;
for lp2:=0 to pp_seg-1 do begin
theta:=2*pi*(n+0.5)/pp_seg;
with flakearray[1,points_here] do begin
x:=0.5*cos(theta)*sin(phi);
z:=0.5*sin(theta)*sin(phi);
y:=0.5*cos(phi);
inc(points_here);
end;
n:n+1;
end;
m:=m+1;
End;
//place the last points(not used in this frame) under the last point(wich is black):
For n
oints_here To (MaxPoints-1) Do flakearray[1,n]:=flakearray[1,Maxpoints];
//frame 5 - torus*2
r1:=0.75;
r2:=0.25;
n:=64;
m:=(maxpoints+1) div (n*2);
points_here:=0;
for i:=0 to n-1 do begin
cp:=cos(2*pi*i/n);
sp:=sin(2*pi*i/n);
for j:=0 to m-1 do begin
with flakearray[3,points_here] do begin
x:=cp*(r1+r2*cos(2*pi*j/m));
y:=sp*(r1+r2*cos(2*pi*j/m));
z:=r2*sin(2*pi*j/m);
inc(points_here);
end;
with flakearray[3,points_here] do begin
x:=cp*(r1+r2*cos(2*pi*j/m));
z:=sp*(r1+r2*cos(2*pi*j/m));
y:=r2*sin(2*pi*j/m);
inc(points_here);
end;
dnd;
end;
//place the last points(not used in this frame) under the last point (wich is black):
For n:=points_here To (Maxoints-1) Do flakearray[3,n]:=flakearray[3,MaxPoints];
end;
procedure Check(v:integer);
Begin
If (v=0) Then;//Put a debug stop here...
End;
在【object inspector】的“events”标签页中,为窗口TForm1添加OnClick消息函数,用来弹出动画效果窗口。
procedure TForm1.FormDblClick(Sender:Tobject);
begin
about:=TAbout.Create(Self);
About.Showmodal;
end;
下面的部分代码是我从一本书找到的,是个三维动画演示,请大家帮忙调试下,调试完了请跟我说下,谢谢各位大虾了!
定义常量
设置动画演示的状态
const
MsgColorForeGroud=CIAqua;
MSGColorBACKGroud=CIGray;
SpeedAnim=25; //豪秒单位
maxpoints=2047; //动画显示的点数
inter_frame=300; //在再次开始变形前的时间间隔
morph_sp=100; //变形的时间
steps=1+morph_sp; //变形的时间
zo=1.8; //透视投影
viewdist=zo*100;
cycle_pal=4; //“调色板”循环的速度
pal_colours=236; //在调色板中循环颜色的实际数目
pal_coloursml=235;
sqr3maxpoint=11;
sqr3maxpointpl=sqr3maxpoint+1;
sqr3maxpoint3=12*12*12;
MsgSize=21;
maxframes=5; //最大侦数为6
定义flakestruc结构;
type
pflakestruc=^flakestruc;
flakestruc=record
x,y,z:Single;
dx,dy,dz:Single;
end;
数学函数
定义视图的投影方式、旋转方式等。
const
tablesize=1023;
tablesizepl=tablesize=1;
var
cosine:array[0..tablesize] of single;
sine:array[0..tablesize] of single;
{geometry}
rotyxz0_0,rotyxz0_1,rotyxz0_2,
rotyxz1_0,rotyxz1_1,rotyxz1_2,
rotyxz2_1,rotyxz2_2,rotyxz2_3:single;
procedure setup_tables;
var
lp1:integer;
n:Single;
begin
for lp1:=0 to tablesize do begin
n:=(2*pi*lp1/tablesizepl);
cosine[lp1]:=cos
![Thumbs down (n) (n)](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f44e.png)
sine[lp1]:=sin
![Thumbs down (n) (n)](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f44e.png)
end;
end;
{------------------------------------------}
procedure yxz_rotation(x,y,z:integer);{unrolled matrix multiply}
var t1,t2,t3,t4,t5,t6,m1,m2,m3:single;
begin
t1:=cosine[x];
t2:=cosine[y];
t3:=cosine[z];
t4:=sine[x];
t5:=sine[y];
t6:=sine[z];
m1:=(t2*t3);
m2:=(t4*t5);
m3:=(t2*t6);
rotyxz0_0:=m1-((m2*t6));
rotyxz0_1:=-((t1*t6));
rotyxz0_2:=((t3*t5))+((m3*t4));
rotyxz1_0:=m3+((t3*m2));
rotyxz1_1:=((t1*t3));
rotyxz1_2:=((t5*t6))-((m1*t4));
rotyxz2_1:=-((t1*t5));
rotyxz2_2:=t4;
rotyxz2_3:=((t1*t2));
end;
头文件
uses
{Borland}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,Buttons,Stdctrls,Extctrls,
{使用TDIBULtra类和TDIBType类}
DIBULtra,DIBType,
{RXTimer可以使计时更加精确}
TimerRX;
成员变量和成员函数
为TAbout窗口添加下面的成员变量和成员函数
type
TAbout=class(TForm)
procedure FormShow(Sender:TObject);
procedure FormCreate(Sender:TObject);
procedure FormClick(Sender:Tobject);
procedure FormPaint(Sender:Tobject);
procedure FormClose(Sender:Tobject;var Action:TCloseAction);
private
{Private declarations}
//Allocation of 294 kilo-octets for this array!
flakearray:array[0..maxframes,0..maxpoints] of flakestruc;
flakeCol:array[0..maxpoints] of byte;// 2 kilo for this one
{screen variables}
xmid,ymid:integer;
{animation control}
bigloop:integer;
framepause:integer;
frameloop:integer;
framenum:integer;
xrotspeed:integer;
yrotspeed:integer;
zrotspeed:integer;
xrotoff:integer;
yrotoff:integer;
zrotoff:integer;
xr,yr,zr:integer;
xo,yo:Single;
MsgCur:Integer;
MsgFrac:Integer;
MsgWidth:Integer;
MsgDpl:Integer;
ToRect:Trect;
DIBRect:TRect;
Move:TRxTimer;
DIB:TDIBUltra;
procedure Setup_graphics;
procedure compute_and_draw_DIB(frame,stepnum:integer;framechange,skip:boolean);
procedure Stabilize;
procedure Animation(Sender:Tobject);
public
{Public declarations}
end;
在【object inspector】的“events”标签页中,为窗口TAbout添加OnCreat消息函数,用来初始化设置窗口
begin
Move:=TRxTimer.Create(nil);
Move.Enabled:=False;
DIB:=TDIBUltra.Create(ClientWidth,ClientHeight-30,DUpf8,@PaletteToAnimate8Bits);
ToRect:=Rect(0,30,DIB.Width,DIB.Height+30);
DIBRect:=Rect(0,0,DIB.Width,DIB.Height);
xmid:=DIB.Width div 2;
ymid:=DIB.Height div 2;
MsgDpl:=3;
MsgCur:=1;//Premier message
DIB.Canvas.Font.Name:=MsgFonte;
DIB.Canvas.Font.Height:=-MsgSize;
DIB.BrushColor:=CLBlack;
MsgFrac:=-DIB.Width;
MsgWidth:=DIB.Canvas.TextWidth(AboutMsg[MsgCur]);
setup_tables; //初始化数学计算值
setup_graphics; //初始化3D物体
Stabilize; //初始化动画的值
end;
在【object inspector】的“events”标签页中,为窗口TABOUT添加onshow消息函数,用来初始化动画效果。
procedure TAbout.FormShow(Sender:Tobject);
begin
//MAJ du RXTimer
![Eek! :o :o](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f631.png)
Move.Interval:=SpeedAnim;
Move.Enabled:=True;
Move.OnTimer:=Animation;
End;
在【object inspector】的“events”标签页中,为窗口TAbout添加onpaint消息函数,用来绘制动画图形。
procedure TAbout.FormPaint(Sender:Tobject);
var n:integer;
s:String;
begin
s:='DRYSIM 2.0.2.0';
canvas.Font.Name:=Times;
canvas.Font.Height:=26;
canvas.Brush.Style:=bsClear;
n:=(Width-Canvas.TextWidth(s)) div 2;
Canvas.Font.Color:=ClRed;
Canvas.TextOut(n+1,4,s);
Canvas.Font.Color:=ClWhite;
Canvas.TextOut(n,3,s);
//绘制图形
Canvas.CopyRect(ToRect,DIB.Canvas,DIBRect);
end;
在【object inspector】的“events”标签页中,为窗口TAbout添加onclick消息函数,用来关闭TAbout窗口。
procedure TAbout.FormClick(Sender:Tobject);
begin
ModalResult:=mrok;//SElf.Free调用FormClose.Action:=caFree
end;
在【object inspector】的“events”标签页中,为窗口TAbout添加onclose消息函数,用来释放内存。
procedure TAbout.FormClose(Sender:Tobject;var Action:TCloseAction);
begin
Move.Free;
DIB.Free;
Action:=caFree;
end;
成员函数的实现
下面介绍TABout各成员函数的实现
//该函数计算DIB的尺寸,并绘制DIB图形
procedure TAbout.compute_and_draw_DIB(frame,stepnum:integer;framechange,skip:boolean);
var x1,y1,lp1:word;
xt,yt,zt:Single;
tx,ty,tz:Single;
begin
//DIB消息
Inc(MsgFrac,MsgDpl);
If(MsgFrac>=MsgWidth)Then
Begin//处理DIB消息
Inc(MsgCur);If(MsgCur>AboutMessages) Then MegCur:=1;
MsgFrac:=-DIB.Width;
MsgWidth:=DIB.Canvas.TextWidth(AboutMsg[MsgCur]);
End;
//设置DIB值
DIB.Canvas.Font.Color:=MsgColorForeGround;
DIB.Canvas.Brush.Style:=bsSolid;
DIB.Canvas.TextOut(-MsgFrac,05,AboutMsg[msgCur]);
//重新计算点的位置
for lpl:=0 to maxpoints do begin
with flakearray[frame,lpl] do begin
tx:=x+(dx*stepnum);
ty:=y+(dy*stepnum);
tz:=z+(dz*stepnum);
xt:=((rotyxz0_0*tx))+((rotyxz0_1*ty))+((rotyxz0_2*tz))+xo;
yt:=((rotyxz1_0*tx))+((rotyxz1_1*ty))+((rotyxz1_2*tz))+yo;
zt:=((rotyxz2_1*tx))+((rotyxz2_2*ty))+((rotyxz2_3*tz))+zo;
x1:=Round((xt*viewdist)/zt)+xmid;
y1:=Round((yt*viewdist)/zt)+ymid;
DIB.DirectPlot(x1,y1,flakeCol[lpl]);//col 10-246
end;
end;
//复制位图文件
Cancas.CopyRect(ToRect,DIB.Canvas,DIBRect);
end;
//该函数用于停止动画效果
procedure TAbout.Stabilize;
var lpl,lp2: integer;
f1,f2:integer;
begin
bigloop:=48;
xrotspeed:=0;
yrotspeed:=5;
zrotspeed:=0;
framepause:=0; //counter
frameloop:=0; //counter
framenum:=0; //counter
for lpl:=0 to maxframes do begin
f1:=lpl;
f2:=(lpl+1) mod (maxframes+1);
for lp2:=0 to maxpoints do begin
with flakearray[f1,lp2] do begin
dx:=(flakearray[f2,lp2].x-x)/steps;
dy:=(flakearray[f2,lp2].y-y)/steps;
dz:=(flakearray[f2,lp2].z-z)/steps;
end;
end;
end;
end;
//实现动画效果
procedure TAbout.Animation(Sender:TObject);
var
framechange:boolean;
Color
![Stick Out Tongue :p :p](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f61b.png)
begin
Inc(bigloop,1);
Bigloop:=Bigloop AND TableSize;
framechange:=false;
if framepause>=0 then inc(framepause)
else inc(frameloop);
if frameloop>=inter_frame then begin
framepause:=-1;
frameloop:=1;
end;
if frameloop>=morph_sp then begin
frameloop:=0;
framepause:=0;
inc(framenum);framechange:=true;
if framenum>maxframes then framenum:=0;
end;
xo:=0;
yo:=0;
xr:=(32+4*xrotoff+xrotspeed*bigloop) and tablesize;
yr:=(32+4*yrotoff+yrotspeed*bigloop) and tablesize;
zr:=(0+4*zrotoff+zrotspeed*bigloop) and tablesize;
yxz_rotation(xr,yr,zr);
//即使分辨率不是8位,也修改颜色
Color:=@flakeCol;
asm//Colors rolling, by Seb
MOV EDX,Color;
MOV ECX,(MaxPoints-1)
@DO:
MOVZX EAX, BYTE PTR[EDX+ECX]
ADD EAX,Cycle_Pal
CMP EAX,(10+pal_colours)
JB @COLOROK
MOV EAX,10
COLOROK:
MOV[EDX+ECX],AL
LOOP @DO
END;//Idem:Forn:=maxpoints-1 down to0 Begin inc(flakeCol[n],cycle_pal);
if (flakeCol[n]>(10+pal_colours)) Then flakeCol[n]:=10; End;
DIB.ClearAll;
compute_and_draw_DIB(framenum,frameloop,framechange,false);
//实现调色板。也可以使用下面的代码:
//If (Screen.Resolution=pf8Bit) Then Begin
SelectPalette(Canvas.Handle,DIB.Hpalette,false);
RealizePalette(Canvas.Handle);
//如果屏幕分辨率不是8位,调用RealizePalette返回0是不起作用的
end;
//装载图象
procedure TAbout.Setup_graphics;
var lp0,lp1,lp2:integer;
a,r:Single;
r1,r2,cp,sp:Single;
i,j,n,m:integer;
points_here:integer;
pp_seg,seg:integer;
phi,theta:Single;
paper:TDIBUltra;
begin//frames 0..5 generated in a seconde
for lpl:=0 to (MaxPoints-1) do flakecol[lpl]:=10+((lpl div 8) mod pal_colours);
flakeCol[MaxPoints]:=0;//最后的点是不可见的
Paper:=TDIBUltra.Create(450,30,DUpf1,Nilpalette);//图象为450*30
for lp0:=0 to 2 do begin
points_here:=0;
//得到字体的属性
Paper.Canvas.Font.Height:=Banner[lp0].FSize;
Paper.Canvas.Font.Style:=Banner[lp0].FStyle;
Paper.Canvas.Font.Name:=Banner[lp0].FName;
Paper.Canvas.Brush.Color:=CLBlack;
Paper.Canvas.Brush.Style:=bsSolid;
Paper.Canvas.Font.Color:=CLWhite;
Paper.Canvas.FillRect(Rect(0,0,Paper.Width,Paper.Height+1));
n:=Paper.Canvas.TextWidth(Banner[lp0].Text);
m:=Banner[lp0].FSize;
Paper.Canvas.TextOut(0,0,Banner[lp0].Text);
//Constantes
a:=2*pi/360;
r:=2*pi/(n*1);//1=>The formed circle is 100% the TextWidth
i:=lp0*2;
for lp1:=0 to (n-1) do begin // So you have to left some spaces at the end of your banner
for lp2:=0 to (m-1) do begin
if Boolean(Paper.Pixels[(n-lp1),lp2]) then begin
with flakearray[i,points_here] do begin
r1:=a*(lp2-m/2);
r2:=r*(n-lp1);
x:=cos(r2)*cos(r1);
z:=sin(r2)*cos(r1);
y:=sin(r1);
end;
inc(points_here);
end;
end;
end;//将剩余的点放置在小球上
{$IFDEF BANNER_CONCEPTION}
ShowMessage('Your message :'#13'"'+Banner[lp0].Text+'"'#13+'use'+IntToStr(points_here)+'pixel!'#13
+'You can still use'+IntToStr(maxpoints-points_here)+'pixels.');
{$ENDIF}
//place the last points(not used in this frame) under the last point(wich is black):
For n:=points_here To (Maxpoints-1) Do flakearray[i,n]:=flakearry[i,MaxPoints];
end;
Paper.Free;
//绘制立方体
phi:=1.2/(sqr3maxpoint);
for lp0:=0 to sqr3maxpoint Do
for lp1:=0 to sqr3maxpoint Do Begin m:=sqr3maxpointp1*(sqr3maxpointp1*lp0+lp1);
for lp2:=0 to sqr3maxpoint Do
with flakearray[5,m+lp2] Do Begin
x:=0.6-Phi*lp0;
z:=0.6-Phi*lp1;
y:=0.6-Phi*lp2;
End;
End;
//place the last points (not used in this frame) under the last point (wich is black):
For n:=sqr3maxpoint3 To (MaxPoints-1) Do flakearray[5,n]:=flakearray[5,MaxPoints];
//System.Move(flakearray[5,0],flakearray[5,sqr3maxpoint3],SizeOf(flakestruc)*(maxpoints-sqr3maxpoint3+1));
{//Old cube figure;by john
//frame 5-random cube
for lp1:=0 to maxpoints do begin
with flakearray[5,lp1] do begin
x:=(0.57*2)*random(256)/255-0.57;
z:=(0.57*2)*random(256)/255-0.57;
y:=(0.57*2)*random(256)/255-0.57;
c:=10+pal_colours*(sqrt(x*x+y*y+z*z)/sqrt(sqr(0.57)*3));
end;
end;
}
//frame 3- two spheres
//Seb Modif:I separate the spheres computing to have a nice rolling color effect
points_here:=0;
seg:=32;
pp_seg:=(maxpoints+1) div (seg*2);
n:=0;
for lp2:=0 to seg-1 do begin
theta:=2*pi*(n+0.5)/pp_seg;
m:=0;
for lp1:=0 to seg-1 do begin
phi:=pi*(m+0.5)/seg;
with flakearray[1,points_here] do begin
x:=cos(theta)*sin(phi);
y:=sin(theta)*sin(phi);
z:=cos(phi);
inc(points_here);
end;
m:=m+1;
end;
n:=n+1;
end;
m:=0;
for lp1:=0 to seg-1 do begin
phi:=pi*(m+0.5)/seg;
n:=0;
for lp2:=0 to pp_seg-1 do begin
theta:=2*pi*(n+0.5)/pp_seg;
with flakearray[1,points_here] do begin
x:=0.5*cos(theta)*sin(phi);
z:=0.5*sin(theta)*sin(phi);
y:=0.5*cos(phi);
inc(points_here);
end;
n:n+1;
end;
m:=m+1;
End;
//place the last points(not used in this frame) under the last point(wich is black):
For n
![Stick Out Tongue :p :p](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f61b.png)
//frame 5 - torus*2
r1:=0.75;
r2:=0.25;
n:=64;
m:=(maxpoints+1) div (n*2);
points_here:=0;
for i:=0 to n-1 do begin
cp:=cos(2*pi*i/n);
sp:=sin(2*pi*i/n);
for j:=0 to m-1 do begin
with flakearray[3,points_here] do begin
x:=cp*(r1+r2*cos(2*pi*j/m));
y:=sp*(r1+r2*cos(2*pi*j/m));
z:=r2*sin(2*pi*j/m);
inc(points_here);
end;
with flakearray[3,points_here] do begin
x:=cp*(r1+r2*cos(2*pi*j/m));
z:=sp*(r1+r2*cos(2*pi*j/m));
y:=r2*sin(2*pi*j/m);
inc(points_here);
end;
dnd;
end;
//place the last points(not used in this frame) under the last point (wich is black):
For n:=points_here To (Maxoints-1) Do flakearray[3,n]:=flakearray[3,MaxPoints];
end;
procedure Check(v:integer);
Begin
If (v=0) Then;//Put a debug stop here...
End;
在【object inspector】的“events”标签页中,为窗口TForm1添加OnClick消息函数,用来弹出动画效果窗口。
procedure TForm1.FormDblClick(Sender:Tobject);
begin
about:=TAbout.Create(Self);
About.Showmodal;
end;