Parcourir la source

* [uutlMessageThread] moved ProgressMessages method to MessageQueue

master
Bergmann89 il y a 9 ans
Parent
révision
375d4687cd
1 fichiers modifiés avec 42 ajouts et 31 suppressions
  1. +42
    -31
      uutlMessageThread.pas

+ 42
- 31
uutlMessageThread.pas Voir le fichier

@@ -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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////


Chargement…
Annuler
Enregistrer