delphi-操作剪贴板  
官方Delphi 学习QQ群： 682628230（三千人）
频道

  1. 人气：
  2. 放大
  3. 缩小
  4. 二维码
  5. 赞赏

delphi-操作剪贴板

使用剪切板[1]: AsText、SetTextBuf、GetTextBuf

剪切板类 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.
复制代码
 

使用剪切板[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.

推荐分享
最新信息 delphi13 多线程优化 TThreade... delphi 如何 FastMM配置 delphi13 FireDAC增强 并行备份... delphi12 Embarcadero ld... delphi 查看 cpu 核心数
热门信息 delphi 动态数组的使用 delphi多线程TThread详解 delphi try except语句 和 try finally语... delphi中常用字符串处理函数 delphi Inc函数和Dec函数的用法
推荐区 txt文本处理 查询128 说一段 简搜 短笑话 IP查询 正则大全 在线加密解密工具 在线文本筛选工具 1234828网址导航 windows库
图文皆来源于网络，内容仅做公益性分享，版权归原作者所有，如有侵权请告知删除！
  1. 关于我们
  2. 联系我们
 

Copyright © 2014 DelphiW.com 开发 源码 文档 技巧 All Rights Reserved
晋ICP备14006235号-8 晋公网安备 14108102000087号

执行时间: 0.46580600738525 seconds