|
|
@@ -16,13 +16,16 @@ type |
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
TutlMessageThread = class(TThread, IUnknown) |
|
|
|
public type |
|
|
|
TMessageProgressCallback = procedure(const aMsg: TutlMessage) of Object; |
|
|
|
TMessageQueue = class(specialize TutlSyncQueue<TutlMessage>) |
|
|
|
private |
|
|
|
fEvent: TSimpleEvent; |
|
|
|
public |
|
|
|
procedure Push(const aItem: T); override; |
|
|
|
function Pop(out aItem: T): Boolean; override; |
|
|
|
|
|
|
|
function WaitForMessages(const aWaitTime: Cardinal = INFINITE): Boolean; |
|
|
|
function ProcessMessages(const aProgressCallback: TMessageProgressCallback): Boolean; |
|
|
|
|
|
|
|
constructor Create(const aOwnsObjects: Boolean = true); |
|
|
|
destructor Destroy; override; |
|
|
@@ -179,6 +182,44 @@ begin |
|
|
|
raise EWait.Create('Error while waiting for messages', wr); |
|
|
|
end; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
function TutlMessageThread.TMessageQueue.ProcessMessages(const aProgressCallback: TMessageProgressCallback): Boolean; |
|
|
|
var |
|
|
|
m: TutlMessage; |
|
|
|
empty: Boolean; |
|
|
|
begin |
|
|
|
empty := false; |
|
|
|
result := false; |
|
|
|
if not Assigned(aProgressCallback) then |
|
|
|
exit; |
|
|
|
repeat |
|
|
|
try |
|
|
|
if Pop(m) then begin |
|
|
|
result := true; |
|
|
|
try |
|
|
|
aProgressCallback(m); |
|
|
|
finally |
|
|
|
if (m is TutlSynchronousMessage) then |
|
|
|
(m as TutlSynchronousMessage).Finish |
|
|
|
else |
|
|
|
FreeAndNil(m); |
|
|
|
end; |
|
|
|
end else |
|
|
|
empty := true; |
|
|
|
except |
|
|
|
on e: Exception do begin |
|
|
|
utlLogger.Error(self, 'error while progressing message %s(ID: %d; wParam: %s; lParam: %s): %s - %s', [ |
|
|
|
m.ClassName, |
|
|
|
m.ID, |
|
|
|
IntToHex(m.wParam, SizeOf(m.wParam) div 4), |
|
|
|
IntToHex(m.wParam, SizeOf(m.wParam) div 4), |
|
|
|
e.ClassName, |
|
|
|
e.Message]); |
|
|
|
end; |
|
|
|
end; |
|
|
|
until empty; |
|
|
|
end; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
constructor TutlMessageThread.TMessageQueue.Create(const aOwnsObjects: Boolean); |
|
|
|
begin |
|
|
@@ -263,38 +304,8 @@ end; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
function TutlMessageThread.ProcessMessages: Boolean; |
|
|
|
var |
|
|
|
m: TutlMessage; |
|
|
|
empty: Boolean; |
|
|
|
begin |
|
|
|
empty := false; |
|
|
|
result := false; |
|
|
|
repeat |
|
|
|
try |
|
|
|
if fMessages.Pop(m) then begin |
|
|
|
result := true; |
|
|
|
try |
|
|
|
ProcessMessage(m); |
|
|
|
finally |
|
|
|
if (m is TutlSynchronousMessage) then |
|
|
|
(m as TutlSynchronousMessage).Finish |
|
|
|
else |
|
|
|
FreeAndNil(m); |
|
|
|
end; |
|
|
|
end else |
|
|
|
empty := true; |
|
|
|
except |
|
|
|
on e: Exception do begin |
|
|
|
utlLogger.Error(self, 'error while progressing message %s(ID: %d; wParam: %s; lParam: %s): %s - %s', [ |
|
|
|
m.ClassName, |
|
|
|
m.ID, |
|
|
|
IntToHex(m.wParam, SizeOf(m.wParam) div 4), |
|
|
|
IntToHex(m.wParam, SizeOf(m.wParam) div 4), |
|
|
|
e.ClassName, |
|
|
|
e.Message]); |
|
|
|
end; |
|
|
|
end; |
|
|
|
until empty; |
|
|
|
result := fMessages.ProcessMessages(@ProcessMessage); |
|
|
|
end; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|