unit SubMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
BtnShow: TButton;
BtnProc: TButton;
BtnMeth: TButton;
procedure BtnShowClick(Sender: TObject);
procedure BtnMethClick(Sender: TObject);
procedure BtnProcClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
OldWndMeth, NewWndMeth: Pointer;
SubControl: TWinControl;
public
procedure NewWinMethod (var Msg: TMessage);
end;
var
Form1: TForm1;
implementation
uses SubSecon;
{$R *.DFM}
var
OldWndProc: Pointer = nil;
function NewWinProc (Handle: THandle;
Msg, wParam, lParam: LongInt): LongInt; stdcall;
begin
if Msg = wm_RButtonDown then
begin
Beep;
SetWindowText (Handle,
PChar (Format ('Right click in %d, %d', [
LoWord (lParam), HiWord (lParam)])));
end;
// pass call to old window proc
Result := CallWindowProc (OldWndProc, Handle,
Msg, wParam, lParam);
end;
procedure TForm1.NewWinMethod (var Msg: TMessage);
begin
if Msg.Msg = wm_LButtonDown then
begin
Beep;
SubControl.SetTextBuf (
PChar (Format ('Left click in %d, %d', [
LoWord (Msg.lParam), HiWord (Msg.lParam)])));
end
else
Msg.Result := CallWindowProc (OldWndMeth,
SubControl.Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;
procedure TForm1.BtnShowClick(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm1.BtnProcClick(Sender: TObject);
begin
OldWndProc := Pointer (SetWindowLong
(Form2.Handle, gwl_WndProc, LongInt (@NewWinProc)));
BtnProc.Enabled := False;
end;
procedure TForm1.BtnMethClick(Sender: TObject);
begin
SubControl := Form2;
NewWndMeth := MakeObjectInstance (NewWinMethod);
OldWndMeth := Pointer (SetWindowLong (
SubControl.Handle, gwl_WndProc, Longint (NewWndMeth)));
BtnMeth.Enabled := False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned (NewWndMeth) then
FreeObjectInstance (NewWndMeth);
end;
end.
|