Переопределение оконной процедуры и метода для другой формы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

unit SubSecon;

interface

uses

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

type

TForm2 = class(TForm)

procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

Caption := Format (‘Cursor in %d, %d’, [X, Y]);

end;

end.

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.

Загрузить исходный код проекта

{/codecitation}

Добавить комментарий