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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
| {******************************************************************************}
{* *}
{* Control resize bugfix for kernel stack overflow due to WH_CALLWNDPROC hook *)
{* Version 1.1 (2008-05-25) *}
{* *}
{* (C) 2008 Andreas Hausladen (<a href="mailto:Andreas.Hausladen@gmx.de">Andreas.Hausladen@gmx.de</a>) *}
{* *}
{******************************************************************************}
{$A+,B-,C+,D-,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
{ Usage:
Add the unit to the .dpr file's uses-list.
Example:
uses
FastMM4, // optional memory manager
ControlResizeBugFix,
Forms,
Unit1 in 'Unit1.pas';
History:
2008-05-25:
- Added code to detect endless resizing controls.
- Added experimental OPTIMIZED_RESIZE_REDRAW option for faster form resizing
2008-05-24:
- Initial release
}
unit ControlResizeBugFix;
{.$DEFINE OPTIMIZED_RESIZE_REDRAW}
{ The OPTIMIZED_RESIZE_REDRAW option is experimental. It speeds up the resizing of forms
by not redrawing each control when it is realigned but by invalidating them all after
one align round is done. }
{$UNDEF DEBUG} // undef any global DEBUG conditions
{.$DEFINE DEBUG}
{ The DEBUG option activates the source code debugging of this unit. }
interface
{$IFDEF DEBUG}
{$D+}
{$ENDIF}
implementation
uses
Windows, Messages, SysUtils, Classes, Controls;
{$IFDEF CONDITIONALEXPRESSIONS}
{$IF CompilerVersion >= 18.0}
{$DEFINE DELPHI2006_UP}
{$IFEND}
{$IF CompilerVersion >= 17.0}
{$DEFINE DELPHI2005_UP}
{$IFEND}
{$ENDIF}
type
TFixWinControl = class(TWinControl)
private
procedure AlignControl(AControl: TControl);
procedure HandleAlignControls(AControl: TControl; var R: TRect);
protected
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
end;
TOpenWinControl = class(TWinControl);
{$IFNDEF DELPHI2005_UP}
TD5WinControlPrivate = class(TControl)
public
FAlignLevel: Word;
end;
{$ENDIF ~DELPHI2005_UP}
threadvar
AlignControlList: TList;
procedure TFixWinControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
WindowPlacement: TWindowPlacement;
begin
if (ALeft <> Left) or (ATop <> Top) or
(AWidth <> Width) or (AHeight <> Height) then
begin
if HandleAllocated and not IsIconic(WindowHandle) then
begin
if AlignControlList <> nil then
SetWindowPos(WindowHandle, 0, ALeft, ATop, AWidth, AHeight,
SWP_NOZORDER or SWP_NOACTIVATE or SWP_DEFERERASE)
else
SetWindowPos(WindowHandle, 0, ALeft, ATop, AWidth, AHeight,
SWP_NOZORDER or SWP_NOACTIVATE);
end
else
begin
PInteger(@Left)^ := ALeft;
PInteger(@Top)^ := ATop;
PInteger(@Width)^ := AWidth;
PInteger(@Height)^ := AHeight;
if HandleAllocated then
begin
WindowPlacement.Length := SizeOf(WindowPlacement);
GetWindowPlacement(WindowHandle, @WindowPlacement);
WindowPlacement.rcNormalPosition := BoundsRect;
SetWindowPlacement(WindowHandle, @WindowPlacement);
end;
end;
UpdateBoundsRect(Rect(Left, Top, Left + Width, Top + Height));
RequestAlign;
end;
end;
procedure TFixWinControl.HandleAlignControls(AControl: TControl; var R: TRect);
function AlignWork: Boolean;
var
I: Integer;
begin
Result := True;
for I := ControlCount - 1 downto 0 do
if (Controls[I].Align <> alNone) or
(Controls[I].Anchors <> [akLeft, akTop]) then
Exit;
Result := False;
end;
var
OwnAlignControlList, TempAlignControlList: TList;
ResizeList: TList;
ResizeCounts: TList; // of Integer
Ctrl: TWinControl;
I, Index: Integer;
begin
if AlignWork then
begin
OwnAlignControlList := nil;
try
if AlignControlList = nil then
begin
OwnAlignControlList := TList.Create;
AlignControlList := OwnAlignControlList;
end;
AlignControls(AControl, R);
if (OwnAlignControlList <> nil) and (OwnAlignControlList.Count > 0) then
begin
{ Convert recursion into an iteration to prevent the kernel stack overflow }
ResizeList := TList.Create;
ResizeCounts := TList.Create;
try
{ The controls in the OwnAlignControlList must be added to ResizeList in reverse order.
Otherwise the OnResize events aren't fired in correct order. }
AlignControlList := TList.Create;
try
repeat
try
for I := OwnAlignControlList.Count - 1 downto 0 do
begin
Ctrl := TWinControl(OwnAlignControlList[I]);
Index := ResizeList.IndexOf(Ctrl);
{ An endless resizing component was stopped by the kernel stack overflow bug.
So we must catch this condition to prevent an endless loop. }
if (Index = -1) or (Integer(ResizeCounts[Index]) < 30) then
begin
Ctrl.Realign;
if Index <> -1 then
ResizeCounts[Index] := Pointer(Integer(ResizeCounts[Index]) + 1);
ResizeCounts.Add(Pointer(0)); // keep index in sync
ResizeList.Add(Ctrl);
end
else if Index <> -1 then
begin
{$WARNINGS OFF}
if DebugHook <> 0 then
{$WARNINGS ON}
OutputDebugString(PChar(Format('The component "%s" of class %s has an endless resize loop', [Ctrl.Name, Ctrl.ClassName])));
end;
end;
finally
OwnAlignControlList.Clear;
{ Switch lists }
TempAlignControlList := AlignControlList;
AlignControlList := OwnAlignControlList;
OwnAlignControlList := TempAlignControlList;
end;
until (OwnAlignControlList.Count = 0) {or EndlessResizeDetection};
finally
{ Let another AlignControlList handle any alignment that comes from the
OnResize method. }
FreeAndNil(AlignControlList);
end;
{ Fire Resize events }
for I := ResizeList.Count - 1 downto 0 do
begin
Ctrl := TWinControl(ResizeList[I]);
if not (csLoading in Ctrl.ComponentState) then
TOpenWinControl(Ctrl).Resize;
end;
finally
ResizeCounts.Free;
ResizeList.Free;
end;
{$IFDEF OPTIMIZED_RESIZE_REDRAW}
Invalidate;
{$ENDIF OPTIMIZED_RESIZE_REDRAW}
end;
finally
if OwnAlignControlList <> nil then
begin
AlignControlList := nil;
FreeAndNil(OwnAlignControlList);
end;
end;
end
else
AlignControls(AControl, R);
end;
procedure TFixWinControl.WMSize(var Message: TWMSize);
begin
{$IFDEF DELPHI2005_UP}
UpdateBounds;
{$IFDEF DELPHI2006_UP}
UpdateExplicitBounds;
{$ENDIF DELPHI2006_UP}
{$ELSE}
if HandleAllocated then
Perform(WM_MOVE, 0, LPARAM(Left and $0000ffff) or (Top shl 16)); // calls the private UpdateBounds
{$ENDIF DELPHI2005_UP}
DefaultHandler(Message);
if AlignControlList <> nil then
begin
if AlignControlList.IndexOf(Self) = -1 then
AlignControlList.Add(Self)
end
else
begin
Realign;
if not (csLoading in ComponentState) then
Resize;
end;
end;
procedure TFixWinControl.AlignControl(AControl: TControl);
var
Rect: TRect;
begin
if not HandleAllocated or (csDestroying in ComponentState) then
Exit;
{$IFDEF DELPHI2005_UP}
if AlignDisabled then
{$ELSE}
if TD5WinControlPrivate(Self).FAlignLevel <> 0 then
{$ENDIF DELPHI2005_UP}
ControlState := ControlState + [csAlignmentNeeded]
else
begin
DisableAlign;
try
Rect := GetClientRect;
HandleAlignControls(AControl, Rect);
finally
ControlState := ControlState - [csAlignmentNeeded];
EnableAlign;
end;
end;
end;
{---------------------------------------------------------------------------}
type
TInjectRec = packed record
Jump: Byte;
Offset: Integer;
end;
PWin9xDebugThunk = ^TWin9xDebugThunk;
TWin9xDebugThunk = packed record
PUSH: Byte;
Addr: Pointer;
JMP: Byte;
Offset: Integer;
end;
PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
TAbsoluteIndirectJmp = packed record
OpCode: Word; //$FF25(Jmp, FF /4)
Addr: ^Pointer;
end;
function GetActualAddr(Proc: Pointer): Pointer;
function IsWin9xDebugThunk(AAddr: Pointer): Boolean;
begin
Result := (AAddr <> nil) and
(PWin9xDebugThunk(AAddr).PUSH = $68) and
(PWin9xDebugThunk(AAddr).JMP = $E9);
end;
begin
if Proc <> nil then
begin
if (Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(Proc) then
Proc := PWin9xDebugThunk(Proc).Addr;
if (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
Result := PAbsoluteIndirectJmp(Proc).Addr^
else
Result := Proc;
end
else
Result := nil;
end;
function CodeRedirect(Proc: Pointer; NewProc: Pointer): TInjectRec;
var
OldProtect: Cardinal;
begin
if Proc = nil then
Exit;
Proc := GetActualAddr(Proc);
if VirtualProtect(Proc, SizeOf(TInjectRec), PAGE_EXECUTE_READWRITE, OldProtect) then
begin
Result := TInjectRec(Proc^);
TInjectRec(Proc^).Jump := $E9;
TInjectRec(Proc^).Offset := Integer(NewProc) - (Integer(Proc) + SizeOf(TInjectRec));
VirtualProtect(Proc, SizeOf(TInjectRec), OldProtect, @OldProtect);
FlushInstructionCache(GetCurrentProcess, Proc, SizeOf(TInjectRec));
end;
end;
{---------------------------------------------------------------------------}
function GetAlignControlProc: Pointer;
var
P: PByteArray;
Offset: Integer;
MemInfo: TMemoryBasicInformation;
begin
P := GetActualAddr(@TWinControl.Realign);
if (P <> nil) and (VirtualQuery(P, MemInfo, SizeOf(MemInfo)) = SizeOf(MemInfo)) then
begin
if (MemInfo.AllocationProtect <> PAGE_NOACCESS) then
begin
Offset := 0;
while Offset < $40 do
begin
if ((P[0] = $33) and (P[1] = $D2)) or // xor edx,edx
((P[0] = $31) and (P[1] = $D2)) then // xor edx,edx
begin
if P[2] = $E8 then // call TWinControl.AlignControl
begin
Inc(PByte(P), 2);
Result := PAnsiChar(P) + 5 + PInteger(PAnsiChar(P) + 1)^;
Exit;
end
else if (P[2] = $8B) and (P[3] = $45) and (P[4] = $FC) and // mov eax,[ebp-$04]
(P[5] = $E8) then // call TWinControl.AlignControl
begin
Inc(PByte(P), 5);
Result := PAnsiChar(P) + 5 + PInteger(PAnsiChar(P) + 1)^;
Exit;
end;
end;
Inc(PByte(P));
Inc(Offset);
end;
end;
end;
Result := nil;
end;
function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer;
asm
call System.@FindDynaClass
end;
var
WinControl_AlignControlProc, WinControl_WMSize, WinControl_SetBounds: Pointer;
BackupAlignControl, BackupWMSize, BackupSetBounds: TInjectRec;
procedure Init;
begin
WinControl_AlignControlProc := GetAlignControlProc;
WinControl_WMSize := GetDynamicMethod(TWinControl, WM_SIZE);
WinControl_SetBounds := @TOpenWinControl.SetBounds;
if (WinControl_AlignControlProc <> nil) and (WinControl_WMSize <> nil) then
begin
{ Redirect the original function to the bug fixed version }
BackupAlignControl := CodeRedirect(WinControl_AlignControlProc, @TFixWinControl.AlignControl);
BackupWMSize := CodeRedirect(WinControl_WMSize, @TFixWinControl.WMSize);
{$IFDEF OPTIMIZED_RESIZE_REDRAW}
BackupSetBounds := CodeRedirect(WinControl_SetBounds, @TFixWinControl.SetBounds);
{$ENDIF OPTIMIZED_RESIZE_REDRAW}
end;
end;
procedure Fini;
var
n: DWORD;
begin
{ Restore the original function }
if BackupAlignControl.Jump <> 0 then
WriteProcessMemory(GetCurrentProcess, GetActualAddr(WinControl_AlignControlProc),
@BackupAlignControl, SizeOf(BackupAlignControl), n);
if BackupWMSize.Jump <> 0 then
WriteProcessMemory(GetCurrentProcess, GetActualAddr(WinControl_WMSize),
@BackupWMSize, SizeOf(BackupWMSize), n);
if BackupSetBounds.Jump <> 0 then
WriteProcessMemory(GetCurrentProcess, GetActualAddr(WinControl_SetBounds),
@BackupSetBounds, SizeOf(BackupSetBounds), n);
end;
initialization
Init;
finalization
Fini;
end. |
Windows 64 bits: Problème de redimensionnement des fenêtres
Répondre avec citation
Envoyé par Pascal Jankowski
Partager