unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls...;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
function GetClipBoardText: string;
procedure SetClipBoardText(const Value: string);
procedure Open;
procedure SetBuffer(Format: Word; var Buffer; Size: Integer);
procedure Adding;
procedure Clear;
constructor CreateRes(Ident: Integer);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
FOpenRefCount: Integer;
FClipboardWindow: HWND;
FAllocated: Boolean;
FEmptied: Boolean;
FMessage: string;
public
{ Public declarations }
end;
var
Form1: TForm1;
resourcestring
SCannotOpenClipboard = 'Cannot open clipboard';
implementation
{$R *.dfm}
//Create resource for resourceString
constructor TForm1.CreateRes(Ident: Integer);
begin
FMessage := LoadStr(Ident);
end;
//Status: Adding
procedure TForm1.Adding;
begin
if (FOpenRefCount <> 0) and not FEmptied then
begin
Clear;
FEmptied := True;
end;
end;
//Empty clipboard
procedure TForm1.Clear;
begin
Open;
try
EmptyClipboard;
finally
Close;
end;
end;
//Set buffer
procedure TForm1.SetBuffer(Format: Word; var Buffer; Size: Integer);
var
Data: THandle;
DataPtr: Pointer;
begin
Open;
try
Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, Size);
try
DataPtr := GlobalLock(Data);
try
Move(Buffer, DataPtr^, Size);
Adding;
SetClipboardData(Format, Data);
finally
GlobalUnlock(Data);
end;
except
GlobalFree(Data);
raise;
end;
finally
Close;
end;
end;
//Open the clipboard
procedure TForm1.Open;
begin
if FOpenRefCount = 0 then
begin
FClipboardWindow := Application.Handle;
if FClipboardWindow = 0 then
begin
{$IFDEF MSWINDOWS}
FClipboardWindow := Classes.AllocateHWnd(MainWndProc);
{$ENDIF}
{$IFDEF LINUX}
FClipboardWindow := WinUtils.AllocateHWnd(MainWndProc);
{$ENDIF}
FAllocated := True;
end;
if not OpenClipboard(FClipboardWindow) then
raise Exception.CreateRes(@SCannotOpenClipboard);
FEmptied := False;
end;
Inc(FOpenRefCount);
end;
//Get the clipboard text
function TForm1.GetClipBoardText: string;
var
Data: THandle;
begin
Open;
Data := GetClipboardData(CF_TEXT);
try
if Data <> 0 then
Result := PChar(GlobalLock(Data))
else
Result := '';
finally
if Data <> 0 then GlobalUnlock(Data);
Close;
end;
end;
procedure TForm1.SetClipBoardText(const Value: string);
begin
//Set ClipboardText
SetBuffer(CF_TEXT, PChar(Value)^, Length(Value) + 1);
end;
//Get the clipboard text
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetClipboardText);
end;
//Set the clipboard text
procedure TForm1.Button2Click(Sender: TObject);
begin
SetClipboardText('-> Big-X <-');
end;
end.
|
