mobilepicture.pas

来自「Delphi7高级应用开发随书源码」· PAS 代码 · 共 71 行

unit MobilePicture;

interface

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

type
  TFmTxxs = class(TForm)
    BtBegin: TButton;
    BtExit: TButton;
    procedure BtBeginClick(Sender: TObject);
    procedure BtExitClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FmTxxs: TFmTxxs;

implementation

{$R *.dfm}

procedure TFmTxxs.BtBeginClick(Sender: TObject);
const
  step=200;
  x0=20;  // 左边界
  y0=20;   // 上边界
var
  Bitmap:TBitmap;
  MidX:Integer;//中间变量，当前步骤所拷贝位图的宽
  RatioX:Real;//每步位图宽度增加量
  I:Integer;
  Rect1,Rect2:TRect;//源、目标矩形区域
begin
  Bitmap:=TBitmap.Create;
  Bitmap.LoadFromFile('示例图片.bmp');//装入位图文件
  RatioX:=Bitmap.Width/Step;
  for I:=0 to Step do
  begin
   MidX:=Round(RatioX*I);
   with Rect1 do //设置复制的目标区域
   begin
    Left:=Bitmap.Width-MidX;
    Top:=0;
    Right:=Bitmap.Width;
    Bottom:=Bitmap.Height;
   end;
   with Rect2 do       //设置复制的源区域
   begin
    Left:=X0;
    Top:=Y0;
    Right:=X0+MidX;
    Bottom:=Y0+Bitmap.Height;
   end;
   Canvas.CopyRect(Rect2,Bitmap.Canvas,Rect1);//复制位图
 end;
 Bitmap.Free;//释放位图资源
end;

procedure TFmTxxs.BtExitClick(Sender: TObject);
begin
  FmTxxs.Close;    //退出
end;

end.