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


本文整理自网络,侵删。

 
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.

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

相关阅读 >>

Delphi dbgrid 保存txt

Delphi 获取系统注册的文件图标

Delphi unigui form控件跳转

Delphi 用正则表达式获取指定的字符串续取出所有符合要求的字符串

Delphi tms web core twebhttprequest使用

Delphi最全面的dbgrid点击标题实现排序

Delphi sha1加密函数

Delphi驱动方式winio模拟按键

Delphi xe intraweb 程序在iis下的发布详细教程

Delphi暴力关机代码

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...