|
将DELPHI下的代码复制到LAZARUS,不能执行,查资料才发现消息要自己写代码。
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
windows,Messages,Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
ComCtrls, StdCtrls, Grids, Buttons, Menus,clipbrd;
type
{ TForm1 }
TForm1 = class(TForm)
Bevel1: TBevel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
.....
private
FNextClipboardOwner: HWnd; {handle to the next viewer}
{Here are the clipboard event handlers}
function WMChangeCBChain(wParam: WParam; lParam: LParam) RESULT;
function WMDrawClipboard(wParam: WParam; lParam: LParam) RESULT;
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
var
PrevWndProc:windows.WNDPROC;
function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
lParam: LParam): LRESULT; stdcall;
begin
if uMsg=WM_CHANGECBCHAIN then
begin
result:=Form1.WMChangeCBChain(wParam,lParam);
exit;
end
else if uMsg=WM_DRAWCLIPBOARD then
begin
result:=Form1.WMDrawClipboard(wParam,lParam);
exit;
end;
result:=CallWindowProc(PrevWndProc,Ahwnd, uMsg, WParam, LParam);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
PrevWndProc:=Windows.WNDPROC(SetWindowLong(Self.Handle,GWL_WNDPROC,PtrInt(@WndCallback)));
FNextClipboardOwner := SetClipboardViewer(Self.Handle);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
//从观察链中删除本观察窗口
ChangeClipboardChain(Handle, FNextClipboardOwner);
end;
function TForm1.WMChangeCBChain(wParam: WParam; lParam: LParam): LRESULT;
var
Remove,Nextt: THandle;
begin
Remove := WParam;
Nextt := LParam;
if FNextClipboardOwner = Remove then
FNextClipboardOwner := Nextt
else if FNextClipboardOwner <> 0 then
SendMessage(FNextClipboardOwner, WM_ChangeCBChain, Remove, Nextt)
end;
function TForm1.WMDrawClipboard(wParam: WParam; lParam: LParam): LRESULT;
var
s1,s2:string;
hTopWin,tw2:THandle;
begin
if Clipboard.HasFormat(CF_TEXT) Then // if (Clipboard.HasFormat(CF_TEXT) or Clipboard.HasFormat(CF_OEMTEXT)) then
Begin
ShowMessage(Clipboard.AsText);
end;
SendMessage(FNextClipboardOwner, WM_DRAWCLIPBOARD, 0, 0); {VERY IMPORTANT!}
Result := 0;
end;
end.
|
|