图形特效
unit ChangeImage;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,jpeg, StdCtrls, ExtCtrls;
procedure BaiYeChuang(Targer:Timage;Source:Tbitmap);//百叶窗
procedure MaSaiKe(Targer:Timage;Source:Tbitmap);//马赛克
procedure JiaoCuo(Targer:Timage;Source:Tbitmap);//交错
procedure FromCenter(Targer:Timage;Source:Tbitmap);//从中心渐入
procedure ZhanKaiFromLeft(Targer:Timage;Source:Tbitmap);//从左边展开
procedure FlyInFromLeft(Targer:Timage;Source:Tbitmap);//从左边飞入
procedure Rain(Targer:Timage;Source:Tbitmap);//雨滴
implementation
uses Math;
procedure Rain(Targer:Timage;Source:Tbitmap);
var
i:Integer;
from,too:TRect;
bmpwidth,bmpheigth:Integer;
begin
bmpwidth:=Targer.Width;
bmpheigth:=Targer.Height;
Source.Width:=bmpwidth;
source.Height:=bmpheigth;
for i:=0 to bmpheigth do
begin
from:=Rect(0,bmpheigth-i-1,bmpwidth,bmpheigth-i);
too:=Rect(0,0,bmpwidth,bmpheigth-i);
Targer.Picture.Bitmap.Canvas.CopyRect(too,Source.Canvas,from);
Application.ProcessMessages;
end;
Targer.Refresh;
end;
procedure ZhanKaiFromLeft(Targer:Timage;Source:Tbitmap);
var
i:Integer;
from,too:TRect;
bmpwidth,bmpheigth:Integer;
begin
bmpwidth:=Targer.Width;
bmpheigth:=Targer.Height;
Source.Width:=bmpwidth;
source.Height:=bmpheigth;
for i:=0 to bmpwidth do
begin
from:=Rect(bmpwidth-i,0,bmpwidth,bmpheigth);
Targer.Picture.Bitmap.Canvas.CopyRect(from,Source.Canvas,from);
Application.ProcessMessages;
end;
Targer.Picture.Bitmap.Canvas.CopyRect(too,Source.Canvas,too);
Targer.Refresh;
end;
procedure FlyInFromLeft(Targer:Timage;Source:Tbitmap);
var
i:Integer;
from,too:TRect;
bmpwidth,bmpheigth:Integer;
const
squ=40;
begin
bmpwidth:=Targer.Width;
bmpheigth:=Targer.Height;
Source.Width:=bmpwidth;
source.Height:=bmpheigth;
for i:=0 to bmpwidth do
begin
from:=Rect(bmpwidth-i,0,bmpwidth,bmpheigth);
too:=Rect(0,0,i,bmpheigth);
Targer.Picture.Bitmap.Canvas.CopyRect(from,Source.Canvas,too);
Application.ProcessMessages;
end;
Targer.Picture.Bitmap.Canvas.CopyRect(too,Source.Canvas,too);
Targer.Refresh;
end;
procedure FromCenter(Targer:Timage;Source:Tbitmap);
var
i,x:Integer;
from,too:TRect;
bmpwidth,bmpheigth:Integer;
opointx,opointy,cj:Integer;
check:Boolean;
const
squ=40;
begin
bmpwidth:=Targer.Width;
bmpheigth:=Targer.Height;
Source.Width:=bmpwidth;
source.Height:=bmpheigth;
opointx:=bmpwidth div 2;
opointy:=bmpheigth div 2;
check:=bmpwidth>bmpheigth;
cj:=IfThen(check,(bmpwidth-bmpheigth) div 2,(bmpheigth-bmpwidth) div 2);
x:=IfThen(check,opointy,opointx);
for i:=0 to x do
begin
if check then
begin
from:=Rect(opointx-cj-i,opointy-i,opointx+cj+i,opointy+i);
too:=Rect(opointx-cj-i,opointy-i,opointx+cj+i,opointy+i);
end
else
begin
from:=Rect(opointx-i,opointy-cj-i,opointx+i,opointy+cj+i);
too:=Rect(opointx-i,opointy-cj-i,opointx+i,opointy+cj+i);
end;
Targer.Picture.Bitmap.Canvas.CopyRect(from,Source.Canvas,too);
Targer.Refresh;
Application.ProcessMessages;
end;
end;
procedure JiaoCuo(Targer:Timage;Source:Tbitmap);
var
i,j,xcount:Integer;
from,too:TRect;
bmpwidth,bmpheigth:Integer;
const
squwidth=20;
squheight=20;
begin
bmpwidth:=Targer.Width;
bmpheigth:=Targer.Height;
Source.Width:=bmpwidth;
source.Height:=bmpheigth;
xcount:=(bmpwidth div squwidth)+IfThen((bmpwidth mod squwidth)<>0,1,0);
for i:=0 to bmpheigth do
begin
for j:=1 to xcount do
begin
if (j mod 2)=0 then
begin
from:=Rect((j-1)*squwidth,0,j*squwidth,i);
too:=Rect((j-1)*squwidth,bmpheigth-i,j*squwidth,bmpheigth);
end
else
begin
too:=Rect((j-1)*squwidth,0,j*squwidth,i);
from:=Rect((j-1)*squwidth,bmpheigth-i,j*squwidth,bmpheigth);
end;
Targer.Picture.Bitmap.Canvas.CopyRect(too,Source.Canvas,from);
end;
Targer.Refresh;
Application.ProcessMessages;
end;
end;
procedure BaiYeChuang(Targer:TImage;Source:TBitmap);
var
i,j:Integer;
from,too:TRect;
bmpwidth,bmpheigth:Integer;
xgroup,xcount:Integer;
begin
bmpwidth:=Targer.Width;
bmpheigth:=Targer.Height;
Source.Width:=bmpwidth;
source.Height:=bmpheigth;
xcount:=100;
xgroup:=bmpheigth div xcount;
for i:=0 to xgroup do
begin
for j:=0 to xcount do
begin
from:=Rect(0,j*xgroup+i-1,bmpwidth,j*xgroup+i);
too:=Rect(0,j*xgroup+i-1,bmpwidth,j*xgroup+i);
Targer.Picture.Bitmap.Canvas.CopyRect(too,Source.Canvas,from);
end;
Targer.Refresh;
sleep(100);
Application.ProcessMessages;
end;
end;
procedure MaSaiKe(Targer:Timage;Source:Tbitmap);
var
i,x,y:Integer;
from,too:TRect;
bmpwidth,bmpheigth:Integer;
const
squ=40;
begin
bmpwidth:=Targer.Width;
bmpheigth:=Targer.Height;
Source.Width:=bmpwidth;
source.Height:=bmpheigth;
Randomize;
for i:=0 to 500 do
begin
x:=Random(bmpwidth div squ);
y:=Random(bmpheigth div squ);
from:=Rect(x*squ,y*squ,(x+1)*squ,(y+1)*squ);
Targer.Picture.Bitmap.Canvas.CopyRect(from,Source.Canvas,from);
Application.ProcessMessages;
end;
too:=Rect(0,0,bmpwidth,bmpheigth);
Targer.Picture.Bitmap.Canvas.CopyRect(too,Source.Canvas,too);
Targer.Refresh;
end;
end.
2011-07-03 22:59
