本文整理自网络,侵删。
unit ChangeImage; interfaceuses 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.
这上是一测试的效果程序:http://download.csdn.net/source/3319599
相关阅读 >>
Delphi 用正则表达式获取指定的字符串续取出所有符合要求的字符串
Delphi tms web core twebhttprequest使用
Delphi xe intraweb 程序在iis下的发布详细教程
更多相关阅读请进入《Delphi》频道 >>