//拷贝端
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.