Changeset 25 for trunk/Packages/Common/UThreading.pas

Timestamp:

Sep 10, 2022, 6:54:43 PM (20 months ago)

Author:

chronos

Message:

• Modified: CoolTranslator replaced by Common package.
• Modified: Update common package.

File:

• trunk/Packages/Common/UThreading.pas (modified) (14 diffs)

trunk/Packages/Common/UThreading.pas

@@ -1 +1 @@
 unit UThreading;
 
-{$mode delphi}
-
 interface
 
 uses
-  Classes, SysUtils, Forms, Contnrs, SyncObjs;
+  Classes, SysUtils, Forms, Generics.Collections, SyncObjs;
 
 type
   TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;
   TMethodCall = procedure of object;
-
 
   { TVirtualThread }
@@ -22 +19 @@
     function GetSuspended: Boolean; virtual; abstract;
     function GetTerminated: Boolean; virtual; abstract;
-    function GetThreadId: Integer; virtual; abstract;
+    function GetThreadId: TThreadID; virtual; abstract;
     procedure SetFreeOnTerminate(const AValue: Boolean); virtual; abstract;
     procedure SetPriority(const AValue: TThreadPriority); virtual; abstract;
@@ -30 +27 @@
     Name: string;
     procedure Execute; virtual; abstract;
-    procedure Resume; virtual; abstract;
-    procedure Suspend; virtual; abstract;
     procedure Start; virtual; abstract;
     procedure Terminate; virtual; abstract;
@@ -44 +39 @@
     property Terminated: Boolean read GetTerminated write SetTerminated;
     property Finished: Boolean read GetFinished;
-    property ThreadId: Integer read GetThreadId;
+    property ThreadId: TThreadID read GetThreadId;
   end;
 
@@ -70 +65 @@
     function GetSuspended: Boolean; override;
     function GetTerminated: Boolean; override;
-    function GetThreadId: Integer; override;
+    function GetThreadId: TThreadID; override;
     procedure SetFreeOnTerminate(const AValue: Boolean); override;
     procedure SetPriority(const AValue: TThreadPriority); override;
@@ -81 +76 @@
     procedure Sleep(Delay: Integer); override;
     procedure Execute; override;
-    procedure Resume; override;
-    procedure Suspend; override;
     procedure Start; override;
     procedure Terminate; override;
@@ -106 +99 @@
   { TThreadList }
 
-  TThreadList = class(TObjectList)
-    function FindById(Id: Integer): TVirtualThread;
+  TThreadList = class(TObjectList<TVirtualThread>)
+    function FindById(Id: TThreadID): TVirtualThread;
     constructor Create; virtual;
   end;
@@ -134 +127 @@
     Thread.FreeOnTerminate := False;
     Thread.Method := Method;
-    Thread.Resume;
+    Thread.Start;
     while (Thread.State = ttsRunning) or (Thread.State = ttsReady) do begin
       if MainThreadID = ThreadID then Application.ProcessMessages;
@@ -155 +148 @@
     Thread.Method := Method;
     Thread.OnFinished := CallBack;
-    Thread.Resume;
+    Thread.Start;
     //if Thread.State = ttsExceptionOccured then
     //  raise Exception.Create(Thread.ExceptionMessage);
@@ -168 +161 @@
   if MainThreadID = ThreadID then Method
   else begin
-    Thread := ThreadList.FindById(ThreadID);
+    try
+      ThreadListLock.Acquire;
+      Thread := ThreadList.FindById(ThreadID);
+    finally
+      ThreadListLock.Release;
+    end;
     if Assigned(Thread) then begin
       Thread.Synchronize(Method);
@@ -177 +175 @@
 { TThreadList }
 
-function TThreadList.FindById(Id: Integer): TVirtualThread;
+function TThreadList.FindById(Id: TThreadID): TVirtualThread;
 var
   I: Integer;
 begin
   I := 0;
-  while (I < ThreadList.Count) and (TVirtualThread(ThreadList[I]).ThreadID <> Id) do
+  while (I < ThreadList.Count) and (ThreadList[I].ThreadID <> Id) do
     Inc(I);
-  if I < ThreadList.Count then Result := TVirtualThread(ThreadList[I])
+  if I < ThreadList.Count then Result := ThreadList[I]
     else Result := nil;
 end;
@@ -237 +235 @@
 end;
 
-function TListedThread.GetThreadId: Integer;
+function TListedThread.GetThreadId: TThreadID;
 begin
   Result := FThread.ThreadID;
@@ -294 +292 @@
   end;
   FThread.Free;
-  inherited Destroy;
+  inherited;
 end;
 
@@ -313 +311 @@
 procedure TListedThread.Execute;
 begin
-end;
-
-procedure TListedThread.Resume;
-begin
-  FThread.Resume;
-end;
-
-procedure TListedThread.Suspend;
-begin
-  FThread.Suspend;
 end;