Al Boldi wrote:
Michael Van Canneyt wrote:
On Sat, 15 Dec 2007, Al Boldi wrote:
melchiorre caruso wrote:
I found an article that explains why my code does not work on Windows:
Actually, I had a closer look at synchronize, and it turns out to be
dependent on the GUI, which probably means that you need to include
'Interfaces' in your library uses clause. Can you try this on windows?
No.
Synchronize does not depend on the GUI, it does depend on the main
thread calling CheckSynchronize from time to time.
The problem is that synchronize depends on calling WakeMainThread, but that
only gets set when you include the Interfaces unit.
melchiorre caruso wrote:
libthread.dpr(4,3) Fatal: Can't find unit Interfaces used by libthread
I add manually $(LazarusDir)\lcl\interfaces\$(TargetOS) to the paths but
an other error occours:
Fatal: Can't find unit InterfaceBase used by Interfaces
"The dog bites the tail"
I use WinXp Sp2
Lazarus svn
Fcp 2.2.0
Try adding the LCL to your project.
I added the LCL to my project;
Now the compiler founds interfaces units and builds all source;
But Synchronize does not work.
But, you could instead just try setting WakeMainThread in your lib yourself,
and let the handler post a message to the mainthread. That's what the
Interfaces unit does. Can you try this
I do not know how to do it,
Btw, I solved the problem using threadx.pas;
Thanks
---
Melchiorre
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.
