WndProc, WindowProc

[Akni]

Hi,
kann mir vielleicht jemand bei so einem Problem helfen: ich muss Botschaften empfangen, die an ein bestimmtes MDI-Fenster gesendet werden (an alle Controls, die zu dem Fenster gehören). Wenn ich versuche, mit folgendem Code WindowProc für alle Controls zu ersetzen, dann bekomme ich „Stack-Überlauf“

Code:

TISMessage=record
  msg: TMessage;
  Pt: TPoint;
end;

var Wmessage: TISMessage;

procedure TfrmMDIChild.ISWndProc(var message: TMessage);
begin
  with message do
  begin
   if (msg=WM_LBUTTONDOWN)
    or (msg=WM_LBUTTONUP)
    or (msg=WM_LBUTTONDBLCLK)
    or (msg=WM_RBUTTONDOWN)
    or (msg=WM_RBUTTONUP)
    or (msg=WM_RBUTTONDBLCLK)
   then
   begin
    WMessage.msg:=Message;
    
    bNewMessage:=true;
   end;
  end;
  Inherited WndProc(Message);
end;

procedure TfrmMDIChild.FormCreate(Sender: TObject);
var i: integer;
begin
 for i:=0 to ControlCount-1 do
  begin
    Controls[i].WindowProc:=ISWndProc;
  end;
……….
end;

Was mache ich falsch und wie kann man das richtig realisieren?

Vielen Dank im voraus,
Akni

[jbg]

Da muss ich dich enttäuschen. Das geht nicht so einfach. Du hast 2 logische Fehler in deinem Code.

1. Du hast vergessen den vorherigen Wert von WindowProc zu sichern. Mit diesem Wert hättest du die Möglichkeit die "alte" WindowProc aufzurufen, die nicht unbeding auf WndProc zeigen muss.

2. Mit dem inherited WndProc rufst du für jedes Control die WndProc von TForm auf und nicht die des entsprechenden Controls.

Hier hast du eine Unit, die dir die Arbeit abnimmt.

Code:

[b]unit[/b] WndProcHooks;
[b]interface[/b]
[b]uses[/b] Windows, Messages, SysUtils, Classes, Controls;
[b]type[/b]
  TWndMethodEx = [b]procedure[/b](Control: TControl; [b]var[/b] [b]Message[/b]: TMessage;
    OrgWndProc: TWndMethod) [b]of[/b] [b]object[/b];

  PWndProcRec = ^TWndProcRec;
  TWndProcRec = [b]record[/b]
    OrgWndProc: TWndMethod;
    NewWndProc: TWndMethodEx;
    Control: TControl;
  [b]end[/b];

  TWndProcList = [b]class[/b](TList)
  [b]private[/b]
    [b]function[/b] GetIndex(Control: TControl): Integer;
  [b]protected[/b]
    [b]procedure[/b] TransferWndProc([b]var[/b] [b]Message[/b]: TMessage); [b]virtual[/b];
  [b]public[/b]
    [b]procedure[/b] HookControl(Control: TControl; NewWndProc: TWndMethodEx);
    [b]procedure[/b] UnhookControl(Control: TControl);
    [b]function[/b] FindOrgWndProc(Control: TControl): TWndMethod;

    [b]procedure[/b] ClearFromOwner(AOwner: TComponent);
    [b]procedure[/b] Clear; [b]override[/b];
  [b]end[/b];

[b]var[/b]
  WndProcList: TWndProcList;

[b]implementation[/b]

[b]type[/b]
  TWndMethodRec = [b]record[/b]
    Code: Pointer;
    Obj: TObject;
  [b]end[/b];

[b]function[/b] TWndProcList.GetIndex(Control: TControl): Integer;
[b]begin[/b]
  [b]for[/b] Result := 0 [b]to[/b] Count - 1 [b]do[/b]
    [b]if[/b] PWndProcRec(Items[Result])^.Control = Control [b]then[/b]
      Exit;
  Result := -1;
[b]end[/b];

[b]procedure[/b] TWndProcList.HookControl(Control: TControl; NewWndProc: TWndMethodEx);
[b]var[/b]
  P: PWndProcRec;
  Proc: TWndMethod;
[b]begin[/b]
  New(P);
  P^.Control := Control;
  P^.OrgWndProc := Control.WindowProc;
  P^.NewWndProc := NewWndProc;
  Add(P);

  Proc := TransferWndProc;
  TWndMethodRec(Proc).Obj := Control;
  Control.WindowProc := Proc;
[b]end[/b];

[b]procedure[/b] TWndProcList.UnhookControl(Control: TControl);
[b]var[/b]
  Index: Integer;
  P: PWndProcRec;
[b]begin[/b]
  Index := GetIndex(Control);
  [b]if[/b] Index <> -1 [b]then[/b]
  [b]begin[/b]
    P := PWndProcRec(Items[Index]);
    Control.WindowProc := P^.OrgWndProc;
    Dispose(P);
    Delete(Index);
  [b]end[/b];
[b]end[/b];

[b]function[/b] TWndProcList.FindOrgWndProc(Control: TControl): TWndMethod;
[b]var[/b] Index: Integer;
[b]begin[/b]
  Index := GetIndex(Control);
  [b]if[/b] Index <> -1 [b]then[/b] Result := PWndProcRec(Items[Index])^.OrgWndProc;
[b]end[/b];

[b]procedure[/b] TWndProcList.ClearFromOwner(AOwner: TComponent);
[b]var[/b]
  Index: Integer;
  P: PWndProcRec;
[b]begin[/b]
  [b]for[/b] Index := Count - 1 [b]downto[/b] 0 [b]do[/b]
  [b]begin[/b]
    P := PWndProcRec(Items[Index]);
    [b]if[/b] P^.Control.Owner = AOwner [b]then[/b]
    [b]begin[/b]
      P^.Control.WindowProc := P^.OrgWndProc;
      Dispose(P);
      Delete(Index);
    [b]end[/b];
  [b]end[/b];
[b]end[/b];

[b]procedure[/b] TWndProcList.Clear;
[b]var[/b]
  Index: Integer;
  P: PWndProcRec;
[b]begin[/b]
  [b]for[/b] Index := 0 [b]to[/b] Count - 1 [b]do[/b]
  [b]begin[/b]
    P := PWndProcRec(Items[Index]);
    P^.Control.WindowProc := P^.OrgWndProc;
    Dispose(P);
  [b]end[/b];
  [b]inherited[/b] Clear;
[b]end[/b];

[b]procedure[/b] TWndProcList.TransferWndProc([b]var[/b] [b]Message[/b]: TMessage);
[b]var[/b]
  i: Integer;
  P: PWndProcRec;
  OrgWndProc: TWndMethod;
[b]begin[/b]
  [color=#000080][i]// Self zeigt auf das Control[/i][/color]
  i := WndProcList.GetIndex(TControl(Self));
  [b]if[/b] i <> -1 [b]then[/b]
  [b]begin[/b]
    P := PWndProcRec(WndProcList.Items[i]);
    OrgWndProc := P^.OrgWndProc;
    [b]if[/b] ([b]Message[/b].Msg = WM_DESTROY) [b]or[/b] (csDestroying [b]in[/b] P^.Control.ComponentState) [b]then[/b]
    [b]begin[/b]
      WndProcList.UnhookControl(P^.Control);
      OrgWndProc([b]Message[/b]);
    [b]end[/b]
    [b]else[/b]
      P^.NewWndProc(P^.Control, [b]Message[/b], OrgWndProc);
  [b]end[/b];
[b]end[/b];

[b]initialization[/b]
  WndProcList := TWndProcList.Create;

[b]finalization[/b]
  WndProcList.Free;

[b]end[/b].

Und hier die Verwendung der Unit:

Code:

[b]procedure[/b] TForm1.ISWndProc(Control: TControl; [b]var[/b] [b]Message[/b]: TMessage;
  OrgWndProc: TWndMethod);
[b]begin[/b]
  [b]with[/b] [b]Message[/b] [b]do[/b]
  [b]begin[/b]
   [b]if[/b] (msg=WM_LBUTTONDOWN)
    [b]or[/b] (msg=WM_LBUTTONUP)
    [b]or[/b] (msg=WM_LBUTTONDBLCLK)
    [b]or[/b] (msg=WM_RBUTTONDOWN)
    [b]or[/b] (msg=WM_RBUTTONUP)
    [b]or[/b] (msg=WM_RBUTTONDBLCLK)
   [b]then[/b]
   [b]begin[/b]
    WMessage.msg:=[b]Message[/b];

    bNewMessage:=true;
   [b]end[/b];
  [b]end[/b];
  OrgWndProc([b]Message[/b]);
[b]end[/b];

[b]procedure[/b] TForm1.FormCreate(Sender: TObject);
[b]var[/b] Index: integer;
[b]begin[/b]
  [b]for[/b] Index := 0 [b]to[/b] ControlCount - 1 [b]do[/b]
    WndProcList.HookControl(Controls[Index], ISWndProc);
[b]end[/b];

[b]procedure[/b] TForm1.FormDestroy(Sender: TObject);
[b]begin[/b]
  WndProcList.ClearFromOwner(Self);
[b]end[/b];

[Akni]

to jbg

Vielen Dank für deine Hilfe, aber das funkt bei mir immer noch nicht richtig. Vielleicht mache ich wieder was falsch?
Jetzt habe ich ein kleines Testprogramm geschrieben, das aus zwei Module besteht:

Code:

unit UntMain;
interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
uses untMDI;

procedure TForm1.Button1Click(Sender: TObject);
var MdiForm: TMDIChild;
begin
  MDiForm:=TMDIChild.Create(Application);
  MDiForm.Show;
end;
end.


unit untMDI;
interface

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

type
  TMDIChild = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    bNewMessage: boolean;
    procedure ISWndProc(Control: TControl; var Message: TMessage;OrgWndProc: TWndMethod);
  public
    { Public-Deklarationen }
  end;

var
  MDIChild: TMDIChild;

implementation

{$R *.DFM}
procedure TMDIChild.ISWndProc(Control: TControl; var Message: TMessage;
  OrgWndProc: TWndMethod);
begin
OrgWndProc(Message);
with Message do
begin
  if (msg=WM_LBUTTONDOWN)
  or (msg=WM_LBUTTONUP)
  or (msg=WM_LBUTTONDBLCLK)
  or (msg=WM_RBUTTONDOWN)
  or (msg=WM_RBUTTONUP)
  or (msg=WM_RBUTTONDBLCLK)
  then
  begin
  ShowMessage('Hallo! FormHandle='+IntToStr(Self.Handle));
  bNewMessage:=true;
  end;
end;
end;

procedure TMDIChild.FormCreate(Sender: TObject);
var Index: integer;
begin
for Index := 0 to ControlCount - 1 do
  WndProcList.HookControl(Controls[Index], ISWndProc);
end;

procedure TMDIChild.FormDestroy(Sender: TObject);
begin
WndProcList.ClearFromOwner(Self);
end; 

procedure TMDIChild.Button1Click(Sender: TObject);
begin
 ShowMessage('Button1.Click');
end;

end.

Und wenn ich das Programm starte, passiert folgendes:
Wenn ich auf irgendein Control draufklicke, erscheint die Meldung "Hallo! FormHandle=…"
Die Meldung "Button1.Click" erscheint aber nicht.

Wenn OrgWndProc(Message) in der Prozedur ISWndProc an erster Stelle steht, dann wird ISWndProc nur für die Controls aufgerufen, die zu MDI-Form gehören (so wie ich es auch brauche).
Wenn aber OrgWndProc(Message) am Ende der Prozedur steht, dann wird ISWndProc immer aufgerufen, egal wo ich draufklicke.

Kannst du mir vielleicht noch ein Paar gute Tipps geben, wie ich dieses Problem endlich lösen kann?

Mfg
Akni

[jbg]

Zitat von Akni:

to jbg

Hat hier noch jemand anderes geantwortet?

Zitat:

Vielleicht mache ich wieder was falsch?

Nur ein kleiner logischer Fehler

Zitat:

Und wenn ich das Programm starte, passiert folgendes:
Wenn ich auf irgendein Control draufklicke, erscheint die Meldung "Hallo! FormHandle=…"
Die Meldung "Button1.Click" erscheint aber nicht.

Genau dieses Phänomen ist der logische Fehler.

Zitat:

Wenn aber OrgWndProc(Message) am Ende der Prozedur steht, dann wird ISWndProc immer aufgerufen, egal wo ich draufklicke.

Dies resultiert aus dem logischen Fehler (den ich übringens gleich auflösen werde). Jedoch ist deine Beschreibung nicht korrekt. Der Button ist der Meinung, dass du immernoch die Mousetaste gedrückt hälst.

Zitat:

Kannst du mir vielleicht noch ein Paar gute Tipps geben, wie ich
dieses Problem endlich lösen kann?

Der logische Fehler besteht darin, dass du ShowMessage aufrufst. Diese Funktion öffnet ein modales Fenster (ShowModal). Dadurch kommt es zu dem Problem, dass alle noch anstehenden Botschaften, die eigentlich für den Button gedacht sind, an das modale Fenster geschickt werden. Somit bekommt der Button nicht mit, dass du die Mousetaste bereits losgelassen hast. Zur Lösung des Problems musst du nur den ShowMessage-Aufruf entfernen. Wenn du jedoch unbedingt ein ShowMessage/MessageDlg/ShowModal brauchst, dann kannst du dies folgendermaßen erledigen.

Code:

const
  WM_MOUSEMESSAGE = WM_USER + 1;
type
 ...
 protected
   procedure WMMouseMessage(var Message: TMessage); message WM_MOUSEMESSAGE;
 private 
   { Private-Deklarationen } 
   FMouseMessageList: TStringList;
   bNewMessage: boolean; 
   procedure ISWndProc(Control: TControl; var Message: TMessage;OrgWndProc: TWndMethod); 
  public 
    { Public-Deklarationen } 
  end; 


implem...

procedure TMDIChild.WMMouseMessage(var Message: TMessage);
var s: string;
begin
  s := FMouseMessageList[FMouseMessageList.Count - 1];
  FMouseMessageList.Delete(FMouseMessageList.Count - 1);
  ShowMessage(s);
end;

procedure TMDIChild.ISWndProc(Control: TControl; var Message: TMessage;
  OrgWndProc: TWndMethod);
begin
  with Message do
  begin
    if (msg=WM_LBUTTONDOWN)
    or (msg=WM_LBUTTONUP)
    or (msg=WM_LBUTTONDBLCLK)
    or (msg=WM_RBUTTONDOWN)
    or (msg=WM_RBUTTONUP)
    or (msg=WM_RBUTTONDBLCLK)
    then
    begin
      FMouseMessageList.Add('Hallo! FormHandle='+IntToStr(Self.Handle));
      PostMessage(Handle, WM_MOUSEMESSAGE, 0, 0);
      bNewMessage:=true;
    end;
  end;
  OrgWndProc(Message);
end;

FMouseMessageList muss in OnCreate erzeugt und in OnDestroy wieder freigegen werden.


Mfg
Akni[/quote]