delphi 将图像复制到剪贴板。

http://wapapp.baidu.com/_n_iu/item/aa6aa442722328f7dd0f6c7e

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.

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

发表于 2015-01-28 13:57 旷野轻尘一个人阅读(1816) 评论(0) 收藏举报

delphi 将图像 复制到剪贴板。

http://wapapp.baidu.com/_n_iu/item/aa6aa442722328f7dd0f6c7e

Delphi操作剪贴板