使用剪切板[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.
//这个例子忘了 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.
