I found an article that explains why my code does not work on Windows:
http://www.clevercomponents.com/articles/article019/delphi6sync.asp
Now it works.
unit threadx;
interface
uses
Windows,
Classes;
type
TThreadSynchronizer = class
private
FMethod: TThreadMethod;
FSynchronizeException: TObject;
FSyncBaseThreadID: LongWord;
public
constructor Create;
destructor Destroy; override;
procedure Synchronize(Method: TThreadMethod);
property SyncBaseThreadID: LongWord read FSyncBaseThreadID;
end;
TThreadEx = class(TThread)
private
FSynchronizer: TThreadSynchronizer;
procedure HandleTerminate;
protected
procedure DoTerminate; override;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure Wait;
property Synchronizer: TThreadSynchronizer read FSynchronizer;
end;
implementation
const
CM_EXECPROC = $8FFD;
CM_DESTROYWINDOW = $8FFC;
type
TSyncInfo = class
FSyncBaseThreadID: LongWord;
FThreadWindow: HWND;
FThreadCount: Integer;
end;
TSynchronizerManager = class
private
FThreadLock: TRTLCriticalSection;
FList: TList;
procedure FreeSyncInfo(AInfo: TSyncInfo);
procedure DoDestroyWindow(AInfo: TSyncInfo);
function InfoBySync(ASyncBaseThreadID: LongWord): TSyncInfo;
function FindSyncInfo(ASyncBaseThreadID: LongWord): TSyncInfo;
public
class function Instance: TSynchronizerManager;
constructor Create();
destructor Destroy; override;
procedure AddThread(ASynchronizer: TThreadSynchronizer);
procedure RemoveThread(ASynchronizer: TThreadSynchronizer);
procedure Synchronize(ASynchronizer: TThreadSynchronizer);
end;
var
SynchronizerManager: TSynchronizerManager;
function ThreadWndProc(Window: HWND; Message, wParam, lParam: Longint):
Longint; stdcall;
begin
case Message of
CM_EXECPROC:
with TThreadSynchronizer(lParam) do
begin
Result := 0;
try
FSynchronizeException := nil;
FMethod();
except
FSynchronizeException := AcquireExceptionObject();
end;
end;
CM_DESTROYWINDOW:
begin
TSynchronizerManager.Instance().DoDestroyWindow(TSyncInfo(lParam));
Result := 0;
end;
else
Result := DefWindowProc(Window, Message, wParam, lParam);
end;
end;
var
ThreadWindowClass: TWndClass = (
style: 0;
lpfnWndProc: @ThreadWndProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: 0;
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: nil;
lpszClassName: 'TThreadSynchronizerWindow');
{ TSynchronizerManager }
constructor TSynchronizerManager.Create;
begin
inherited Create();
InitializeCriticalSection(FThreadLock);
FList := TList.Create();
end;
destructor TSynchronizerManager.Destroy;
var
i: Integer;
begin
for i := FList.Count - 1 downto 0 do
begin
FreeSyncInfo(TSyncInfo(FList[i]));
end;
FList.Free();
DeleteCriticalSection(FThreadLock);
inherited Destroy();
end;
class function TSynchronizerManager.Instance: TSynchronizerManager;
begin
if (SynchronizerManager = nil) then
begin
SynchronizerManager := TSynchronizerManager.Create();
end;
Result := SynchronizerManager;
end;
procedure TSynchronizerManager.AddThread(ASynchronizer: TThreadSynchronizer);
function AllocateWindow: HWND;
var
TempClass: TWndClass;
ClassRegistered: Boolean;
begin
ThreadWindowClass.hInstance := HInstance;
ClassRegistered := GetClassInfo(HInstance, ThreadWindowClass.lpszClassName,
TempClass);
if not ClassRegistered or (@TempClass.lpfnWndProc <> @ThreadWndProc) then
begin
if ClassRegistered then
Windows.UnregisterClass(ThreadWindowClass.lpszClassName, HInstance);
Windows.RegisterClass(ThreadWindowClass);
end;
Result := CreateWindow(ThreadWindowClass.lpszClassName, '', 0,
0, 0, 0, 0, 0, 0, HInstance, nil);
end;
var
info: TSyncInfo;
begin
EnterCriticalSection(FThreadLock);
try
info := FindSyncInfo(ASynchronizer.SyncBaseThreadID);
if (info = nil) then
begin
info := TSyncInfo.Create();
info.FSyncBaseThreadID := ASynchronizer.SyncBaseThreadID;
FList.Add(info);
end;
if (info.FThreadCount = 0) then
begin
info.FThreadWindow := AllocateWindow();
end;
Inc(info.FThreadCount);
finally
LeaveCriticalSection(FThreadLock);
end;
end;
procedure TSynchronizerManager.RemoveThread(ASynchronizer: TThreadSynchronizer);
var
info: TSyncInfo;
begin
EnterCriticalSection(FThreadLock);
try
info := InfoBySync(ASynchronizer.SyncBaseThreadID);
PostMessage(info.FThreadWindow, CM_DESTROYWINDOW, 0, Longint(info));
finally
LeaveCriticalSection(FThreadLock);
end;
end;
procedure TSynchronizerManager.DoDestroyWindow(AInfo: TSyncInfo);
begin
EnterCriticalSection(FThreadLock);
try
Dec(AInfo.FThreadCount);
if AInfo.FThreadCount = 0 then
begin
FreeSyncInfo(AInfo);
end;
finally
LeaveCriticalSection(FThreadLock);
end;
end;
procedure TSynchronizerManager.FreeSyncInfo(AInfo: TSyncInfo);
begin
if AInfo.FThreadWindow <> 0 then
begin
DestroyWindow(AInfo.FThreadWindow);
AInfo.Free();
FList.Remove(AInfo);
end;
end;
procedure TSynchronizerManager.Synchronize(ASynchronizer: TThreadSynchronizer);
begin
SendMessage(InfoBySync(ASynchronizer.SyncBaseThreadID).FThreadWindow,
CM_EXECPROC, 0, Longint(ASynchronizer));
end;
function TSynchronizerManager.FindSyncInfo(
ASyncBaseThreadID: LongWord): TSyncInfo;
var
i: Integer;
begin
for i := 0 to FList.Count - 1 do
begin
Result := TSyncInfo(FList[i]);
if (Result.FSyncBaseThreadID = ASyncBaseThreadID) then Exit;
end;
Result := nil;
end;
function TSynchronizerManager.InfoBySync(
ASyncBaseThreadID: LongWord): TSyncInfo;
begin
Result := FindSyncInfo(ASyncBaseThreadID);
Assert(Result <> nil, 'Cannot find SyncInfo for the specified thread
synchronizer');
end;
{ TThreadSynchronizer }
constructor TThreadSynchronizer.Create;
begin
inherited Create();
FSyncBaseThreadID := GetCurrentThreadId();
TSynchronizerManager.Instance().AddThread(Self);
end;
destructor TThreadSynchronizer.Destroy;
begin
TSynchronizerManager.Instance().RemoveThread(Self);
inherited Destroy();
end;
procedure TThreadSynchronizer.Synchronize(Method: TThreadMethod);
begin
FSynchronizeException := nil;
FMethod := Method;
TSynchronizerManager.Instance().Synchronize(Self);
if Assigned(FSynchronizeException) then raise FSynchronizeException;
end;
{ TThreadEx }
constructor TThreadEx.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
FSynchronizer := TThreadSynchronizer.Create();
end;
destructor TThreadEx.Destroy;
begin
FSynchronizer.Free();
inherited Destroy();
end;
procedure TThreadEx.DoTerminate;
begin
if Assigned(OnTerminate) then Synchronizer.Synchronize(HandleTerminate);
end;
procedure TThreadEx.HandleTerminate;
begin
if Assigned(OnTerminate) then OnTerminate(Self);
end;
procedure TThreadEx.Wait;
var
Msg: TMsg;
H: THandle;
begin
DuplicateHandle(GetCurrentProcess(), Handle, GetCurrentProcess(), @H, 0,
False, DUPLICATE_SAME_ACCESS);
try
if GetCurrentThreadID = Synchronizer.SyncBaseThreadID then
begin
while MsgWaitForMultipleObjects(1, H, False, INFINITE, QS_SENDMESSAGE) =
WAIT_OBJECT_0 + 1 do
begin
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
DispatchMessage(Msg);
end;
end;
end else
begin
WaitForSingleObject(H, INFINITE);
end;
finally
CloseHandle(H);
end;
end;
initialization
SynchronizerManager := nil;
finalization
SynchronizerManager.Free();
SynchronizerManager := nil;
end.
