Просмотр буфера обмена

Code:

{ **** UBPFD *********** ****

>>

 Зависимости: clipboard

Автор:       Sect, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., Нижневартовск

Copyright:   Советы по Delphi

********************************************** }

unit ClipboardViewer;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs;

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

FNextViewerHandle : THandle;

procedure WMDrawClipboard (var message : TMessage);

message WM_DRAWCLIPBOARD;

procedure WMChangeCBCHain (var message : TMessage);

message WM_CHANGECBCHAIN;

public

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

// Проверяем работоспособность функции.

// При невозможности просмотра буфера обмена

// функция возвратит значение Nil.

FNextViewerHandle := SetClipboardViewer(Handle);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

// Восстанавливаем цепочки.

ChangeClipboardChain(Handle, FNextViewerHandle);

end;

procedure TForm1.WMDrawClipboard (var message : TMessage);

begin

// Вызывается при любом изменении содержимого буфера обмена

message.Result := SendMessage(WM_DRAWCLIPBOARD, FNextViewerHandle, 0, 0);

end;

procedure TForm1.WMChangeCBCHain (var message : TMessage);

begin

// Вызывается при любом изменении цепочек буфера обмена.

if message.wParam = FNextViewerHandle then begin

// Удаляем следующую цепочку просмотра. Корректируем внутреннюю переменную.

FNextViewerHandle := message.lParam;

// Возвращаем 0 чтобы указать, что сообщение было обработано

message.Result := 0;

end else begin

// Передаем сообщение следующему окну в цепочке.

message.Result := SendMessage(FNextViewerHandle, WM_CHANGECBCHAIN,

message.wParam, message.lParam);

end;

end;

end.

Code:

...

private

{ Private declarations }

PrevHwnd: Hwnd;

procedure WMChangeCBChain(var Msg: TWMChangeCBChain);

   message WM_CHANGECBCHAIN;

procedure WMDrawClipboard(var Msg: TWMDrawClipboard);

   message WM_DRAWCLIPBOARD;

...

procedure TForm1.WMChangeCBChain(var Msg: TWMChangeCBChain);

begin

if PrevHWnd = Msg.Remove then

   PrevHWnd := Msg.Next;

if Msg.Remove <> Handle then

   SendMessage(PrevHWnd, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next);

end;

procedure TForm1.WMDrawClipboard(var Msg: TWMDrawClipboard);

var

P: PChar;

H: THandle;

begin

SendMessage(PrevHWnd, WM_DRAWCLIPBOARD, 0, 0);

if Clipboard.HasFormat(CF_TEXT) then

begin

   H := Clipboard.GetAsHandle(CF_TEXT);

   Len := GlobalSize(H) + 1;

   P := GlobalLock(H);

   Memo1.SetTextBuf(P);

   GlobalUnlock(H);

end;

Msg.Result := 0;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

PrevHwnd := SetClipboardViewer(Handle);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

ChangeClipboardChain(Handle, PrevHwnd);

end;