delphi中VCL一些bug的补丁修复包VCLfixpack介绍

最新推荐文章于 2024-08-09 08:10:04 发布

九点搬书匠

最新推荐文章于 2024-08-09 08:10:04 发布

阅读量3.7k

点赞数

CC 4.0 BY-SA版权

分类专栏： Delphi 文章标签： delphi integer warnings class function recursion

本文链接：https://blog.youkuaiyun.com/sushengmiyan/article/details/8062741

本文介绍了针对Delphi VCL的一些bug的补丁修复包VCLfixpack，由于Delphi官方已停止维护，此补丁包为开发者提供了解决控件问题的方案。文章分享了下载链接，并通过具体代码示例展示了修复过程。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

delphi本身就存在问题，现在又不维护了，所以有时候用到控件的时候就不知道怎么办了。

现在知道了一个delphi的补丁包，感觉不错，拿出来分享一下。

下载地址：http://download.youkuaiyun.com/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