Как сохранить содержимое буфера обмена и восстановить

← →
Int23 (2008-09-18 15:28) [0]

В программе использую буфер. Нужно сначало запомнить первоначальное состояние. Поработать с буфером а потом восстановить содержимое. Как такое сделать?

← →
Правильный$Вася (2008-09-18 15:36) [1]

tclipboard + F1

← →
Vlad Oshin © (2008-09-18 16:05) [2]

вообщем, вот. Писал для себя, на красоту не претендует
unit Unit1;

interface

uses
Windows, Messages, Forms, Classes, Controls, StdCtrls, Dialogs, ComCtrls,
Buttons, SysUtils ;

const
MOD_ALT = 1;
MOD_CONTROL = 2;
MOD_SHIFT = 4;
MOD_WIN = 8;

type
TForm1 = class(TForm)
Edit1: TEdit;
TrackBar1: TTrackBar;
Memo1: TMemo;
BitBtn1: TBitBtn;
Edit2: TEdit;
BitBtn2: TBitBtn;
Edit3: TEdit;
BitBtn3: TBitBtn;
Edit4: TEdit;
BitBtn4: TBitBtn;
Edit5: TEdit;
BitBtn5: TBitBtn;
Edit6: TEdit;
BitBtn6: TBitBtn;
Edit7: TEdit;
BitBtn7: TBitBtn;
Edit8: TEdit;
BitBtn8: TBitBtn;
Edit9: TEdit;
BitBtn9: TBitBtn;
BitBtn10: TBitBtn;
BitBtn11: TBitBtn;
BitBtn12: TBitBtn;
CheckBox1: TCheckBox;
procedure FormCreate(Sender : TObject);
procedure FormDestroy(Sender : TObject);
procedure TrackBar1Change(Sender: TObject);
procedure BitBtn10Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Memo1Click(Sender: TObject);
procedure BitBtn11Click(Sender: TObject);
private
First:boolean;
id1:integer;
ArrayCB:array[1..10] of string;
MAX:byte;
FNextClipboardViewer: HWND;
procedure WMChangeCBChain(var Msg : TWMChangeCBChain); message WM_CHANGECBCHAIN;
procedure WMDrawClipboard(var Msg : TWMDrawClipboard); message WM_DRAWCLIPBOARD;
procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
function GetClipboardText(Wnd: HWND; var Str: string): Boolean;
function SetClipboardText(Wnd: HWND; Value: string): Boolean;
procedure ViewForm(mode:byte);
end;

var
Form1 : TForm1;

implementation

{$R *.DFM}

procedure KDown(Key: byte); begin keybd_event(Key, 0, 0, 0); end;
procedure KUp(Key: byte); begin keybd_event(Key, 0, KEYEVENTF_KEYUP, 0); end;

function TForm1.SetClipboardText(Wnd: HWND; Value: string): Boolean;
var
hData: HGlobal;
pData: pointer;
Len: integer;
begin
Result := True;
if OpenClipboard(Wnd) then
begin
try
Len := Length(Value) + 1;
hData := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, Len);
try
pData := GlobalLock(hData);
try
Move(PChar(Value)^, pData^, Len);
EmptyClipboard;
SetClipboardData(CF_Text, hData);
finally
GlobalUnlock(hData);
end;
except
GlobalFree(hData);
raise
end;
finally
CloseClipboard;
end;
end
else
Result := False;
end;

procedure TForm1.ViewForm(mode:byte);
begin
case mode of
1:form1.Show;
0:form1.Hide;
end;
Application.CreateHandle;
ShowWindow(Application.Handle, SW_HIDE);
Application.ShowMainForm := FALSE;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
AlphaBlendValue:= TrackBar1.Position;
end;

function TForm1.GetClipboardText(Wnd: HWND; var Str: string): Boolean;
var
hData: HGlobal;
begin
Result := True;
if OpenClipboard(Wnd) then
begin
try
if not(IsClipboardFormatAvailable(CF_TEXT)) then exit;
hData := GetClipboardData(CF_TEXT);
if hData <> 0 then
begin
try
SetString(Str, PChar(GlobalLock(hData)), GlobalSize(hData));
finally
GlobalUnlock(hData);
end;
end
else
Result := False;
Str := PChar(@Str[1]);
finally
CloseClipboard;
end;
end
else
Result := False;
end;

procedure TForm1.Memo1Click(Sender: TObject);
begin
ViewForm(0);
KDown(VK_CONTROL);
KDown(ord("V"));
KUp(VK_CONTROL);
KUp(ord("V"));
end;

procedure TForm1.BitBtn11Click(Sender: TObject);
begin
close;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
s:string;
i:integer;
begin
// ShowMessage(inttostr(tBitBtn(sender).tag));
First:=true;
SetClipboardText(handle, ArrayCB[tBitBtn(sender).tag]);
s:=Memo1.Text;
Memo1.Text:=ArrayCB[tBitBtn(sender).tag];
ArrayCB[tBitBtn(sender).tag]:=s;
for I := 0 to form1.ComponentCount - 1 do
begin
if form1.Components[i] is TEdit then
begin
if (form1.Components[i] as Tedit).Tag=tBitBtn(sender).tag then
begin
(form1.Components[i] as Tedit).Text:=ArrayCB[tBitBtn(sender).tag];
end;
end;
end;

First:=false;
if not(checkbox1.Checked) then memo1click(sender);

end;

procedure TForm1.FormCreate(Sender : TObject);
begin
First:=false;
{ Initialize variable }
FNextClipboardViewer := 0;
MAX:=0;
FNextClipboardViewer := SetClipboardViewer(Handle);
ViewForm(0);

id1 := GlobalAddAtom("Hotkey-MOD+PTRSCR");
RegisterHotKey(Handle, id1, MOD_WIN, $56 );

// ShowMessage("10 ClpBrd started.");
ViewForm(1);
end;

procedure TForm1.BitBtn10Click(Sender: TObject);
var
s:string;
begin
ViewForm(0);
GetClipboardText(Handle,s);
memo1.Text:=s;
// First:=false;
end;

procedure TForm1.WMChangeCBChain(var Msg : TWMChangeCBChain);
begin
inherited;
if First then exit;
{ mark message as done }
Msg.Result := 0;
{ the chain has changed }
if Msg.Remove = FNextClipboardViewer then
{ The next window in the clipboard viewer chain had been removed. We recreate it. }
FNextClipboardViewer := Msg.Next
else
{ Inform the next window in the clipboard viewer chain }
SendMessage(FNextClipboardViewer, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next);
end;

procedure TForm1.WMDrawClipboard(var Msg : TWMDrawClipboard);
var
i:integer;
begin
inherited;
if First then exit;
try
if not(IsClipboardFormatAvailable(CF_TEXT)) then exit;
MAX:=MAX+1;
if MAX>10 then MAX:=1;
GetClipboardText(Handle, ArrayCB[MAX]);
for I := 0 to form1.ComponentCount - 1 do
begin
if form1.Components[i] is TEdit then
begin
if (form1.Components[i] as Tedit).Tag=MAX then
begin
(form1.Components[i] as Tedit).Text:=ArrayCB[MAX];
end;
end;
end;
finally
SendMessage(FNextClipboardViewer, WM_DRAWCLIPBOARD, 0, 0);
end;
end;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
if Msg.HotKey = id1
then begin
case form1.Visible of
True: ViewForm(0);
False: ViewForm(1);
end;
end;
end;

procedure TForm1.FormDestroy(Sender : TObject);
begin
if FNextClipboardViewer <> 0 then
begin
{ Remove from clipboard chain }
ChangeClipboardChain(Handle, FNextClipboardViewer);
FNextClipboardViewer := 0;
end;

UnRegisterHotKey(Handle, id1);
GlobalDeleteAtom(id1);
end;

initialization
IsLibrary := True;
end.

← →
Int23 (2008-09-18 16:16) [3]

спасибо. попробую

Как сохранить содержимое буфера обмена и восстановить Найти похожие ветки