delphi copyrect实现的几个图片的转换效果

来源:互联网 发布:java 获取项目路径 编辑:程序博客网 时间:2024/05/17 08:51

 

这上是一测试的效果程序:http://download.csdn.net/source/3319599

 

 

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.


 

原创粉丝点击