Delphi操作剪贴板-阿里云开发者社区

剪切板类 TClipboard 定义在 Clipbrd 单元, 使用前先要 uses Clipbrd;

uses Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
var
  clip: TClipboard;
begin
  clip := TClipboard.Create; {建立}
  clip.AsText := Self.Text;  {把窗体标题放入剪切板}
  ShowMessage(clip.AsText);  {从剪切板读取, 返回结果是: Form1}
  {因为剪切板是全局的, 此时可以在其他地方粘贴一试}
  clip.Free;                 {释放}
end;

根据 Delphi 给我们提供的方便, 上面的例子可以简化为:

uses Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.AsText := Text;
  ShowMessage(Clipboard.AsText); {Form1}
end;

这个 Clipboard 是什么? 是不是和 Screen 一样的类型变量?
答案是否定的! Clipboard 只是个函数, 是一个无参函数, 是定义在 Clipbrd 单元的一个全局函数, 它返回一个 TClipboard 类型的变量, 当我看到这个函数的源码时, 真是感觉又学了一招, 非常精巧的思路.

除了用 TClipboard.AsText 属性, 我们还可以使用 SetTextBuf 把文本放入剪切板、使用 GetTextBuf 读出剪切板中的文本.

uses Clipbrd;

{使用 SetTextBuf}
procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.SetTextBuf(PChar(Text)); {按参数类型要求, 需要转换一下}
  ShowMessage(Clipboard.AsText);     {Form1}
end;

{使用 GetTextBuf 就和使用 API 差不多, 需要给个缓冲区}
procedure TForm1.Button2Click(Sender: TObject);
var
  arr: array[0..255] of Char;
begin
  Clipboard.AsText := Text;
  Clipboard.GetTextBuf(arr, Length(arr));
  ShowMessage(arr);                       {Form1}
end;

{如果不给缓冲区, 那你自己得申请并释放内存}
procedure TForm1.Button3Click(Sender: TObject);
var
  pc: PChar;
begin
  Clipboard.AsText := Text;
  GetMem(pc, 256);               {申请内存}
  Clipboard.GetTextBuf(pc, 256);
  ShowMessage(pc);               {Form1}
  FreeMem(pc);                   {释放内存}
end;

使用剪切板[2]: Assign、HasFormat

准备工作: 在窗体上放置一个 TPanel; 在 TPanel 上放一个 TImage; 另外需要三个按钮.

第一版代码:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel1: TPanel;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Left := 0;
  Image1.Top := 0;
  Panel1.AutoSize := True;
  Image1.AutoSize := True;
  Image1.Picture.LoadFromFile('c:/temp/test.bmp');

  TButton(Sender).Caption := '导入';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Clipboard.Assign(Image1.Picture); {把 Image1 中的图片放入剪切板}
  {现在在图像软件中都可以粘贴了, 可以用 Windows 画图板试试}

  TButton(Sender).Caption := '复制';
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  bit: TBitmap; {准备用一个 TBitmap 从剪切板中结束图片}
  x,y: Integer;
begin
  bit := TBitmap.Create;
  bit.Assign(Clipboard);               {从剪切板获取}
  x := Panel1.Width + Panel1.Left * 2; {x,y 是准备在窗体上的粘贴位置}
  y := Panel1.Top;
  Canvas.Draw(x, y, bit);              {粘贴就是画出来呗}
  bit.Free;

  TButton(Sender).Caption := '粘贴';
end;

end.

不过现在程序还有漏洞: 假如剪切板中没有东西, 粘贴什么? 如果剪切板中不是图片, 怎么粘贴?

其实我们只用 TClipboard.HasFormat 函数判断一下剪切板中是不是图片就行了.

第二版代码:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel1: TPanel;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Left := 0;
  Image1.Top := 0;
  Panel1.AutoSize := True;
  Image1.AutoSize := True;
  Image1.Picture.LoadFromFile('c:/temp/test.bmp');
  TButton(Sender).Caption := '导入';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  {如果 Image1 还没有图片, 就别复制了, 退出吧}
  if Image1.Picture = nil then Exit;

  Clipboard.Assign(Image1.Picture);
  TButton(Sender).Caption := '复制';
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  bit: TBitmap;
  x,y: Integer;
begin
  {如果当前剪切板中的东西不是图片, 就退出}
  if not Clipboard.HasFormat(CF_BITMAP) then Exit;

  bit := TBitmap.Create;
  bit.Assign(Clipboard);
  x := Panel1.Width + Panel1.Left * 2;
  y := Panel1.Top;
  Canvas.Draw(x, y, bit);
  bit.Free;
  TButton(Sender).Caption := '粘贴';
end;

end.

现在有出了新的问题: CF_BITMAP 常量表示图片, 其他格式怎么表示? 有多少格式可以用于剪切板?

使用剪切板[3]: SetComponent、GetComponent

本例演示把一个组件(TEdit)放入剪切板, 又取出(放到一个 TPanel 上)的过程.

放入剪切板的方法是个过程: SetComponent(要放入的组件);
取出的方法是个函数: GetComponent(指定属主, 指定父窗口): 函数返回取出的组件的句柄.

取出以前, 最好要判断一下当前剪切板中是不是个组件: HasFormat(CF_COMPONENT);

取出以前还必须要注册要取出的组件类, 譬如: RegisterClasses([TEdit]);

准备工作: 在窗体上添加 TEdit、TPanel 和三个按钮.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Clipbrd;

var obj: TComponent; {用于接受 GetComponent 的返回值}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.SetComponent(Edit1);
  TButton(Sender).Caption := '复制';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  RegisterClasses([TEdit]);
  if Clipboard.HasFormat(CF_COMPONENT) then
    obj := Clipboard.GetComponent(nil, Panel1);
  TButton(Sender).Caption := '粘贴';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if Assigned(obj) then obj.Free;
  TButton(Sender).Caption := '删除';
end;

end.

一般情况下, 应该把 RegisterClasses(); 过程提前放置(起码可以避免反复执行), 譬如在 Form1.OnCreate 事件中;
大家好像都习惯再提前到: initialization. 程序修改如下:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Clipbrd;

var obj: TComponent;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.SetComponent(Edit1);
  TButton(Sender).Caption := '复制';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if Clipboard.HasFormat(CF_COMPONENT) then
    obj := Clipboard.GetComponent(nil, Panel1);
  TButton(Sender).Caption := '粘贴';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if Assigned(obj) then obj.Free;
  TButton(Sender).Caption := '删除';
end;

initialization
  RegisterClasses([TEdit]);

end.

另外, 关于剪切板中格式的问题还没有详谈, 这里有来了一个 CF_COMPONENT.

Windows 系统已经定义了十几种剪切板的格式常数, 譬如: CF_BITMAP、CF_TEXT 等等;
不过这里的 CF_COMPONENT 是 Delphi 自定义的, 可以猜测: 在需要的时候, 我们也可以自定义剪切板中的格式.

使用剪切板[4]: 如果把子控件一起复制?

如果连同子控件一起复制到剪切板, 需要定义一个新类型.

譬如在一个 TPanel 中包含一个 TEdit; 在复制 TPanel 时, 若要连同 TEdit 一起复制, 需要重新从 TPanel 中继承出一个类来(譬如是 TMyPanel), 把 TEdit 包含在新的类中.

TMyPanel 类的单元:

unit MyPanel;

interface

uses Classes, StdCtrls, ExtCtrls;

type
  TMyPanel = class(TPanel)
    Edit1: TEdit; 
    constructor Create(AOwner: TComponent); override;
  end;

implementation

{ TMyPanel }

constructor TMyPanel.Create(AOwner: TComponent);
begin
  inherited;
  Edit1 := TEdit.Create(Self);
  Edit1.Parent := Self;
  Edit1.Left := 10;
  Edit1.Top := 10;
  RegisterClasses([TMyPanel]); {在这里就给注册了}
end;

end.

测试单元:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Clipbrd, MyPanel;

var
  obj: TComponent;
  pnl: TMyPanel;

procedure TForm1.FormCreate(Sender: TObject);
begin
  pnl := TMyPanel.Create(Self);
  pnl.Parent := Self;
  pnl.Edit1.Text := '一起被复制';

  Button1.Caption := '复制';
  Button2.Caption := '粘贴';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.SetComponent(pnl);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if Clipboard.HasFormat(CF_COMPONENT) then
  begin
    obj := Clipboard.GetComponent(Self, Self);
    TMypanel(obj).Left := 20;
    TMypanel(obj).Top := 60;
  end;
end;

end.

使用剪切板[5]: SetAsHandle、GetAsHandle - 自定义格式

如果要在剪切板中存放自己的格式, 需要用到 SetAsHandle、GetAsHandle 两个方法. SetAsHandle(用于剪切板的格式ID, 数据的内存句柄); 看这个方法的两个参数都有点麻烦. 自定义剪切板格式要用 RegisterClipboardFormat 函数; 第二个参数是内存句柄而不是内存地址, 能分配内存并返回句柄的函数暂时我只知道 GlobalAlloc、GlobalReAlloc 两个函数, 使用它们分配用于剪切板的内存时还须使用 GMEM_DDESHARE 标志. GetAsHandle(用于剪切板的格式ID) 方法返回的是数据所在内存的句柄. 通过内存句柄获取获取内存地址, 还要用到 GlobalLock 函数. 本例自定义了结构 TMyRec, 并指定了对应的剪切板格式 CF_MY.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Clipbrd;

Type
  TMyRec = record
    name: string[8];
    age : Byte;
  end;

var
  CF_MY: Word;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CF_MY := RegisterClipboardFormat('My Format');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  PRec: ^TMyRec;
  Data: THandle;
begin
  Data := GlobalAlloc(GMEM_DDESHARE, SizeOf(TMyRec));
  PRec := GlobalLock(Data);

  PRec.name := '张三';
  PRec.age  := 99;

  GlobalUnlock(Data);
  Clipboard.SetAsHandle(CF_MY, Data);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  PRec: ^TMyRec;
  Data: THandle;
begin
  if not Clipboard.HasFormat(CF_MY) then Exit;
  Data := Clipboard.GetAsHandle(CF_MY);
  PRec := GlobalLock(Data);

  ShowMessageFmt('%s %d 岁', [PRec.name, PRec.age]); {张三 99 岁}
  GlobalUnlock(Data);
end;

end.

//这个例子忘了 GlobalFree 了.

使用剪切板[6]: 把窗体客户区图像保存到文件或剪切板

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Clipbrd; {剪切板单元}

//把窗体客户区保存为图片
procedure TForm1.Button1Click(Sender: TObject);
var
  bit: TBitmap;
begin
  bit := TBitmap.Create;
  bit := Self.GetFormImage;
  bit.SaveToFile('c:/temp/img1.bmp');
  bit.Free;
end;

//用一句话完成上一个过程
procedure TForm1.Button2Click(Sender: TObject);
begin
  Self.GetFormImage.SaveToFile('c:/temp/img2.bmp');
end;

//把窗体客户区图像复制到剪切板
procedure TForm1.Button3Click(Sender: TObject);
var
  Format: Word;
  Data: Cardinal;
  APalette: HPALETTE;
begin
  {TBitmap.SaveToClipboardFormat 函数的三个参数都是接受数据用的, 按要求类型定义即可}
  GetFormImage.SaveToClipboardFormat(Format, Data, APalette);
  {放入剪切板}
  Clipboard.SetAsHandle(Format, Data);
end;

end.

Delphi操作剪贴板

热门文章

最新文章

相关电子书