pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

lazMapViewer: More cosmetic changes.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6314 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-04-16 21:57:42 +00:00
parent 119046bcbc
commit d70b3d3e26
4 changed files with 505 additions and 480 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/lazmapviewer/example/MapViewer_Demo.lpi
View File

@ -59,6 +59,10 @@
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Linking> <Linking>
<Debugging>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options> <Options>
<Win32> <Win32>
<GraphicApplication Value="True"/> <GraphicApplication Value="True"/>

5
components/lazmapviewer/source/mvengine.pas
View File

@ -257,14 +257,15 @@ begin
end; end;
procedure TLaunchDownloadJob.ExecuteTask(aTask: integer; FromWaiting: boolean); procedure TLaunchDownloadJob.ExecuteTask(aTask: integer; FromWaiting: boolean);
var iTile : integer; var
iTile: integer;
begin begin
iTile := aTask - 1; iTile := aTask - 1;
Queue.AddUniqueJob(TEventJob.Create Queue.AddUniqueJob(TEventJob.Create
( (
@Engine.evDownload, @Engine.evDownload,
TEnvTile.Create(FTiles[iTile], Win), TEnvTile.Create(FTiles[iTile], Win),
false, false, // owns data
Engine.GetTileName(FTiles[iTile]) Engine.GetTileName(FTiles[iTile])
), ),
Launcher Launcher

512
components/lazmapviewer/source/mvjobqueue.pas
View File

@ -24,11 +24,12 @@ interface
uses uses
Classes, SysUtils,syncobjs,contnrs,forms; Classes, SysUtils,syncobjs,contnrs,forms;
const ALL_TASK_COMPLETED = -1; const
ALL_TASK_COMPLETED = -1;
NO_MORE_TASK = 0; NO_MORE_TASK = 0;
type type
TjobQueue = class; TJobQueue = class;
{ TJob } { TJob }
@ -60,9 +61,9 @@ type
TJobArray = Array of TJob; TJobArray = Array of TJob;
{ TjobQueue } { TJobQueue }
TjobQueue = Class TJobQueue = Class
private private
FMainThreadId : TThreadID; FMainThreadId : TThreadID;
FOnIdle: TNotifyEvent; FOnIdle: TNotifyEvent;
@ -109,26 +110,26 @@ type
implementation implementation
const const
WAIT_TIME = 3000; WAIT_TIME = 3000;
TERMINATE_TIMEOUT = 1000; TERMINATE_TIMEOUT = 1000;
type
Type
{ EWaiting } { EWaiting }
EWaiting = Class(Exception) EWaiting = class(Exception)
private private
FLauncher: TJob; FLauncher: TJob;
FNewJob: TJob; FNewJob: TJob;
public public
constructor Create(launcher : TJob;NewJob : TJob); constructor Create(ALauncher: TJob; ANewJob: TJob);
end; end;
{ TRestartTask } { TRestartTask }
TRestartTask = Class(TJob) TRestartTask = class(TJob)
private private
FStarted: Boolean; FStarted: Boolean;
FJob: TJob; FJob: TJob;
@ -146,15 +147,41 @@ Type
{ TQueueThread } { TQueueThread }
TQueueThread = Class(TThread) TQueueThread = class(TThread)
private private
MyQueue : TJobqueue; MyQueue: TJobQueue;
function ProcessJob: boolean; function ProcessJob: boolean;
public public
constructor Create(aQueue: TJobQueue); constructor Create(aQueue: TJobQueue);
procedure Execute; override; procedure Execute; override;
end; end;
{ TSyncCallData }
TSyncCallData = Class
private
FMethod: TDataEvent;
FData: PtrInt;
public
constructor Create(AMethod: TDataEvent; AData: PtrInt);
procedure SyncCall;
end;
{ TSyncCallData }
constructor TSyncCallData.Create(AMethod: TDataEvent; AData: PtrInt);
begin
FMethod := AMethod;
FData := AData;
end;
procedure TSyncCallData.SyncCall;
begin
FMethod(FData);
end;
{ TRestartTask } { TRestartTask }
procedure TRestartTask.DoCancel; procedure TRestartTask.DoCancel;
@ -193,76 +220,21 @@ end;
function TRestartTask.Running: boolean; function TRestartTask.Running: boolean;
begin begin
Result:=Fstarted; Result := FStarted;
end; end;
{ EWaiting } { EWaiting }
constructor EWaiting.Create(launcher: TJob; NewJob: TJob); constructor EWaiting.Create(ALauncher: TJob; ANewJob: TJob);
begin begin
FLauncher:=launcher; FLauncher := ALauncher;
FNewJob:=NewJob; FNewJob := ANewJob;
end; end;
{ TQueueThread } { TQueueThread }
function TQueueThread.ProcessJob : boolean;
var aJob : TJob;
TaskId : Integer;
Procedure SetRes(e : Exception);
Begin
MyQueue.EnterCriticalSection;
Try
MyQueue.pTaskEnded(aJob,TaskId,nil);
finally
MyQueue.LeaveCriticalSection;
end;
end;
var RestartTask : boolean;
SomeJob : Boolean;
begin
Result:=false;
Repeat
SomeJob:=false;
MyQueue.EnterCriticalSection;
Try
result:=result or (MyQueue.Jobs.Count>0);
aJob:=MyQueue.pGetJob(TaskId,RestartTask);
if Assigned(aJob) then
Begin
if TaskId=ALL_TASK_COMPLETED then
begin
MyQueue.pJobCompleted(aJob);
SomeJob := true;
end
else
Begin
MyQueue.FEvent.ResetEvent;
if not(RestartTask) then
MyQueue.pTaskStarted(aJob,TaskId);
end;
end;
finally
MyQueue.LeaveCriticalSection;
end;
if Assigned(aJob) then
Begin
SomeJob:=true;
Try
aJob.ExecuteTask(TaskId,RestartTask);
SetRes(nil);
Except
on e : Exception do
if e.InheritsFrom(EWaiting) then
MyQueue.DoWaiting(e,TaskId)
else
SetRes(e);
end;
end;
until SomeJob=false;
end;
constructor TQueueThread.Create(aQueue: TJobQueue); constructor TQueueThread.Create(aQueue: TJobQueue);
begin begin
MyQueue := aQueue; MyQueue := aQueue;
@ -270,21 +242,22 @@ begin
end; end;
procedure TQueueThread.Execute; procedure TQueueThread.Execute;
var wRes : TWaitResult; var
wRes: TWaitResult;
begin begin
while not Terminated do while not Terminated do
begin begin
wRes := MyQueue.FEvent.WaitFor(WAIT_TIME); wRes := MyQueue.FEvent.WaitFor(WAIT_TIME);
if not(Terminated) then if not Terminated then
Begin begin
if not(ProcessJob) then if not ProcessJob then
if wRes = wrTimeout then if wRes = wrTimeout then
if Assigned(MyQueue.OnIdle) then if Assigned(MyQueue.OnIdle) then
MyQueue.OnIdle(self); MyQueue.OnIdle(self);
end; end;
end; end;
MyQueue.EnterCriticalSection; MyQueue.EnterCriticalSection;
Try try
inc(MyQueue.TerminatedThread); inc(MyQueue.TerminatedThread);
if Assigned(MyQueue.TerminateEvent) then if Assigned(MyQueue.TerminateEvent) then
if MyQueue.TerminatedThread=MyQueue.Threads.count then if MyQueue.TerminatedThread=MyQueue.Threads.count then
@ -294,29 +267,107 @@ begin
end; end;
end; end;
{ TjobQueue } function TQueueThread.ProcessJob: boolean;
var
aJob: TJob;
TaskId: Integer;
procedure TjobQueue.SetUseThreads(AValue: boolean); procedure SetRes(e: Exception);
begin
MyQueue.EnterCriticalSection;
try
MyQueue.pTaskEnded(aJob,TaskId,nil);
finally
MyQueue.LeaveCriticalSection;
end;
end;
var
RestartTask: boolean;
SomeJob: Boolean;
begin
Result := false;
Repeat
SomeJob := false;
MyQueue.EnterCriticalSection;
try
Result := Result or (MyQueue.Jobs.Count > 0);
aJob := MyQueue.pGetJob(TaskId, RestartTask);
if Assigned(aJob) then
begin
if TaskId = ALL_TASK_COMPLETED then
begin
MyQueue.pJobCompleted(aJob);
SomeJob := true;
end
else
begin
MyQueue.FEvent.ResetEvent;
if not(RestartTask) then
MyQueue.pTaskStarted(aJob, TaskId);
end;
end;
finally
MyQueue.LeaveCriticalSection;
end;
if Assigned(aJob) then
begin
SomeJob := true;
try
aJob.ExecuteTask(TaskId, RestartTask);
SetRes(nil);
except
on e: Exception do
if e.InheritsFrom(EWaiting) then
MyQueue.DoWaiting(e, TaskId)
else
SetRes(e);
end;
end;
until not SomeJob;
end;
{ TJobQueue }
constructor TJobQueue.Create(NbThread: integer);
begin
waitings := TStringList.Create;
FNbThread := NbThread;
FMainThreadId := GetCurrentThreadId;
end;
destructor TJobQueue.Destroy;
begin
FreeThreads;
ClearWaitings;
FreeAndNil(Waitings);
inherited;
end;
procedure TJobQueue.SetUseThreads(AValue: boolean);
begin begin
if FUseThreads = AValue then if FUseThreads = AValue then
Exit; Exit;
FUseThreads := AValue; FUseThreads := AValue;
if Fusethreads then if FUsethreads then
InitThreads InitThreads
else else
FreeThreads; FreeThreads;
end; end;
procedure TjobQueue.ClearWaitings; procedure TJobQueue.ClearWaitings;
var i : integer; var
i: integer;
begin begin
For i:=0 to pred(Waitings.count) do for i := 0 to pred(Waitings.count) do
Waitings.Objects[i].Free; Waitings.Objects[i].Free;
Waitings.Clear; Waitings.Clear;
end; end;
procedure TjobQueue.InitThreads; procedure TJobQueue.InitThreads;
var i : integer; var
i: integer;
begin begin
Jobs := TObjectList.Create(true); Jobs := TObjectList.Create(true);
Threads := TObjectList.Create(true); Threads := TObjectList.Create(true);
@ -327,16 +378,17 @@ begin
Threads.Add(TQueueThread.Create(self)); Threads.Add(TQueueThread.Create(self));
end; end;
procedure TjobQueue.FreeThreads; procedure TJobQueue.FreeThreads;
var i : integer; var
i: integer;
begin begin
if Assigned(Threads) then if Assigned(Threads) then
Begin begin
TerminateEvent := TEvent.Create(nil, false, false, ''); TerminateEvent := TEvent.Create(nil, false, false, '');
Try try
FEvent.SetEvent; FEvent.SetEvent;
TerminatedThread := 0; TerminatedThread := 0;
For i:=0 to pred(Threads.Count) do for i:=0 to pred(Threads.Count) do
TQueueThread(Threads[i]).Terminate; TQueueThread(Threads[i]).Terminate;
TerminateEvent.WaitFor(TERMINATE_TIMEOUT); TerminateEvent.WaitFor(TERMINATE_TIMEOUT);
FreeAndNil(FSect); FreeAndNil(FSect);
@ -349,20 +401,21 @@ begin
end; end;
end; end;
procedure TjobQueue.EnterCriticalSection; procedure TJobQueue.EnterCriticalSection;
begin begin
if Assigned(FSect) and UseThreads then if Assigned(FSect) and UseThreads then
FSect.Enter; FSect.Enter;
end; end;
procedure TjobQueue.LeaveCriticalSection; procedure TJobQueue.LeaveCriticalSection;
begin begin
if Assigned(FSect) and UseThreads then if Assigned(FSect) and UseThreads then
FSect.Leave; FSect.Leave;
end; end;
procedure TjobQueue.DoWaiting(E : Exception;TaskId : integer); procedure TJobQueue.DoWaiting(E: Exception; TaskId: integer);
var we : EWaiting; var
we: EWaiting;
begin begin
EnterCriticalSection; EnterCriticalSection;
try try
@ -374,21 +427,21 @@ begin
end; end;
end; end;
procedure TjobQueue.pAddWaiting(aJob: TJob; aTask: integer; JobId: String); procedure TJobQueue.pAddWaiting(aJob: TJob; aTask: integer; JobId: String);
begin begin
Waitings.AddObject(JobId, TRestartTask.Create(aJob, aTask)); Waitings.AddObject(JobId, TRestartTask.Create(aJob, aTask));
end; end;
procedure TjobQueue.pTaskStarted(aJob: TJob; aTask: integer); procedure TJobQueue.pTaskStarted(aJob: TJob; aTask: integer);
begin begin
aJob.pTaskStarted(aTask); aJob.pTaskStarted(aTask);
end; end;
procedure TjobQueue.pJobCompleted(var aJob: TJob); procedure TJobQueue.pJobCompleted(var aJob: TJob);
Begin Begin
pNotifyWaitings(aJob); pNotifyWaitings(aJob);
if FuseThreads then if FuseThreads then
Begin begin
Jobs.Remove(aJob); Jobs.Remove(aJob);
aJob := nil; aJob := nil;
end end
@ -396,72 +449,74 @@ Begin
FreeAndNil(aJob); FreeAndNil(aJob);
end; end;
procedure TjobQueue.pTaskEnded(var aJob: TJob; aTask: integer; aExcept: Exception); procedure TJobQueue.pTaskEnded(var aJob: TJob; aTask: integer; aExcept: Exception);
begin begin
aJob.pTaskEnded(aTask, aExcept); aJob.pTaskEnded(aTask, aExcept);
if (aJob.pGetTask = ALL_TASK_COMPLETED) then if (aJob.pGetTask = ALL_TASK_COMPLETED) then
Begin
pJobcompleted(aJob); pJobcompleted(aJob);
end; end;
end;
function TjobQueue.pGetJob(out TaskId : integer;out Restart : boolean): TJob; function TJobQueue.pGetJob(out TaskId: integer; out Restart: boolean): TJob;
var iJob : integer; var
iJob: integer;
aJob: TJob; aJob: TJob;
begin begin
Restart := false; Restart := false;
Result := nil; Result := nil;
For iJob:=0 to pred(Jobs.Count) do for iJob := 0 to pred(Jobs.Count) do
Begin begin
aJob := TJob(Jobs[iJob]); aJob := TJob(Jobs[iJob]);
if aJob.InheritsFrom(TRestartTask) then if aJob.InheritsFrom(TRestartTask) then
Begin begin
result:=TRestartTask(aJob).FJob; Result := TRestartTask(aJob).FJob;
TaskId := TRestartTask(aJob).FTask; TaskId := TRestartTask(aJob).FTask;
Restart := true; Restart := true;
Jobs.Delete(iJob); Jobs.Delete(iJob);
Exit; exit;
end; end;
TaskId := aJob.pGetTask; TaskId := aJob.pGetTask;
if (TaskId>NO_MORE_TASK) or (TaskId=ALL_TASK_COMPLETED) then if (TaskId>NO_MORE_TASK) or (TaskId=ALL_TASK_COMPLETED) then
Begin begin
Result := aJob; Result := aJob;
Exit; Exit;
end; end;
end; end;
if not(assigned(result)) then if not Assigned(Result) then
TaskId := NO_MORE_TASK; TaskId := NO_MORE_TASK;
end; end;
function TjobQueue.pFindJobByName(const aName: string;ByLauncher: TObject): TJobArray; function TJobQueue.pFindJobByName(const aName: string;
var iRes,i : integer; ByLauncher: TObject): TJobArray;
var
iRes, i: integer;
begin begin
SetLength(result,Jobs.count); SetLength(Result, Jobs.Count);
iRes := 0; iRes := 0;
For i:=0 to pred(Jobs.Count) do for i := 0 to pred(Jobs.Count) do
Begin begin
if TJob(Jobs[i]).Name = aName then if TJob(Jobs[i]).Name = aName then
begin begin
if (ByLauncher = nil) or (TJob(Jobs[i]).FLauncher = ByLauncher) then if (ByLauncher = nil) or (TJob(Jobs[i]).FLauncher = ByLauncher) then
Begin begin
Result[iRes] := TJob(Jobs[i]); Result[iRes] := TJob(Jobs[i]);
inc(iRes); inc(iRes);
end; end;
end; end;
end; end;
SetLength(result,iRes); SetLength(Result, iRes);
end; end;
procedure TjobQueue.pNotifyWaitings(aJob: TJob); procedure TJobQueue.pNotifyWaitings(aJob: TJob);
var JobId : String; var
JobId: String;
ObjRestart: TRestartTask; ObjRestart: TRestartTask;
idx: integer; idx: integer;
begin begin
JobId := aJob.Name; JobId := aJob.Name;
Repeat repeat
idx := waitings.IndexOf(JobId); idx := waitings.IndexOf(JobId);
if idx <> -1 then if idx <> -1 then
Begin begin
ObjRestart := TRestartTask(waitings.Objects[idx]); ObjRestart := TRestartTask(waitings.Objects[idx]);
waitings.Delete(idx); waitings.Delete(idx);
Jobs.Add(ObjRestart); Jobs.Add(ObjRestart);
@ -469,27 +524,12 @@ begin
until idx = -1; until idx = -1;
end; end;
function TjobQueue.IsMainThread: boolean; function TJobQueue.IsMainThread: boolean;
begin begin
Result:=GetCurrentThreadId=FMainThreadID; Result := (GetCurrentThreadId = FMainThreadID);
end; end;
constructor TjobQueue.Create(NbThread: integer); procedure TJobQueue.QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);
begin
waitings := TStringList.create;
FNbThread := NbThread;
FMainThreadId := GetCurrentThreadId;
end;
destructor TjobQueue.Destroy;
begin
FreeThreads;
ClearWaitings;
FreeAndNil(Waitings);
inherited;
end;
procedure TjobQueue.QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);
begin begin
if UseThreads then if UseThreads then
Application.QueueAsyncCall(aMethod,Data) Application.QueueAsyncCall(aMethod,Data)
@ -497,84 +537,58 @@ begin
AMethod(Data); AMethod(Data);
end; end;
procedure TJobQueue.QueueSyncCall(const AMethod: TDataEvent; Data: PtrInt);
Type var
tmp: TSyncCallData;
{ TSyncCallData }
TSyncCallData = Class
private
FMethod : TDataEvent;
FData : PtrInt;
public
Constructor Create(AMethod : TDataEvent;AData : PtrInt);
Procedure SyncCall;
End;
{ TSyncCallData }
constructor TSyncCallData.Create(AMethod: TDataEvent; AData: PtrInt);
begin
FMethod:=AMethod;
FData:=AData;
end;
procedure TSyncCallData.SyncCall;
begin
FMethod(FData);
end;
procedure TjobQueue.QueueSyncCall(const AMethod: TDataEvent; Data: PtrInt);
var tmp : TSyncCallData;
begin begin
tmp := TSyncCallData.Create(AMethod,Data); tmp := TSyncCallData.Create(AMethod,Data);
Try try
TThread.Synchronize(nil, @tmp.SyncCall); TThread.Synchronize(nil, @tmp.SyncCall);
finally finally
tmp.free; tmp.Free;
end; end;
end; end;
procedure TjobQueue.AddJob(aJob: TJob;Launcher : TObject); procedure TJobQueue.AddJob(aJob: TJob; Launcher: TObject);
var TaskId : Integer; var
TaskId: Integer;
restart: boolean; restart: boolean;
begin begin
aJob.FLauncher := Launcher; aJob.FLauncher := Launcher;
aJob.Queue := self; aJob.Queue := self;
if Usethreads then if Usethreads then
Begin begin
EnterCriticalSection; EnterCriticalSection;
Try try
Jobs.add(aJob); Jobs.Add(aJob);
finally finally
LeaveCriticalSection; LeaveCriticalSection;
end; end;
FEvent.SetEvent; FEvent.SetEvent;
end end
Else else
Begin begin
Try try
Repeat repeat
TaskId := aJob.pGetTask; TaskId := aJob.pGetTask;
restart := false; restart := false;
if TaskId > NO_MORE_TASK then if TaskId > NO_MORE_TASK then
Begin begin
pTaskStarted(aJob, TaskId); pTaskStarted(aJob, TaskId);
Try try
aJob.ExecuteTask(TaskId, restart); aJob.ExecuteTask(TaskId, restart);
pTaskEnded(aJob,TaskId, nil); pTaskEnded(aJob,TaskId, nil);
except except
on e: Exception do on e: Exception do
Begin begin
if not(e.InheritsFrom(EWaiting)) then if not e.InheritsFrom(EWaiting) then
pTaskEnded(aJob, TaskId, e) pTaskEnded(aJob, TaskId, e)
else else
DoWaiting(e, TaskId); DoWaiting(e, TaskId);
end; end;
end; end;
end; end;
if not(Assigned(aJob)) then if not Assigned(aJob) then
TaskId := ALL_TASK_COMPLETED; TaskId := ALL_TASK_COMPLETED;
until TaskId = ALL_TASK_COMPLETED; until TaskId = ALL_TASK_COMPLETED;
finally finally
@ -583,19 +597,20 @@ begin
end; end;
end; end;
function TjobQueue.AddUniqueJob(aJob: TJob; Launcher: TObject): boolean; function TJobQueue.AddUniqueJob(aJob: TJob; Launcher: TObject): boolean;
var lst : TJobArray; var
lst: TJobArray;
begin begin
Result := true; Result := true;
if FUseThreads then if FUseThreads then
Begin begin
aJob.Queue := self; aJob.Queue := self;
aJob.FLauncher := Launcher; aJob.FLauncher := Launcher;
EnterCriticalSection; EnterCriticalSection;
Try try
lst := pFindJobByName(aJob.Name, Launcher); lst := pFindJobByName(aJob.Name, Launcher);
if length(lst)=0 then if Length(lst) = 0 then
Jobs.add(aJob) Jobs.Add(aJob)
else else
Result := false; Result := false;
finally finally
@ -603,29 +618,30 @@ begin
end; end;
FEvent.SetEvent;; FEvent.SetEvent;;
end end
Else else
AddJob(aJob,Launcher); AddJob(aJob,Launcher);
end; end;
function TjobQueue.CancelAllJob(ByLauncher: TObject) : TJobArray; function TJobQueue.CancelAllJob(ByLauncher: TObject): TJobArray;
var i,iJob : integer; var
i, iJob: integer;
begin begin
SetLength(Result, 0); SetLength(Result, 0);
if FUseThreads then if FUseThreads then
Begin begin
EnterCriticalSection; EnterCriticalSection;
Try try
SetLEngth(Result, Jobs.Count); SetLEngth(Result, Jobs.Count);
iJob := 0; iJob := 0;
For i:=pred(Jobs.Count) downto 0 do for i := pred(Jobs.Count) downto 0 do
Begin begin
if (ByLauncher = nil) or (TJob(Jobs[i]).FLauncher = ByLauncher) then if (ByLauncher = nil) or (TJob(Jobs[i]).FLauncher = ByLauncher) then
Begin begin
TJob(Jobs[i]).Cancel; TJob(Jobs[i]).Cancel;
Result[iJob] := TJob(Jobs[i]); Result[iJob] := TJob(Jobs[i]);
iJob += 1; iJob += 1;
End; end;
End; end;
SetLength(Result, iJob); SetLength(Result, iJob);
finally finally
LeaveCriticalSection; LeaveCriticalSection;
@ -633,29 +649,31 @@ begin
end; end;
end; end;
function TjobQueue.CancelJobByName(aJobName: String;ByLauncher: TObject) : boolean; function TJobQueue.CancelJobByName(aJobName: String; ByLauncher: TObject): boolean;
var lst : TJobArray; var
lst: TJobArray;
i: integer; i: integer;
begin begin
Result := false; Result := false;
if FUseThreads then if FUseThreads then
Begin begin
EnterCriticalSection; EnterCriticalSection;
Try try
lst := pFindJobByName(aJobName, ByLauncher); lst := pFindJobByName(aJobName, ByLauncher);
For i:=low(lst) to high(lst) do for i := Low(lst) to High(lst) do
Begin begin
result:=true; Result := true;
lst[i].Cancel; lst[i].Cancel;
End; end;
finally finally
LeaveCriticalSection; LeaveCriticalSection;
end; end;
end; end;
end; end;
procedure TjobQueue.WaitForTerminate(const lstJob: TJobArray); procedure TJobQueue.WaitForTerminate(const lstJob: TJobArray);
var OneFound : Boolean; var
OneFound: Boolean;
i: integer; i: integer;
mThread: Boolean; mThread: Boolean;
TimeOut: integer; TimeOut: integer;
@ -663,15 +681,15 @@ begin
TimeOut := 0; TimeOut := 0;
mThread := IsMainThread; mThread := IsMainThread;
if FUseThreads then if FUseThreads then
Begin begin
repeat repeat
OneFound := False; OneFound := False;
EnterCriticalSection; EnterCriticalSection;
Try try
For i:=low(lstJob) to high(lstJob) do for i := Low(lstJob) to High(lstJob) do
Begin begin
if Jobs.IndexOf(lstJob[i]) <> -1 then if Jobs.IndexOf(lstJob[i]) <> -1 then
Begin begin
OneFound := True; OneFound := True;
break; break;
end; end;
@ -680,52 +698,53 @@ begin
LeaveCriticalSection; LeaveCriticalSection;
end; end;
if OneFound and (TimeOut > 200) then if OneFound and (TimeOut > 200) then
Raise Exception.Create('TimeOut'); raise Exception.Create('TimeOut');
if mThread then if mThread then
Application.ProcessMessages; Application.ProcessMessages;
if OneFound then if OneFound then
Sleep(100); Sleep(100);
Inc(TimeOut); Inc(TimeOut);
until not(OneFound); until not OneFound;
end; end;
end; end;
procedure TjobQueue.WaitAllJobTerminated(ByLauncher: TObject); procedure TJobQueue.WaitAllJobTerminated(ByLauncher: TObject);
var OneFound : boolean; var
OneFound: boolean;
i: integer; i: integer;
TimeOut: integer; TimeOut: integer;
mThread: Boolean; mThread: Boolean;
Procedure CheckTimeOut; procedure CheckTimeOut;
Begin begin
if TimeOut > 200 then if TimeOut > 200 then
Raise Exception.Create('TimeOut'); raise Exception.Create('TimeOut');
if mThread then if mThread then
Application.ProcessMessages; Application.ProcessMessages;
sleep(100); Sleep(100);
inc(TimeOut); inc(TimeOut);
end; end;
begin begin
TimeOut := 0; TimeOut := 0;
if FUseThreads then if FUseThreads then
Begin begin
mThread := IsMainThread; mThread := IsMainThread;
if ByLauncher = nil then if ByLauncher = nil then
Begin begin
While Jobs.Count>0 do while Jobs.Count > 0 do
CheckTimeOut; CheckTimeOut;
end end
else else
Begin begin
repeat repeat
OneFound := False; OneFound := False;
EnterCriticalSection; EnterCriticalSection;
Try try
For i:=0 to pred(Jobs.Count) do for i := 0 to pred(Jobs.Count) do
Begin begin
if TJob(Jobs[i]).FLauncher = ByLauncher then if TJob(Jobs[i]).FLauncher = ByLauncher then
Begin begin
OneFound := True; OneFound := True;
break; break;
end; end;
@ -735,34 +754,35 @@ begin
end; end;
if OneFound then if OneFound then
CheckTimeOut; CheckTimeOut;
until not(OneFound); until not OneFound;
end; end;
end; end;
end; end;
{ TjobQueue } { TJobQueue }
procedure TJob.Cancel; procedure TJob.Cancel;
var lst : Array of TRestartTask; var
lst: Array of TRestartTask;
i, idx: integer; i, idx: integer;
begin begin
Queue.EnterCriticalSection; Queue.EnterCriticalSection;
Try try
FCancelled := true; FCancelled := true;
if (Name<>'') and (Queue.waitings.count>0) then if (Name <> '') and (Queue.waitings.Count > 0) then
Begin begin
SetLength(lst, 0); SetLength(lst, 0);
Repeat repeat
idx := Queue.waitings.IndexOf(Name); idx := Queue.waitings.IndexOf(Name);
if idx <> -1 then if idx <> -1 then
Begin begin
SetLength(lst,length(lst)+1); SetLength(lst, Length(lst)+1);
lst[high(lst)]:=TRestartTask(Queue.waitings.Objects[idx]); lst[High(lst)] := TRestartTask(Queue.waitings.Objects[idx]);
Queue.waitings.Delete(idx); Queue.waitings.Delete(idx);
end; end;
until idx = -1; until idx = -1;
For i:=low(lst) to high(lst) do for i := Low(lst) to High(lst) do
Begin begin
lst[i].Cancel; lst[i].Cancel;
lst[i].pTaskEnded(1, nil); lst[i].pTaskEnded(1, nil);
lst[i].Free; lst[i].Free;
@ -776,7 +796,7 @@ end;
procedure TJob.DoCancel; procedure TJob.DoCancel;
begin begin
//
end; end;
function TJob.pGetTask: integer; function TJob.pGetTask: integer;
@ -786,7 +806,7 @@ end;
procedure TJob.WaitForResultOf(aJob: TJob); procedure TJob.WaitForResultOf(aJob: TJob);
begin begin
Raise EWaiting.Create(self,aJob); raise EWaiting.Create(self,aJob);
end; end;
procedure TJob.EnterCriticalSection; procedure TJob.EnterCriticalSection;

34
components/lazmapviewer/source/mvjobs.pas
View File

@ -26,8 +26,7 @@ uses
type type
{ TSimpleJob } { TSimpleJob: job with only one task }
//job with only one task
TSimpleJob = class(TJob) TSimpleJob = class(TJob)
private private
FRunning, FEnded: boolean; FRunning, FEnded: boolean;
@ -39,19 +38,19 @@ type
function Running : boolean; override; function Running : boolean; override;
end; end;
TJobProc = Procedure (Data : TObject;Job : TJob) of object; TJobProc = procedure (Data: TObject; Job: TJob) of object;
{ TEventJob } { TEventJob: job with only one task (callback an event) }
//job with only one task (callback an event) TEventJob = class(TSimpleJob)
TEventJob = Class(TSimpleJob)
private private
FData: TObject; FData: TObject;
FTask: TJobProc; FTask: TJobProc;
FOwnData: Boolean; FOwnData: Boolean;
public public
constructor Create(aEvent : TJobProc;Data : TObject;OwnData : Boolean;JobName : String='');virtual; constructor Create(aEvent: TJobProc; Data: TObject; OwnData: Boolean;
procedure ExecuteTask(aTask : integer;FromWaiting : boolean);override; JobName: String = ''); virtual;
destructor Destroy; override; destructor Destroy; override;
procedure ExecuteTask(aTask: integer; FromWaiting: boolean); override;
end; end;
@ -65,23 +64,17 @@ begin
Name := JobName; Name := JobName;
FTask := aEvent; FTask := aEvent;
if Assigned(Data) or OwnData then if Assigned(Data) or OwnData then
Begin begin
FData := Data; FData := Data;
FOwnData := OwnData; FOwnData := OwnData;
end end
else else
Begin begin
FOwnData := false; FOwnData := false;
FData := self; FData := self;
end; end;
end; end;
procedure TEventJob.ExecuteTask(aTask : integer;FromWaiting : boolean);
begin
if Assigned(FTask) then
FTask(FData,self);
end;
destructor TEventJob.Destroy; destructor TEventJob.Destroy;
begin begin
if FOwnData then if FOwnData then
@ -90,12 +83,19 @@ begin
inherited Destroy; inherited Destroy;
end; end;
procedure TEventJob.ExecuteTask(aTask: integer; FromWaiting: boolean);
begin
if Assigned(FTask) then
FTask(FData, self);
end;
{ TSimpleJob } { TSimpleJob }
function TSimpleJob.pGetTask: integer; function TSimpleJob.pGetTask: integer;
begin begin
if FRunning or Cancelled then if FRunning or Cancelled then
Begin begin
if not FRunning then if not FRunning then
Result := ALL_TASK_COMPLETED Result := ALL_TASK_COMPLETED
else else