图像的消隐效果
【打印文章】
unit Bmp-Disaper;
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.
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.
本栏文章均来自于互联网,版权归原作者和各发布网站所有,本站收集这些文章仅供学习参考之用。任何人都不能将这些文章用于商业或者其他目的。( Pfan.cn )
【编程爱好者论坛】