⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 bitbltpicture.pas

📁 Delphi高级程序开发配书源代码,可以循序渐进的学习Delphi.
💻 PAS
字号:
unit BitBltPicture;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TFmTxxs2 = class(TForm)
    BtCenToAll: TButton;
    BtAllToCen: TButton;
    BtLupToRdown: TButton;
    BtLdownToRup: TButton;
    BtRupToLdown: TButton;
    BtRdownToLup: TButton;
    BtMidToBoth: TButton;
    BtClear: TButton;
    BtExit: TButton;
    BtBothToMid: TButton;
    procedure BtClearClick(Sender: TObject);
    procedure BtCenToAllClick(Sender: TObject);
    procedure BtAllToCenClick(Sender: TObject);
    procedure BtLupToRdownClick(Sender: TObject);
    procedure BtLdownToRupClick(Sender: TObject);
    procedure BtRupToLdownClick(Sender: TObject);
    procedure BtRdownToLupClick(Sender: TObject);
    procedure BtMidToBothClick(Sender: TObject);
    procedure BtBothToMidClick(Sender: TObject);
    procedure BtExitClick(Sender: TObject);
  private
    { Private declarations }
    procedure ShowButtons(Sender:Tobject); // 显示窗体上的按钮
    procedure HideButtons(Sender:Tobject); // 隐藏窗体上的按钮
  public
    { Public declarations }
  end;

var
  FmTxxs2: TFmTxxs2;

implementation
const
 Step=1600;  //循环的次数,用以调整图象变动的快慢
var
 Bitmap:TBitmap;
 X0,Y0:integer;
 MidX,MidY:integer;
 RatioX,RatioY:real;
{$R *.dfm}

procedure TFmTxxs2.HideButtons(Sender: Tobject);
begin
    //将所有按钮设为不可见
    BtCenToAll.Visible:=False;
    BtAllToCen.Visible:=False;
    BtLupToRdown.Visible:=False;
    BtLdownToRup.Visible:=False;
    BtRupToLdown.Visible:=False;
    BtRdownToLup.Visible:=False;
    BtMidToBoth.Visible:=False;
    BtBothToMid.Visible:=False;

    BtClear.Visible:=False;
    BtExit.Visible:=False;


end;

procedure TFmTxxs2.ShowButtons(Sender: Tobject);
begin
    //显示所有按钮
    BtCenToAll.Visible:=True;
    BtAllToCen.Visible:=True;
    BtLupToRdown.Visible:=True;
    BtLdownToRup.Visible:=True;
    BtRupToLdown.Visible:=True;
    BtRdownToLup.Visible:=True;
    BtMidToBoth.Visible:=True;
    BtBothToMid.Visible:=True;

    BtClear.Visible:=True;
    BtExit.Visible:=True;
end;

procedure TFmTxxs2.BtClearClick(Sender: TObject);
const
   TmpStep=100;   //通过它调整清除屏幕时的速度
var
 I:Integer;
begin
 Bitmap:=TBitmap.Create;
 Bitmap.LoadFromFile('示例图片.bmp');//载入图片
 X0:=FmTxxs2.Width div 2;
 Y0:=FmTxxs2.Height div 2;
 RatioX:=Bitmap.Width/TmpStep;
 RatioY:=Bitmap.Height/TmpStep;
 for I:=0 to TmpStep do
 begin                    //将窗体显示区域变黑
    MidX:=Round(RatioX *I*0.5);
    MidY:=Round(RatioY*I*0.5);
    BitBlt(FmTxxs2.Canvas.Handle,X0-MidX,Y0-MidY,Round(RatioX*I),Round(RatioY*I),
    Bitmap.Canvas.Handle,X0-MidX,Y0-MidY,blackness);
 end;
 Bitmap.Free        //释放位图
end;

procedure TFmTxxs2.BtCenToAllClick(Sender: TObject);
var
  i:integer;
begin      //实现图片从中心到四周的暂变显示。
  hidebuttons(sender);      //隐藏按钮
  BtClearClick(sender);     //清屏
  bitmap:=tbitmap.Create;    //创建位图对象
  bitmap.LoadFromFile('示例图片.bmp');
  x0:=width div 2;
  y0:=height div 2;
  ratiox:=Bitmap.width/step; //step每加1,图片变化的宽度
  ratioy:=Bitmap.height/step;
  for i:=0 to step do
  begin
     midx:=round(ratiox*i*0.5);
     midy:=round(ratioy*i*0.5);
     bitblt(FmTxxs2.canvas.handle,x0-midx,y0-midy,
       round(ratiox*i),round(ratioy*i),
         bitmap.canvas.handle,x0-midx,y0-midy,srccopy);
       //循环拷贝一定区域的图象显示,区域不断变化实现特效显示
  end;
  bitmap.free;  //释放位图
  showbuttons(sender);    //显示按钮
 end;

procedure TFmTxxs2.BtAllToCenClick(Sender: TObject);
//实现图片从四周到中心的暂变显示。
var
  i:integer;
begin
  hidebuttons(sender);       //隐藏按钮
  BtClearClick(sender);        //清屏
  bitmap:=tbitmap.Create;      //创建位图对象
  bitmap.LoadFromFile('示例图片.bmp');
  ratiox:=width/step;
  ratioy:=height/step;
  for i:= 0 to step do
  begin  //由于bitblt每次只能拷贝一个矩形,故要实现
     //从四周到中间的渐变显示特效,需要每次拷贝周边的
     //四个矩形,组成一个矩形框,

    bitblt(FmTxxs2.canvas.handle,0,0,
         round(ratiox*i*0.5),height,
         bitmap.canvas.handle,0,0,srccopy);
         //拷贝左边的矩形
    bitblt(FmTxxs2.canvas.handle,0,0,
         width,round(ratioy*i*0.5),
         bitmap.canvas.handle,0,0,srccopy);
         //拷贝上方的矩形
    bitblt(FmTxxs2.canvas.handle,width-round(ratiox*i*0.5),0,
         width,height,
         bitmap.canvas.handle,width-round(ratiox*i*0.5),0,srccopy);
         //拷贝右边的矩形
    bitblt(FmTxxs2.canvas.handle,0,
          height-round(ratioy*i*0.5),width,height,
          bitmap.canvas.handle,0,
          height-round(ratioy*i*0.5),srccopy);
          //拷贝下面的矩形

  end;

  bitmap.free;     //释放位图
  showbuttons(sender);    //显示所有按钮
end;

procedure TFmTxxs2.BtLupToRdownClick(Sender: TObject);
//实现图片从左上到右下的暂变显示。
var
  i:integer;
begin
  hidebuttons(sender);
  BtClearClick(sender);
  bitmap:=tbitmap.Create;
  bitmap.LoadFromFile('示例图片.bmp');
  ratiox:=width/step;
  ratioy:=height/step;
  for i:= 0 to step do
  begin
    bitblt(FmTxxs2.canvas.handle,0,0,
         round(ratiox*i),round(ratioy*i),
         bitmap.canvas.handle,0,0,srccopy);
         //拷贝左上角的一个矩形,要求右下角的坐标
         //按(round(ratiox*i),round(ratioy*i))变化,
         //注意,由于宽和高不等,所以它们的变化幅度
         //也应该有所不同。
  end;
  bitmap.free;
  showbuttons(sender);
 end;


procedure TFmTxxs2.BtLdownToRupClick(Sender: TObject);
//实现图片从左下到右上的暂变显示。
var
  i:integer;
begin
  hidebuttons(sender);
  BtClearClick(sender);
  bitmap:=tbitmap.Create;
  bitmap.LoadFromFile('示例图片.bmp');
  ratiox:=width/step;
  ratioy:=height/step;
  for i:= 0 to step do
  begin
    bitblt(FmTxxs2.canvas.handle,0,height-round(ratioy*i),
         round(ratiox*i),height,bitmap.canvas.handle,
         0,height-round(ratioy*i),srccopy);
  end;
  bitmap.free;
  showbuttons(sender);
 end;

procedure TFmTxxs2.BtRupToLdownClick(Sender: TObject);
//实现图片从右上到左下的暂变显示。
var
  i:integer;
begin
  hidebuttons(sender);
  BtClearClick(sender);
  bitmap:=tbitmap.Create;
  bitmap.LoadFromFile('示例图片.bmp');
  ratiox:=width/step;
  ratioy:=height/step;
  for i:= 0 to step do
  begin
    bitblt(FmTxxs2.canvas.handle,width-round(ratiox*i),0,
         width,round(ratioy*i),bitmap.canvas.handle,
         width-round(ratiox*i),0,srccopy);
  end;

  bitmap.free;
  showbuttons(sender);
 end;

procedure TFmTxxs2.BtRdownToLupClick(Sender: TObject);
//实现图片从右下到左上的暂变显示。
var
  i:integer;
begin
  hidebuttons(sender);
  BtClearClick(sender);
  bitmap:=tbitmap.Create;
  bitmap.LoadFromFile('示例图片.bmp');
  ratiox:=width/step;
  ratioy:=height/step;
  for i:= 0 to step do
  begin
    bitblt(FmTxxs2.canvas.handle,width-round(ratiox*i),
         height-round(ratioy*i),width,height,
         bitmap.canvas.handle,width-round(ratiox*i),
         height-round(ratioy*i),srccopy);
  end;
  bitmap.free;
  showbuttons(sender);
 end;

procedure TFmTxxs2.BtMidToBothClick(Sender: TObject);
//实现图片从中间到两边的暂变显示。
var
  i:integer;
begin
  hidebuttons(sender);
  BtClearClick(sender);
  bitmap:=tbitmap.Create;
  bitmap.LoadFromFile('示例图片.bmp');
  ratiox:=width/step;
  for i:= 0 to step do
  begin
  //注意此时左上角的x坐标朝左变化,而右下角的x坐标朝右变化
     bitblt(FmTxxs2.canvas.handle,round(width/2)-round(ratiox*i*0.5),0,
      round(ratiox*i),height,bitmap.canvas.handle,
      round(width/2)-round(ratiox*i*0.5),0
      ,srccopy);
  end;
  bitmap.free;
  showbuttons(sender);
 end;

procedure TFmTxxs2.BtBothToMidClick(Sender: TObject);
//实现图片从两边到中间的暂变显示。
var
  i:integer;
begin
  hidebuttons(sender);
  BtClearClick(sender);
  bitmap:=tbitmap.Create;
  bitmap.LoadFromFile('示例图片.bmp');
  ratiox:=width/step;
  ratioy:=height/step;
  for i:= 0 to step do
  begin
   //实际是从四周到中心变化的简化。
    bitblt(FmTxxs2.canvas.handle,0,0,
         round(ratiox*i*0.5),height,
         bitmap.canvas.handle,0,0,srccopy);
    bitblt(FmTxxs2.canvas.handle,width-round(ratiox*i*0.5),0,
         width,height,
         bitmap.canvas.handle,width-round(ratiox*i*0.5),0,srccopy);
  end;
  bitmap.free;
  showbuttons(sender);
 end;
procedure TFmTxxs2.BtExitClick(Sender: TObject);
begin
  close; //退出
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -