WndProc, WindowProc

Akni · Hält's aus hier Beiträge: 7

Hi Leute,
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“

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:

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.

Ehemaliges Mitglied Erhaltene Danke: 1

Hier wurde dir geantwortet.

Tino · Beiträge: 9839 Erhaltene Danke: 45 Windows 8.1 Delphi XE4

Hier die o. g. Antwort:

jbg aus Delphi-Praxis hat folgendes geschrieben:

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.

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:

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

 PWndProcRec = ^TWndProcRec; 
 TWndProcRec = record
  OrgWndProc: TWndMethod; 
  NewWndProc: TWndMethodEx; 
  Control: TControl; 
 end; 

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

  procedure ClearFromOwner(AOwner: TComponent); 
  procedure Clear; override; 
 end; 

var
 WndProcList: TWndProcList; 

implementation

type
 TWndMethodRec = record
  Code: Pointer; 
  Obj: TObject; 
 end; 

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

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

 Proc := TransferWndProc; 
 TWndMethodRec(Proc).Obj := Control; 
 Control.WindowProc := Proc; 
end; 

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

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

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

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

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

initialization
 WndProcList := TWndProcList.Create; 

finalization
 WndProcList.Free; 

end.

Und hier die Verwendung der Unit:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:

procedure TForm1.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
  WMessage.msg:=Message; 

  bNewMessage:=true; 
  end; 
 end; 
 OrgWndProc(Message); 
end; 

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

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

Akni · Hält's aus hier Beiträge: 7

to Tino
Danke! Das wird mir bestimmt weiter helfen!

Ehemaliges Mitglied Erhaltene Danke: 1

Warum bedankst du dich bei Tino? :roll:

Weil er auf den Link geklickt hast, wozu du nicht fähig warst? :shock:

Tino · Beiträge: 9839 Erhaltene Danke: 45 Windows 8.1 Delphi XE4

Luckie hat folgendes geschrieben:

Warum bedankst du dich bei Tino?

Vielleicht weil ich mir die Mühe gemacht habe das Wissen auch hier in AUQ zu sichern. Wer weiß wie lange sich solche Links überhaupt im Web halten? :shock:

Aber letztendlich hast Du recht und er sollte sich bei jbg bedanken :-D

Gruß
TINO

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme