图像的消隐效果
点击次数：73 次 发布日期：2008-11-09 08:40:53 作者：源代码网
源代码网推荐 interface 源代码网推荐 uses 源代码网推荐 SysUtils,WinTypes,WinProcs,Messages,Classes,Graphics,Controls,Forms,Dialogs,Ex 源代码网推荐 tCtrls,StdCtrls; 源代码网推荐 type 源代码网推荐 TForm1=class(TForm) 源代码网推荐 Image1:TImage;{显示渐隐图像} 源代码网推荐 Timer1:TTimer;{时钟构件} 源代码网推荐 Panel1:TPanel;{显示渐隐过程，已渐隐为背景色的颜色数} 源代码网推荐 Button1:TButton;{开始渐隐按钮} 源代码网推荐 procedure Timer1 Timer(Sender:TObject);{始终控制过程} 源代码网推荐 procedure Button1 Click (Sender:TObject);{激发渐隐过程} 源代码网推荐 procedure FormCreate (Sender:TObject);{窗体构造过程} 源代码网推荐 private 源代码网推荐 PalDevice:Imteger;{调色板模式标志} 源代码网推荐 go:integer;{渐隐开始标志} 源代码网推荐 pal:arrar［0...255］ of TPaletteEntry;{逻辑调色板} 源代码网推荐 end; 源代码网推荐 var 源代码网推荐 Form1:TForm1; 源代码网推荐 源代码网推荐 implementation 源代码网推荐 {$R *.DFM} 源代码网推荐 procedure TForm1.Timer1Timer(Sender:TObject); 源代码网推荐 var 源代码网推荐 i,n:integer; 源代码网推荐 begin 源代码网推荐 if go=1 then{开始渐隐} 源代码网推荐 begin 源代码网推荐 for i:=0 to 255 do{调色板颜色值递减} 源代码网推荐 begin 源代码网推荐 源代码网推荐 pal［i］.peFlags:=PC-RESERVED;{调色板动画标志，一定得这样设置} 源代码网推荐 if pal［i］.peRed>0 thenpal［i］.peRed:=pal［i］.peRed-1; 源代码网推荐 if pal［i］.peGreen>0 thenpal［i］.peGreen:=pal［i］.peGreen-1; 源代码网推荐 if pal［i］.peBlue>0 thenpal［i］.peBlue:=pal［i］.peBlue-1;〖ZK)〗 源代码网推荐 end; 源代码网推荐 SetPaletteEntries(Image1.Picture.Bitmap.Palette,0,256,pal);{设置新的颜色 源代码网推荐 到 源代码网推荐 DIB调色板} 源代码网推荐 RealizePalette(Image1.Picture.Bitmap.Canvas.Handle);{影射逻辑调色板 源代码网推荐 到系统硬件调色板} 源代码网推荐 {计算已经渐隐消失的颜色数，如全数完成则终止渐隐过程，令go=0} 源代码网推荐 n:=0; 源代码网推荐 for i:=0 to 255 do 源代码网推荐 if(pal［i］.peRed=0) and (pal［i］.peGreen=0) and (pal［i］.peBlue=0) 源代码网推荐 then 源代码网推荐 n:=n 1 源代码网推荐 if n=256 then 源代码网推荐 begin 源代码网推荐 Panel1.Caption:="OK"; 源代码网推荐 go:=0; 源代码网推荐 end 源代码网推荐 else 源代码网推荐 Panel1.Caption:="n=" IntToStr(n); 源代码网推荐 end; 源代码网推荐 end; 源代码网推荐 procedure TForm1.Button1Click(Sender:TObject); 源代码网推荐 begin 源代码网推荐 GetPaletteEntries(Image1.Pictrue.Bitmap.Palette,0,256,pal);{获得DIB图 源代码网推荐 像 源代码网推荐 的调色板} 源代码网推荐 {判断系统是否是基于调色板的显示模式，如果是则开始渐隐过程} 源代码网推荐 PalDevice:=GetDeviceCaps(Canvas.Handle,RASTERCAPS) and RC-PALETTE; 源代码网推荐 if(PalDevice>0) the go:=1; 源代码网推荐 end; 源代码网推荐 procedure TForm1.FormCreate(Sender:TObject); 源代码网推荐 begin 源代码网推荐 Image1.Pictrue.Bitmap.LoadFromFile("c:＼video10＼ts.bmp");{加载DIB图像} 源代码网推荐 end; 源代码网推荐 end. 源代码网推荐 源代码网供稿. |
