TClipBoard剪贴板示例

//拷贝端

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Memo1: TMemo;
    Memo2: TMemo;
    Button2: TButton;
    Button3: TButton;
    Image1: TImage;
    copyimg: TButton;
    cutimg: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure copyimgClick(Sender: TObject);
    procedure cutimgClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//字符串拷贝
procedure TForm1.Button1Click(Sender: TObject);
begin
  ClipBoard.AsText := Edit1.Text;
  Edit2.Text := ClipBoard.AsText;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //setTextBuf用于把超过255个字符的字符串拷贝到剪贴板
  ClipBoard.SetTextBuf(pchar(Memo1.Text));
  Memo2.Text := ClipBoard.AsText;
end;

////字符串拷贝 拷贝到程序二中
procedure TForm1.Button3Click(Sender: TObject);
begin
  ClipBoard.AsText := Edit1.Text;
end;

//图像拷贝
procedure TForm1.copyimgClick(Sender: TObject);
begin
  ClipBoard.Assign(image1.Picture);
end;

//图像剪切：首先把图像拷贝到剪贴板，然后在原来位置用空白图像进行覆盖
procedure TForm1.cutimgClick(Sender: TObject);
var
  ARect: TRect;
begin
  ClipBoard.Assign(Image1.Picture);//把Image1上的图像拷贝到剪贴板
  with Image1.Canvas do
  begin
    CopyMode := cmWhiteness;
    ARect := Rect(0,0,image1.Width,image1.Height);//空白图像
    CopyRect(ARect,image1.Canvas,ARect);//覆盖
    CopyMode := cmSrcCopy;
  end;
end;

end.

//粘贴端

unit Unit2;

interface

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

type
  TForm1 = class(TForm)
    pastetxt: TButton;
    Label1: TLabel;
    pasteimg: TButton;
    Image1: TImage;
    procedure pastetxtClick(Sender: TObject);
    procedure pasteimgClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//字符串拷贝 数据源从程序一中
procedure TForm1.pastetxtClick(Sender: TObject);
begin
  label1.Caption := ClipBoard.AsText;
end;

//图像粘贴 数据源从程序一中
procedure TForm1.pasteimgClick(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  if ClipBoard.HasFormat(CF_BITMAP) then //检测剪贴板上的数据格式
  begin
    Bitmap := TBitmap.Create;
    Try
      Bitmap.Assign(ClipBoard); //拷贝剪贴板图片
      image1.Canvas.Draw(0,0,Bitmap);
    finally
      Bitmap.Free; //释放内存
    end;
  end;
end;

end.