2010/1/20 Brad Campbell <b...@wasp.net.au>:
> Is QueueAsyncCall() threadsafe?
As far as I know it is not.
>
> Let's say I have a communications child thread and I want to trigger a call
> back in the main GUI thread. Traditionally I'd do something ugly like have a
> timer polling a variable used as a flag, or polling a RtlEvent on a short
> timeout, but this seems like a much nicer solution.
>
You can call TThread.Synchronize(), your thread will be stopped until
the GUI thread executes your function.
Other solution is to create a separate thread for handling such GUI
functions (take a look at attached source); this doesn't stop your
child thread. Be careful however because in this case you don't
control when your method is called (it may be after your thread is
already finished).
> Also, is there any form of mutex or lock I can use to protect access to a
> linked list shared between threads? It would appear that RTLCriticalSection
> might do what I want.
Yes, it will do fine. The TCriticalSection is just a wrapper over
RTLCriticalSection.
--
cobines
unit uGuiMessageQueue;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, syncobjs;
type
TGuiMessageProc = procedure (Data: Pointer) of object;
PMessageQueueItem = ^TMessageQueueItem;
TMessageQueueItem = record
Method: TGuiMessageProc;
Data : Pointer;
Next : PMessageQueueItem;
end;
TGuiMessageQueueThread = class(TThread)
private
FWakeThreadEvent: PRTLEvent;
FMessageQueue: PMessageQueueItem;
FMessageQueueLastItem: PMessageQueueItem;
FMessageQueueLock: TCriticalSection;
{en
This method executes some queued functions.
It is called from main thread through Synchronize.
}
procedure CallMethods;
public
constructor Create(CreateSuspended: Boolean = False); reintroduce;
destructor Destroy; override;
procedure Terminate;
procedure Execute; override;
{en
@param(AllowDuplicates
If @false then if the queue already has AMethod with
AData parameter then it is not queued for a second time.
If @true then the same methods with the same parameters
are allowed to exists multiple times in the queue.)
}
procedure QueueMethod(AMethod: TGuiMessageProc; AData: Pointer;
AllowDuplicates: Boolean = True);
end;
procedure InitializeGuiMessageQueue;
procedure FinalizeGuiMessageQueue;
var
GuiMessageQueue: TGuiMessageQueueThread;
implementation
uses
LCLProc, uExceptions;
const
// How many functions maximum to call per one Synchronize.
MaxMessages = 10;
constructor TGuiMessageQueueThread.Create(CreateSuspended: Boolean = False);
begin
FWakeThreadEvent := RTLEventCreate;
FMessageQueue := nil;
FMessageQueueLastItem := nil;
FMessageQueueLock := TCriticalSection.Create;
inherited Create(CreateSuspended, DefaultStackSize);
FreeOnTerminate := True;
end;
destructor TGuiMessageQueueThread.Destroy;
var
item: PMessageQueueItem;
begin
// Make sure the thread is not running anymore.
Terminate;
FMessageQueueLock.Acquire;
while Assigned(FMessageQueue) do
begin
item := FMessageQueue^.Next;
Dispose(FMessageQueue);
FMessageQueue := item;
end;
FMessageQueueLock.Release;
RTLeventdestroy(FWakeThreadEvent);
FreeAndNil(FMessageQueueLock);
inherited Destroy;
end;
procedure TGuiMessageQueueThread.Terminate;
begin
inherited Terminate;
// Wake after setting Terminate to True.
RTLeventSetEvent(FWakeThreadEvent);
end;
procedure TGuiMessageQueueThread.Execute;
begin
while not Terminated do
begin
if Assigned(FMessageQueue) then
// Call some methods.
Synchronize(@CallMethods)
else
// Wait for messages.
RTLeventWaitFor(FWakeThreadEvent);
end;
end;
procedure TGuiMessageQueueThread.QueueMethod(AMethod: TGuiMessageProc; AData: Pointer;
AllowDuplicates: Boolean = True);
var
item: PMessageQueueItem;
begin
FMessageQueueLock.Acquire;
try
if AllowDuplicates = False then
begin
// Search the queue for this method and parameter.
item := FMessageQueue;
while Assigned(item) do
begin
if (item^.Method = AMethod) and (item^.Data = AData) then
Exit;
item := item^.Next;
end;
end;
New(item);
item^.Method := AMethod;
item^.Data := AData;
item^.Next := nil;
if not Assigned(FMessageQueue) then
FMessageQueue := item
else
FMessageQueueLastItem^.Next := item;
FMessageQueueLastItem := item;
RTLeventSetEvent(FWakeThreadEvent);
finally
FMessageQueueLock.Release;
end;
end;
procedure TGuiMessageQueueThread.CallMethods;
var
MessagesCount: Integer = MaxMessages;
item: PMessageQueueItem;
begin
while Assigned(FMessageQueue) and (MessagesCount > 0) do
begin
try
// Call method with parameter.
FMessageQueue^.Method(FMessageQueue^.Data);
except
on Exception do
begin
WriteExceptionToErrorFile;
DebugLn(ExceptionToString);
ShowExceptionDialog;
end;
end;
FMessageQueueLock.Acquire;
try
item := FMessageQueue^.Next;
Dispose(FMessageQueue);
FMessageQueue := item;
// If queue is empty then reset wait event (must be done under lock).
if not Assigned(FMessageQueue) then
RTLeventResetEvent(FWakeThreadEvent);
finally
FMessageQueueLock.Release;
end;
Dec(MessagesCount, 1);
end;
end;
// ----------------------------------------------------------------------------
procedure InitializeGuiMessageQueue;
begin
GuiMessageQueue := TGuiMessageQueueThread.Create(False);
end;
procedure FinalizeGuiMessageQueue;
begin
GuiMessageQueue.Terminate;
WaitForThreadTerminate(GuiMessageQueue.ThreadID, 10000); // wait max 10 seconds
end;
initialization
InitializeGuiMessageQueue;
finalization
FinalizeGuiMessageQueue;
end.
--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
