如果你不了解 AnsiString 和 WideString，请先去网上查阅相关资料。微软的 Visual C++ 在提供 Unicode 方案的时候，提供了一套宏机制[6]。在 Delphi 中也有类似的方法，比如大家最熟悉的 string/Char/PChar。

宽字节版的字符串类型和 Windows API 函数很早就出现在 Delphi 中了。只是类型/函数别名一直只是对应到了传统的单字节版本上。简单来说，我们需要的是自由将类型/函数别名对应到单字节或者宽字节版本的数据类型上。

很多人想必和我一样对“程序全面支持 Unicode”这个概念懵懵懂懂。这里所谓的支持，并不是说要让应用程序既可以在 Windows9x 上运行，又可以在 WindowsXP 上显示 Unicode 字符。而是指一个应用程序应该针对 Windows9x 和WindowsXP 分别编译单字节或者宽字节版本。

“一版通杀”的解决方案比较的累人。首先，字符串相关的数据类型在程序内部都是以宽字节版本定义的。当在 Windows9x 上调用 Windows API 的时候，开发者必须手动进行类型转换。这种做法费时费力，维护的工作量相当大。目前 Delphi 制作的兼容 Unicode 的应用程序，基本都采用这个方法。在此，要特地感谢一下牺牲最大的先驱 Troy 和他的 TntControl[8]。

比较可以接受的方案是编译二个版本。这样就的项目可以继续以 Ansi 模式顺利编译。而新的项目，只要遵循国际化编程准则的，也都可以成功的编译出单字节或者宽字节版本。尽管在处理宽字节 Windows API 函数的时候你需要加倍小心，比如有些数据类型要求字符串指针包含二个 #0结束符，但比起“一版通杀”的工作量，你真的要偷笑了。

我实在不明白，究竟CodeGear 叫苦了10年的 Unicode 的瓶颈到底在哪里？难道他们之前一直在往“一版通杀”的方向努力？

现有的 WideString (D4-D2007) 类型是个比较奇怪的东西。不同于 AnsiString，它为了兼容 COM 调用中常用的BSTR 类型，违背了引用计数原则。因此它就性能而言，完全无法与 AnsiString 相提并论[9]。想必是为了保证现有的项目能顺利在 Delphi2008 (codename Tiburon) 中通过，下个版本并不打算改造现有的 WideString，而是另起炉灶，引入一个新的类型 UnicodeString。我个人是强烈反对这个方案的。请看下面的表格

显而易见，UnicodeString 这个名字和 WideChar/PWideChar 是不一致的。我的想法是：CodeGear 应该把现有的WideString (D4-D2007) 命名成 BSTR，然后再引入一个全新的 WideString (即 UnicodeString) 以及一个新的类型别名 T_BSTR。

当你以单字节方式编译你的现有项目时，一切照旧，程序顺利编译。当你以宽字节方式编译同样的项目时，编译器会在 BSTR 被强制转换成新的 WideString 发出警告或者错误提示。并要求开发者认真考虑是使用 BSTR 还是 WideString。

用 UTF-16 肯定好过 UTF-8。原因很简单，UTF-8 是一种给单字节系统提供双字节支持的权宜之计[10]。尽管它使用了可变长度定义一个字符，节约了部分的内存空间，但是它在编码和解码上需要花费更多的时间。一来一去，你说谁更加划算呢？

正如 Delphi 的首席构架师 Allen[4] 所说，Windows API 函数别名会和 UnicodeString 一样被很好的处理。不过我希望今后的 Delphi 能有一种函数重定向指令，以方便开发者定义自己的单字节和宽字节函数版本。例如：

在全面支持 Unicode 的过程中，确实会面临很多问题。既然微软在十年前就已经成功的解决了此问题，相信 CodeGear 的工程师不可能在今时今日仍然愁眉不展吧。让你的应用程序顺利支持 Unicode，你准备好了吗？

接口大大增强了类设计的灵活性，类似于c++中的多重继承。不管你是否真正了解接口 (Interface)，但它已经默默的在为你的程序服务了。你可以去看一下 TComponent 的定义部分，你会发现它内部已经封装了2个接口：IInterface, IInterfaceComponentReference。不难发现，Delphi 中除了原子类 TObject 之外，任何类有且只有一个父类，但同时它可以拥有0..n个接口。接口是一组抽象的函数集，不能被实例化，函数实现部分必须由它的实现类或间接实现 (外包) 类完成。

type
  IHello = interface(IUnknown)
    ['{1EE7A0AA-F525-4DD5-AB1B-900348BF8322}']
    procedure Hello;
  end;
  
  THello = class(TObject, IHello)
    // Implements IHello
    procedure Hello;
  end;

procedure UnSafeInftCall(Obj: TObject);
begin
  // Case 1
  Obj.Hello; //<-- Syntax error
  // Case 2
  THello(Obj).Hello;
  // Case 3
  IHello(Obj).Hello;
end;

procedure SafeInftCall(Obj: TObject);
var
  pIntfHello: IHello;
begin
  // Case 4
  if Obj.GetInterface(IHello, pIntfHello) then
    pIntfHello.Hello;
  // Case 5
  try
    pIntfHello := Obj as IHello;
    pIntfHello.Hello;
  except end; 
  // Case 6
  if Supports(Obj, IHello, pIntfHello) then
    pIntfHello.Hello;
end;

type
  THelloImplementor = class(TInterfacedObject, IHello)
  public
    procedure Hello;
  end;

procedure TestMe;
var
  Obj: THelloImplementor;
begin
  Obj := THelloImplementor.Create;
  try
    if Supports(Obj, IHello) then //<-- Obj.Destroy is called

begin
      // Own code

end
  finally
    ShowMessage(Obj.ClassName); //<-- Crashed!
    Obj.Free;
  end;
end; 

奇怪吗，为什么用 Supports 查询接口出错了呢？通过调试发现，在执行 Supports 之后，Obj 的实例被意外的释放了。于是乎意外应该是在 Supports 之内发生的。现在我们来看一下Supports 的实现：

function Supports(const Instance: TObject; const IID: TGUID): Boolean; overload;
var
  Temp: IInterface;
begin
  Result := Supports(Instance, IID, Temp); 
end;

type
  TVirtualImplementor = class(TInterfacedObject{TObject does not have problem}, IHello)
  public
    FImplementorOfIHello: THelloImplementor;
    property ImplementorOfIHello: THelloImplementor read FImplementorOfIHello implements IHello; //<-- Be careful!
  end;

procedure TestMe;
var
  VI: TVirtualImplementor;
  pIntfHello: IHello;
begin
  VI := TVirtualImplementor.Create;
  try
    // Method 1
    try
      pIntfHello := VI as IHello;
      pIntfHello.Hello;
    except end;
    // Method 2
    if Supports(VI, IHello, pIntfHello) then //<-- VI.Destroy is called
      pIntfHello.Hello;
  finally

    ShowMessage(VI.ClassName); //<-- Crashed!
    VI.Free;
  end;
end; 

如果使用 as 做类型转换，程序是可以顺利运行的。但是为什么用 Supports 就出错了呢？我们应该会很自然的联想上面那个问题。但问题是，这次接口指针 pIntfHello 实实在在地获得了接口，而且在 VI 释放之前并没有清除，也就是说 VI 不应该同上面的情况一样被自动销毁的。那么我们就再看一下 Supports 的实现：

function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean; overload;
var
  LUnknown: IUnknown;
begin
  Result := (Instance <> nil) and
            ((Instance.GetInterface(IUnknown, LUnknown) and Supports(LUnknown, IID, Intf)) or //<-- RefCount changed!
             Instance.GetInterface(IID, Intf)); 
end;

倒数第三行的地方，Supports 并不是直接通过 Instance 去查询是否支持IHello 接口的，而是先去查询 Instance 是否支持 IUnknown，然后通过 IUnknown 去查询 IHello接口。我不清楚 Delphi 为什么这样处理。

当执行Instance.GetInterface(IUnknown, LUnknown) 之后，LUnknown 指针指向了 Instance (即 VI)，同时因为接口引用计数的关系 VI.FRefCount 加一。

然后程序继续执行 Supports(LUnknown, IID, Intf)。这时 Intf 指针指向了IHello 的真正实现者 VI.FImplementorOfHello，同样的的，VI.FImplementorOfHello.FRefCount 加一。

当查询成功离开 Supports 函数时，本地变量指针 LUnknown 会被清除，于是 VI.FRefCount 减一。不巧的是 VI 也是由 TInterfacedObject 继承来的……。种种不幸最终酿成又一场惨祸。

1. FillChar 是低级的内存读写，所以在使用之前你要非常清楚要打算干什么。
2. 在记录类型中慎用 string 和 Widestring。如果记录的结构复杂，不妨尝试封装成类，类可以提供更丰富的特性，扩展性更佳。如果一定要定义带 string 的记录，最好注释一下，以免日后出错。(有时候的确是记录更方便和高效)
3. 活用 out 保留字可以解决接口类型和带 string 的记录类型的引用计数问题。

问题的提出：
上述代码不是线程安全的。假设 A 率先调用函数 Clipboard，局部变量 FClipboard会先进行实例化。在实例尚未完全创建完之前，如果 B 也尝试调用函数Clipboard，那么它也会去对 FClipboard 进行实例化。因为变量FClipboard此时依然为空指针。于是乎A、B分别创建了一个 TClipboard 的实例，单例不再单！其中的一个并且变成了一个内存泄漏。这种泄漏往往发送在构建函数需要耗费较长时间的情况下。如何将上述代码改成线程安全的呢？其实可以通过加入临界区处理来解决

var
  FClipboard: TClipboard;
  GClipboardLocker: TRTLCriticalSection;

function Clipboard: TClipboard;
begin
  if FClipboard = nil then
  begin
   EnterCriticalSection(GClipboardLocker);
   try
     if FClipboard = nil then
       FClipboard := TClipboard.Create;
   finally
     LeaveCriticalSection(GClipboardLocker);
   end;
 end;
  Result := FClipboard ;
end;

initialization
  InitializeCriticalSection(GClipboardLocker);
finalization
  DeleteCriticalSection(GClipboardLocker);
end. 

小结：
单例模式简约而不简单，当开发往多线程延伸之后，可能还会爆出更多的问题。单例就是一个全局变量，建议不要滥用，否则软件的层次结构会被破坏。

问题的产生原因：
经过一番研究，我注意到，所有的工具提示其实是通过 THintWindow 来画出的。可能是因为Borland 工程师想让工具提示可以彻底自定义重绘。于是并没有创建一个 TOOLTIPS_CLASS 窗口，而是创建了一个WS_EX_TOOLWINDOW 窗口。也就是说，Delphi 程序里面的工具提示是用 TOOLWINDOW 假冒的。这也就解释了为什么在 Vista 下面会这么难看的原因了。解决代码

题外话：
Delphi 2007 预计会在3月份发布，网上已经有2张截图了。Delphi 开发小组说这个版本会解决 Vista 的兼容性问题，同时改善 IDE 性能 (重绘等问题)。可能是大部分核心开发人员都跳槽的缘故吧。Delphi 2006 的质量不如人意，最近的热补竟然出到了#10。希望下个版本会改观。

具体解决方法：修改 Forms.pas，修改 procedure TcustomForm.CMShowingChanged(var Message: Tmessage);

procedure TCustomForm.CMShowingChanged(var Message: TMessage);
const
  ShowCommands: array[TWindowState] of Integer =
    (SW_SHOWNORMAL, SW_SHOWMINNOACTIVE, SW_SHOWMAXIMIZED);
var
  X, Y: Integer;
  NewActiveWindow: HWnd;
  CenterForm: TCustomForm;
begin
  if not (csDesigning in ComponentState) and (fsShowing in FFormState) then
    raise EInvalidOperation.Create(SVisibleChanged);
  Application.UpdateVisible;
  Include(FFormState, fsShowing);
  try
    if not (csDesigning in ComponentState) then
    begin
      if Showing then
      begin
        try
          DoShow;
        except
          Application.HandleException(Self);
        end;
        if (FPosition = poScreenCenter) or
           ((FPosition = poMainFormCenter) and (FormStyle = fsMDIChild)) then
        begin
          if FormStyle = fsMDIChild then
          begin
            X := (Application.MainForm.ClientWidth - Width) div 2;
            Y := (Application.MainForm.ClientHeight - Height) div 2;
          end else
          begin
            X := (Screen.Width - Width) div 2;
            Y := (Screen.Height - Height) div 2;
          end;
          if X < Screen.DesktopLeft then
            X := Screen.DesktopLeft;
          if Y < Screen.DesktopTop then
            Y := Screen.DesktopTop;
          if Y > Screen.WorkAreaHeight - Height then  //PATCH
            Y := Screen.WorkAreaHeight - Height;      //PATCH
          SetBounds(X, Y, Width, Height);
          if Visible then SetWindowToMonitor;
        end
        else if FPosition in [poMainFormCenter, poOwnerFormCenter] then
        begin
          CenterForm := Application.MainForm;
          if (FPosition = poOwnerFormCenter) and (Owner is TCustomForm) then
            CenterForm := TCustomForm(Owner);
          if Assigned(CenterForm) then
          begin
            X := ((CenterForm.Width - Width) div 2) + CenterForm.Left;
            Y := ((CenterForm.Height - Height) div 2) + CenterForm.Top;
          end else
          begin
            X := (Screen.Width - Width) div 2;
            Y := (Screen.Height - Height) div 2;
          end;
          if X < Screen.DesktopLeft then
            X := Screen.DesktopLeft;
          if Y < Screen.DesktopTop then
            Y := Screen.DesktopTop;
          if Y > Screen.WorkAreaHeight - Height then  //PATCH
            Y := Screen.WorkAreaHeight - Height;      //PATCH
          SetBounds(X, Y, Width, Height);
          if Visible then SetWindowToMonitor;
        end
        else if FPosition = poDesktopCenter then
        begin
          if FormStyle = fsMDIChild then
          begin
            X := (Application.MainForm.ClientWidth - Width) div 2;
            Y := (Application.MainForm.ClientHeight - Height) div 2;
          end else
          begin
            X := (Screen.DesktopWidth - Width) div 2;
            Y := (Screen.DesktopHeight - Height) div 2;
          end;
          if X < Screen.DesktopLeft then              //PATCH
            X := Screen.DesktopLeft;                  //
          if Y < Screen.DesktopTop then               //
            Y := Screen.DesktopTop;                   //
          if Y > Screen.WorkAreaHeight - Height then  //
            Y := Screen.WorkAreaHeight - Height;      //PATCH
          SetBounds(X, Y, Width, Height);
        end;

好了！大功告成。将修改后的 Forms.pas 复制到您的工程目录下，再次编译您的程序。这个问题消失了。

此外，对于修改 Delphi 的源文件，我建议把所有修改过的源文件都放在一个新的目录 （例如 PatchedVCLs），然后在 Delphi 里面定义一个环境变量，这样以后你只要给其它工程的路径里面添加这个环境变量，这些工程都可以使用你修改过的代码了。至于修改源码的一些方法和技巧，请参考 如何访问私有成员变量和函数。

1.     访问私有成员变量
如果是 protected 的变量，可以用如下方法访问：

type
  TSomeClassAccess = class(TSomeClass);

begin
  TSomeClassAccess(Object1).protected_Bool := False;
  TSomeClassAccess(Object1).protected_Int := 0;
  ...
end;

如果是 private 的变量，那么就要当心了。因为涉及到偏移量。还要考虑不同 Delphi 版本的控件的内部成员可能也有变化。最简单的例子是：访问 TMenuItem 的第二个内部成员变量 FHandle

type
  THackMenuItem = class(TComponent)
  protected //<-- change to protected 
    FxxxxCaption: AnsiString;
    FHandle: HMENU; //<-- the property you want to access

  end;

begin
  THackMenuItem(AMenuItem).FHandle := 0;
  ...
end;

2.      访问私有成员函数
这个目前普遍的做法是偷梁换柱。就是把自己的函数地址替换成待修改函数的内存地址。不过其中涉及到了内存修改、地址偏移量……，具体做法可以参考 TntControls 中 TntSystem.pas 安装系统补丁，或者是 Fastcode 控件包。当然这个替换是会出现副作用的：例如 AQTime 就无法测试安装过 TntSystem 补丁的程序。

3.      直接修改代码的实现
如果是运行库中的具体实现要修改，可以直接动源码，因为改动是implementation 的部分，不会影响到其它的调用该单元的部分。（注意：interface 和 implementation 的内容不能直接修改，否则无法编译通过。）修改之后，勾选编译选项里面的 „Use Debug DCUs“，并编译程序，再将编译得到的 dcu 文件保存到编译目录下面。我一般创建2个目录：PatchedVCLs 和 PreCompiled 放修改过的源码，和编译之后的版本。然后把这个2个目录定义到环境变量里面，这样只要在每个项目的路径设置中添加这些变量，就可以使用改动过的代码了。

4.      间接修改代码的实现
如果要在修改定义部分怎么办？方法3是肯定行不通了。因为所有引用到这个单元的单元也需要重新编译，但不是所有 Delphi 源码你都可以重新编译的。这种情况就伤脑筋了。我目前只可以修改很小一部分的。基本思路是在自己的程序里面定义需访问对象的扩展类和具体实现。然后释放原先对象实例，并以新扩展类重新创建实例。请参考 打入消息循环的另类方法。

总结：
以上四种方法是我在修改 Delphi 库或者第三方控件时候所用到的。在修改源码的时候，尽量要考虑到代码的移植性。要做到最少量的修改，得到最好的效果。并且需要考虑修改的代码是否可以在不 同的 Delphi 版本中使用。我在实际项目中，修改了6、7个源码。（有时间的话，我会一一列出，有需要的可以问我索取。）同时也欢迎交流更多的修改方法，以及 Delphi 不正确封装的补丁。

题外话：
刚刚来自 CodeGear 的消息，Delphi 下个版本会引入了新的技术，直接修改声明部分的代码将变的可能。

procedure TMyMenuMessagesHandler.SubclassWndProc;
begin
  FDefMenuProc := Pointer(GetWindowLongA(PopupList.Window, GWL_WNDPROC));
  FObjInstance := Classes.MakeObjectInstance(CustomMenuWndProc);
  SetWindowLongA(PopupList.Window, GWL_WNDPROC, Longint(FObjInstance));
end;

procedure TMyMenuMessagesHandler.UnSubclassWndProc;
begin
  if Assigned(FDefMenuProc) then
    SetWindowLongA(PopupList.Window, GWL_WNDPROC, Longint(FDefMenuProc));
  if Assigned(FObjInstance) then
    Classes.FreeObjectInstance(FObjInstance);
end;

procedure TMyMenuMessagesHandler.CustomMenuWndProc(var Message: TMessage);
var
  CancelPopupContextMenu: Boolean;
begin
  if Message.Msg = WM_CONTEXTMENU then
  begin
    // My own code ....
    Message.Result := 1;
    Exit;
  end;

  // Send message to default message handler
  with Message do
    Result := CallWindowProcA(FDefMenuProc, PopupList.Window, Msg, wParam, lParam);
end; 

问题的提出：
但是这样做有个隐藏问题：如果你接管的消息窗口提前释放了，那么消息处理链就断了，这个时候程序可能会崩溃。如果我们可以直接修改Menus.PopupList.WndProc，那么就不用通过 subclass 来实现消息接管了。幸运的是，对于 Menus.PopupList 这个特殊的全局变量来说，这个是可以做到的。

实现原理：
PopupList 的类型是 TPopupList，我们可以在自己的程序里面定义一个继承类，名为TPopupListEx。因为这是个特殊的全局变量，它是在 Menus.pas 的初始化部分就创建的，我们可以在它创建之后，立刻释放它，然后以 TPopupListEx的形式重新创建。只要声明部分没有任何变化，这种方法可以 “骗过” 任何调用者，它们以为还是在调用TPopupList。

具体代码：
把上面的代码替换成如下代码即可

//PATCH-BEGIN
type
  TPopupListEx = class(TPopupList)
  private
    FOnCustomWndProc: TWndMethod;
  public
    property OnCustomWndProc: TWndMethod read FOnCustomWndProc write FOnCustomWndProc;
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

procedure TPopupListEx.WndProc(var Message: TMessage);
begin
  if Assigned(OnCustomWndProc) then
  begin
    OnCustomWndProc(Message);
    if Message.Result = 1 then
      Exit;
  end;
  inherited;
end;
//PATCH-END

procedure TMyMenuMessagesHandler.SubclassWndProc;
begin
  if Assigned(PopupList) then
    TPopupListEx(PopupList).OnCustomWndProc := CustomMenuWndProc;
end;

procedure TMyMenuMessagesHandler.UnSubclassWndProc;
begin
  if Assigned(PopupList) then
    TPopupListEx(PopupList).OnCustomWndProc := nil;
end;

procedure TMyMenuMessagesHandler.CustomMenuWndProc(var Message: TMessage);
var
  CancelPopupContextMenu: Boolean;
begin
  if Message.Msg = WM_CONTEXTMENU then
  begin
    // My own code ....
    Message.Result := 1;
  end;
end; 


initialization
  FreeAndNil(PopupList);
  PopupList := TPopupListEx.Create;

finalization
//FreeAndNil(PopupList); //NOTE: will be freed by finalization section of Menus.pas
end.

说明：
但是我还不清楚为什么用 subclass 方法的时候，一旦消息窗口释放，程序会崩溃。目前也只能先用这个方法了。

我发现如果有 Band 设置过 FixedSize=True，就会出现偏差，没设置过就没有问题。我猜测可能是工具栏高度发生变化后，Band 的高度属性未被真正更新所致。（ReBar 系列控件的细节问题的确很多，难怪到现在 Delphi 都没有给工具栏加上 Chevron 效果。）要解决这个问题，只要在接收到 RBN_HEIGHTCHANGE 消息时，对设置过 FixedSize=True 的 Band 强制更新一次属性即可。反正只是重新更新一次属性，所以也不会带来什么副作用。

具体方法：找到 procedure TCoolBar.CNNotify(var Message: TWMNotify);
将整个函数替换成如下代码即可。

procedure TCoolBar.CNNotify(var Message: TWMNotify);
var
  I: Integer;
  RBBI: TReBarBandInfo;
begin
  if (Message.NMHdr^.code = RBN_HEIGHTCHANGE) then
    if IsAutoSized and (ComponentState * [csLoading, csDestroying] = []) then
    begin
      //PATCH-BEGIN
      for I := 0 to Bands.Count - 1 do
        if Bands[I].FixedSize then
        begin
          FillChar(RBBI, SizeOfReBarBandInfo, 0);
          RBBI.cbSize := SizeOfReBarBandInfo;
          RBBI.fMask := RBBIM_STYLE;
          Perform(RB_GETBANDINFO, Bands[I].FID and IDMask, Integer(@RBBI));
          Perform(RB_SETBANDINFO, Bands[I].FID and IDMask, Integer(@RBBI));
        end;
      //PATCH-END
                     
      ReadBands;
      BeginUpdate;
      try
        if AutoSize then AdjustSize;
      finally
        EndUpdate;
      end;
    end
    else if IsBackgroundDirty then
      Invalidate;
end;

好了！大功告成。将修改后的 ComCtrls.pas 复制到 coolstuf 目录下，再次编译文件。这个问题消失了。

此外，对于修改 Delphi 的源文件，我建议把所有修改过的源文件都放在一个新的目录 （例如 PatchedVCLs），然后在 Delphi 里面定义一个环境变量，这样以后你只要给其它工程的路径里面添加这个环境变量，这些工程都可以使用你修改过的代码了。至于修改源码的一些方法和技巧，请参考 如何访问私有成员变量和函数。

如果你没有用过 TAction，或许你不该说你会 Delphi。TAction 大大简化了界面逻辑的关联，加速了项目的开发。不过我在程序中大量使用 TAction 时，无意发现这样一个问题：如果程序的某个窗体里有超过100个 TAction，在运行这个程序时，只要不停的在该窗体上快速移动鼠标，CPU 占用率会猛增到 30% 左右。

为什么会有如此高的 CPU 占用？

使用 Spy++ 调试后发现，一旦鼠标快速在窗体上移动，程序会频繁发送 WM_UPDATE 消息。进一步调试后发现，TContainedAction.Update() 被 TActionManager 频繁调用。正如帮助文档中所写：当应用程序处于空闲状态时，所有的 TxxxxAction.OnUpdate 事件会被触发。由于空闲状态频繁改变，因此 OnUpdate 也就被频繁触发，这个正是造成不当 CPU 占用的真正原因。

如果你的程序中没有使用到 TxxxxAction.OnUpdate，那么你可以屏蔽 TActionManager 去查询并触发 TxxxxAction.OnUpdate。具体实现代码如下：

uses
 FastcodePatch {http://fastcode.sourceforge.net/};

procedure TContainedActionUpdateStub;
asm
 call TContainedAction.Update;
end;

type
 TContainedActionPatch = class(TContainedAction)
 public
    function Update: Boolean; override;
 end;

function TContainedActionPatch.Update: Boolean;
begin
 Result := False;
end;

function DisableTActionOnUpdate(ActnList: TActionList): Boolean;
var
 I: Integer;
begin
 Result := True;
 for I := 0to ActnList.ActionCount - 1do
    if Assigned(ActnList.Actions[I].OnUpdate) then
    begin
      Result := False;
      Break;
    end;

 if Result then
 begin
    FastcodeAddressPatch(
      FastcodeGetAddress(@TContainedActionUpdateStub),
      @TContainedActionPatch.Update);
 end;
end;

这段代码的最佳运行位置是在你程序窗体的OnCreate() 事件中。当然，如果你希望彻底解决这个问题，你可以修改ActnList.pas 中的TContainedAction.Update，或者提交申请让CodeGear 来改进这个问题。

本文展示了过多使用TxxxxAction 组件可能会造成应用程序过高的CPU 占用问题。并且提供了补丁代码来解决这个问题。尽管我手上没有最新版本的 Delphi，但是估计这个问题是不会被 CodeGear 修正的。