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

 

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

 

 

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.