delphi中VCL一些bug的补丁修复包VCLfixpack介绍
来源：互联网 发布：js遍历数组,并执行方法 编辑：程序博客网 时间：2024/05/15 07:14
delphi本身就存在问题，现在又不维护了，所以有时候用到控件的时候就不知道怎么办了。
现在知道了一个delphi的补丁包，感觉不错，拿出来分享一下。
下载地址：http://download.csdn.net/detail/sushengmiyan/4637884
拿一个修复的例子来说吧：看代码
{$IF CompilerVersion < 20.0} // Delphi 6-2007 {$DEFINE ControlResizeFix} { 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. } {.$DEFINE OPTIMIZED_RESIZE_REDRAW}{$IFEND}implementation{$IF CompilerVersion >= 18.0} {$DEFINE DELPHI2006_UP}{$IFEND}{$IF CompilerVersion >= 17.0} {$DEFINE DELPHI2005_UP}{$IFEND}uses Windows, Messages, SysUtils, Classes, TypInfo, ActnList, SysConst, {$IFDEF ObjAutoDEPFix} ObjAuto, {$ENDIF ObjAutoDEPFix} {$IF CompilerVersion >= 15.0} Themes, {$IFEND} {$IF CompilerVersion >= 20.0} Character, {$IFEND} {$IFDEF VCLFIXPACK_DB_SUPPORT} DB, DBClient, DBGrids, DBCtrls, {$ENDIF VCLFIXPACK_DB_SUPPORT} Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, ComCtrls, Buttons, CommCtrl;{ ---------------------------------------------------------------------------- }{ Helper functions, shared }type TOpenWinControl = class(TWinControl); TOpenCustomForm = class(TCustomForm); TOpenCommonDialog = class(TCommonDialog); TOpenCustomActionList = class(TCustomActionList); TOpenComponent = class(TComponent); TOpenCustomCombo = class(TCustomCombo); TJumpOfs = Integer; PPointer = ^Pointer;type PXRedirCode = ^TXRedirCode; TXRedirCode = packed record Jump: Byte; Offset: TJumpOfs; end; PWin9xDebugThunk = ^TWin9xDebugThunk; TWin9xDebugThunk = packed record PUSH: Byte; Addr: Pointer; JMP: TXRedirCode; end; PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp; TAbsoluteIndirectJmp = packed record OpCode: Word; //$FF25(Jmp, FF /4) Addr: PPointer; end;{ Hooking }function GetActualAddr(Proc: Pointer): Pointer; function IsWin9xDebugThunk(AAddr: Pointer): Boolean; begin Result := (AAddr <> nil) and (PWin9xDebugThunk(AAddr).PUSH = $68) and (PWin9xDebugThunk(AAddr).JMP.Jump = $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;procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);var n: DWORD; Code: TXRedirCode;begin Proc := GetActualAddr(Proc); Assert(Proc <> nil); if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then begin Code.Jump := $E9; Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code); WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n); end;end;procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);var n: Cardinal;begin if (BackupCode.Jump <> 0) and (Proc <> nil) then begin Proc := GetActualAddr(Proc); Assert(Proc <> nil); WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n); BackupCode.Jump := 0; end;end;function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer;asm call System.@FindDynaClassend;procedure DebugLog(const S: string);begin OutputDebugString(PChar('VCLFixPack patch installed: ' + S));end;{ ---------------------------------------------------------------------------- }{ Control resize bugfix for kernel stack overflow due to WH_CALLWNDPROC hook }{$IFDEF ControlResizeFix}{2008-05-25: - Added code to detect endless resizing controls. - Added experimental OPTIMIZED_RESIZE_REDRAW option for faster form resizing }var WinControl_AlignControlProc, WinControl_WMSize, WinControl_SetBounds: Pointer; BackupAlignControl, BackupWMSize, BackupSetBounds: TXRedirCode;type TControlResizeFixWinControl = 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; {$IFNDEF DELPHI2005_UP} TD5WinControlPrivate = class(TControl) public FAlignLevel: Word; end; {$ENDIF ~DELPHI2005_UP}threadvar AlignControlList: TList;procedure TControlResizeFixWinControl.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 TControlResizeFixWinControl.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 TControlResizeFixWinControl.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 TControlResizeFixWinControl.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;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;procedure InitControlResizeFix;begin WinControl_AlignControlProc := GetAlignControlProc; WinControl_WMSize := GetDynamicMethod(TWinControl, WM_SIZE); WinControl_SetBounds := @TOpenWinControl.SetBounds; if (WinControl_AlignControlProc <> nil) and (WinControl_WMSize <> nil) then begin DebugLog('ControlResizeFix'); { Redirect the original function to the bug fixed version } HookProc(WinControl_AlignControlProc, @TControlResizeFixWinControl.AlignControl, BackupAlignControl); HookProc(WinControl_WMSize, @TControlResizeFixWinControl.WMSize, BackupWMSize); {$IFDEF OPTIMIZED_RESIZE_REDRAW} HookProc(WinControl_SetBounds, @TControlResizeFixWinControl.SetBounds, BackupSetBounds); {$ENDIF OPTIMIZED_RESIZE_REDRAW} end;end;procedure FiniControlResizeFix;begin { Restore the original function } UnhookProc(WinControl_AlignControlProc, BackupAlignControl); UnhookProc(WinControl_WMSize, BackupWMSize); UnhookProc(WinControl_SetBounds, BackupSetBounds);end;{$ENDIF ControlResizeFix}{ ---------------------------------------------------------------------------- }initialization {$IFDEF ControlResizeFix} InitControlResizeFix; {$ENDIF ControlResizeFix}finalization {$IFDEF ControlResizeFix} FiniControlResizeFix; {$ENDIF ControlResizeFi- delphi中VCL一些bug的补丁修复包VCLfixpack介绍
- Delphi 2009(Tiburon)中一些VCL组件的增强
- Delphi中MediaPlayer控件的一个Bug即修复
- Delphi的一些Bug
- Oracle 11g R2 补丁修复的bug list
- KEIL uVision的一些BUG修复
- CnPack VCL组件库中 TCnButtonEdit 组件的BUG修正
- Hibernate中包的一些介绍
- BCB/Delphi中常用的VCL函数说明
- BCB/Delphi中常用的VCL函数说明
- BCB/Delphi中常用的VCL函数说明
- BCB/Delphi中常用的VCL函数说明
- BCB/Delphi中常用的VCL函数说明
- BCB/Delphi中常用的VCL函数说明
- Delphi VCL中DragDrop功能的底层实现
- Delphi 中 DevExpress VCL 14.2.6的编译路径设置
- 发现 Delphi 2009 VCL 源码中一处可能导致死循环的 Bug
- Delphi有关包的介绍
- 飞行射击类游戏,Helloworldgame
- iPhone摄像头设备获取(分离简化版）
- 两数组中的相同元素
- 如何在 IPHONE 下面用 FFMPEG 播放 H.264 流开发记录
- 智能车辆研究
- delphi中VCL一些bug的补丁修复包VCLfixpack介绍
- 笔记20121010
- jbpm5学习资料
- xcode3.2.6,sdk4.3,ffmpeg0.10.2,编译
- 小心NLS_SORT和NLS_COMP的设置成为性能杀手
- java求三角形面积以及周长---封装
- 单例模式
- jbpm5--WSHumanTaskHandler
- C语言需要注意的一些问题
