unit1.pas

来自「在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码」· PAS 代码 · 共 62 行

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Clipbrd, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
     NextViewerHandle : THandle;
     procedure WMDrawClipboard (var message : TMessage);message WM_DRAWCLIPBOARD;
     procedure WMChangeCBCHain (var message : TMessage); message WM_CHANGECBCHAIN;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
   NextViewerHandle := SetClipboardViewer(Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   ChangeClipboardChain(Handle, NextViewerHandle);
end;

procedure TForm1.WMDrawClipboard (var message : TMessage);
begin
    message.Result := SendMessage(WM_DRAWCLIPBOARD, NextViewerHandle, 0, 0);
    if (Clipboard.HasFormat(CF_TEXT) or Clipboard.HasFormat(CF_OEMTEXT)) then
    begin
        Memo1.Clear;
        Memo1.Text:=Clipboard.asText;
    end;
end;

procedure TForm1.WMChangeCBCHain (var message : TMessage);
begin
    if message.wParam = NextViewerHandle then
    begin
       NextViewerHandle := message.lParam;
       message.Result := 0;
    end else  begin 
       message.Result := SendMessage(NextViewerHandle, WM_CHANGECBCHAIN,message.wParam, message.lParam);
    end;
end;

end.