Browse Source

* [uutlMessageThread] moved ProgressMessages method to MessageQueue

master
Bergmann89 9 years ago
parent
commit
375d4687cd
1 changed files with 42 additions and 31 deletions
  1. +42
    -31
      uutlMessageThread.pas

+ 42
- 31
uutlMessageThread.pas View File

@@ -16,13 +16,16 @@ type
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlMessageThread = class(TThread, IUnknown) TutlMessageThread = class(TThread, IUnknown)
public type public type
TMessageProgressCallback = procedure(const aMsg: TutlMessage) of Object;
TMessageQueue = class(specialize TutlSyncQueue<TutlMessage>) TMessageQueue = class(specialize TutlSyncQueue<TutlMessage>)
private private
fEvent: TSimpleEvent; fEvent: TSimpleEvent;
public public
procedure Push(const aItem: T); override; procedure Push(const aItem: T); override;
function Pop(out aItem: T): Boolean; override; function Pop(out aItem: T): Boolean; override;

function WaitForMessages(const aWaitTime: Cardinal = INFINITE): Boolean; function WaitForMessages(const aWaitTime: Cardinal = INFINITE): Boolean;
function ProcessMessages(const aProgressCallback: TMessageProgressCallback): Boolean;


constructor Create(const aOwnsObjects: Boolean = true); constructor Create(const aOwnsObjects: Boolean = true);
destructor Destroy; override; destructor Destroy; override;
@@ -179,6 +182,44 @@ begin
raise EWait.Create('Error while waiting for messages', wr); raise EWait.Create('Error while waiting for messages', wr);
end; 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); constructor TutlMessageThread.TMessageQueue.Create(const aOwnsObjects: Boolean);
begin begin
@@ -263,38 +304,8 @@ end;


//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMessageThread.ProcessMessages: Boolean; function TutlMessageThread.ProcessMessages: Boolean;
var
m: TutlMessage;
empty: Boolean;
begin 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; end;


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


Loading…
Cancel
Save