记录消息只是Synchronize()完全没有任何意义的区域之一.您应该创建一个日志目标对象,该对象具有一个字符串列表,受关键部分的保护,并添加您的日志消息.让主VCL线程从该列表中删除日志消息,并将其显示在日志窗口中.这有几个优点：

>你不需要调用Synchronize(),这只是一个坏主意.好的副作用是你的关机问题消失了.
>工作线程可以继续他们的工作,而不会阻塞主线程事件处理,或者在尝试记录消息的其他线程上.
>性能提高,因为一次可以将多条消息添加到日志窗口.如果您使用BeginUpdate()和EndUpdate()这将加快速度.

没有任何缺点,我可以看到 – 日志消息的顺序也保留下来.

编辑：

我将添加一些更多的信息和一些代码来玩,以便说明有更好的方法来做你需要做的事情.

从与VCL程序中的主应用程序线程不同的线程调用Synchronize()将导致调用线程阻塞,所传递的代码将在VCL线程的上下文中执行,然后调用线程将被解除阻塞并继续跑.在单处理器机器的时代,这可能是一个好主意,只有一个线程可以一次运行,但是使用多个处理器或内核,这是一个巨大的浪费,应该不惜一切代价避免.如果在8核心机器上有8个工作线程,调用Synchronize()可能会将吞吐量限制在可能的一小部分.

实际上,调用Synchronize()并不是一个好主意,因为它可能导致死锁.有一个更有说服力的理由,不要使用它.

使用PostMessage()发送日志消息将会处理死锁问题,但它有自己的问题：

>每个日志字符串将导致一个消息被发布和处理,导致很多开销.一次无法处理多个日志消息.
> Windows消息只能在参数中携带机器字大小的数据.因此发送字符串是不可能的.在类型转换到PChar后发送字符串是不安全的,因为字符串可能在消息被处理时被释放.在处理消息后,在工作线程中分配内存并释放VCL线程中的内存是一种出路.一种增加更多开销的方式.
> Windows中的消息队列具有有限的大小.发布太多邮件可能导致队列变满,邮件被删除.这不是一件好事,并且与之前的一切导致内存泄漏.
>在生成任何定时器或油漆消息之前,将处理队列中的所有消息.因此,许多发布消息的稳定流可能导致程序无响应.

收集日志消息的数据结构可能如下所示：

@H_502_6@type TLogTarget = class(TObject) private fCritSect: TCriticalSection; fMsgs: TStrings; public constructor Create; destructor Destroy; override; procedure GetLoggedMsgs(AMsgs: TStrings); procedure LogMessage(const AMsg: string); end; constructor TLogTarget.Create; begin inherited; fCritSect := TCriticalSection.Create; fMsgs := TStringList.Create; end; destructor TLogTarget.Destroy; begin fMsgs.Free; fCritSect.Free; inherited; end; procedure TLogTarget.GetLoggedMsgs(AMsgs: TStrings); begin if AMsgs <> nil then begin fCritSect.Enter; try AMsgs.Assign(fMsgs); fMsgs.Clear; finally fCritSect.Leave; end; end; end; procedure TLogTarget.LogMessage(const AMsg: string); begin fCritSect.Enter; try fMsgs.Add(AMsg); finally fCritSect.Leave; end; end;

许多线程可以同时调用LogMessage(),进入关键部分将序列化对列表的访问,并且在添加他们的消息之后,线程可以继续他们的工作.

这就是VCL线程知道何时调用GetLoggedMsgs()来从对象中删除消息并将它们添加到窗口的问题.一个穷人的版本将是一个定时器和民意调查.更好的方法是在添加日志消息时调用PostMessage()：

@H_502_6@procedure TLogTarget.LogMessage(const AMsg: string); begin fCritSect.Enter; try fMsgs.Add(AMsg); PostMessage(fNotificationHandle,WM_USER,0); finally fCritSect.Leave; end; end;

这仍然发生太多邮件的问题.只有当前一个消息处理完毕时,才需要发布消息：

@H_502_6@procedure TLogTarget.LogMessage(const AMsg: string); begin fCritSect.Enter; try fMsgs.Add(AMsg); if InterlockedExchange(fMessagePosted,1) = 0 then PostMessage(fNotificationHandle,0); finally fCritSect.Leave; end; end;

然而,仍然可以改进.使用定时器解决了发布的消息填满队列的问题.以下是实现这一点的小类：

@H_502_6@type TMainThreadNotification = class(TObject) private fNotificationMsg: Cardinal; fNotificationRequest: integer; fNotificationWnd: HWND; fOnNotify: TNotifyEvent; procedure DoNotify; procedure NotificationWndMethod(var AMsg: TMessage); public constructor Create; destructor Destroy; override; procedure RequestNotification; public property OnNotify: TNotifyEvent read fOnNotify write fOnNotify; end; constructor TMainThreadNotification.Create; begin inherited Create; fNotificationMsg := RegisterWindowMessage('thrd_notification_msg'); fNotificationRequest := -1; fNotificationWnd := AllocateHWnd(NotificationWndMethod); end; destructor TMainThreadNotification.Destroy; begin if IsWindow(fNotificationWnd) then DeallocateHWnd(fNotificationWnd); inherited Destroy; end; procedure TMainThreadNotification.DoNotify; begin if Assigned(fOnNotify) then fOnNotify(Self); end; procedure TMainThreadNotification.NotificationWndMethod(var AMsg: TMessage); begin if AMsg.Msg = fNotificationMsg then begin SetTimer(fNotificationWnd,42,10,nil); // set to 0,so no new message will be posted InterlockedExchange(fNotificationRequest,0); DoNotify; AMsg.Result := 1; end else if AMsg.Msg = WM_TIMER then begin if InterlockedExchange(fNotificationRequest,0) = 0 then begin // set to -1,so new message can be posted InterlockedExchange(fNotificationRequest,-1); // and kill timer KillTimer(fNotificationWnd,42); end else begin // new notifications have been requested - keep timer enabled DoNotify; end; AMsg.Result := 1; end else begin with AMsg do Result := DefWindowProc(fNotificationWnd,Msg,WParam,LParam); end; end; procedure TMainThreadNotification.RequestNotification; begin if IsWindow(fNotificationWnd) then begin if InterlockedIncrement(fNotificationRequest) = 0 then PostMessage(fNotificationWnd,fNotificationMsg,0); end; end;

该类的一个实例可以添加到TLogTarget,以在主线程中调用通知事件,但每秒钟最多打几次.