[GExperts-Checkins] SF.net SVN: gexperts:[3167] trunk/ExternalSource/dzlib

[<tw...@us...>]

Revision: 3167
          http://sourceforge.net/p/gexperts/code/3167
Author:   twm
Date:     2020-05-29 15:26:58 +0000 (Fri, 29 May 2020)
Log Message:
-----------
Updated to current version from OSDN

Modified Paths:
--------------
    trunk/ExternalSource/dzlib/u_dzErrorThread.pas
    trunk/ExternalSource/dzlib/u_dzLineBuilder.pas
    trunk/ExternalSource/dzlib/u_dzVclUtils.pas

Modified: trunk/ExternalSource/dzlib/u_dzErrorThread.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzErrorThread.pas	2020-05-29 15:07:11 UTC (rev 3166)
+++ trunk/ExternalSource/dzlib/u_dzErrorThread.pas	2020-05-29 15:26:58 UTC (rev 3167)
@@ -45,6 +45,15 @@
     function WaitFor(_TimeoutMsecs: DWORD; out _ReturnValue: DWORD): Boolean; overload;
     function WaitFor(_TimeoutMsecs: DWORD): Boolean; overload;
     ///<summary>
+    /// Calls Windows.TerminateThread to kill the thread without freeing resources.
+    /// Read the documentation first!
+    /// https://docs.microsoft.com/en-us/windows/win32/api/processthreadsapi/nf-processthreadsapi-terminatethread
+    /// @ExitCode is the exit code to return to GetExitCodeThread calls.
+    ///           NOTE: ExitCode must *not* be STILL_ACTIVE (259)
+    /// @returns True, if TerminateThread was called
+    ///          False if not (e.g. if the thread was already finished or never started) </summary>
+    function Kill_YesIHaveReadTheTerminateThreadApiDocumentation(_ExitCode: DWORD): Boolean;
+    ///<summary>
     /// Is true, when the thread has finished executing </summary>
     property HasFinished: Boolean read FHasFinished;
     ///<summary>
@@ -101,6 +110,14 @@
   end;
 end;
 
+function TErrorThread.Kill_YesIHaveReadTheTerminateThreadApiDocumentation(_ExitCode: DWORD): Boolean;
+begin
+  Result := not FHasFinished and (Handle <> 0);
+  if Result then begin
+    Win32Check(Windows.TerminateThread(Handle, 5));
+  end;
+end;
+
 function TErrorThread.WaitFor(_TimeoutMsecs: DWORD): Boolean;
 var
   Dummy: DWORD;
@@ -112,14 +129,14 @@
 
 function TErrorThread.WaitFor(_TimeoutMsecs: DWORD; out _ReturnValue: DWORD): Boolean;
 var
-  H: array[0..1] of THandle;
+  h: array[0..1] of THandle;
   WaitResult: Cardinal;
   Msg: TMsg;
 begin
-  H[0] := Handle;
+  h[0] := Handle;
   if GetCurrentThreadID = MainThreadID then begin
     WaitResult := 0;
-    H[1] := SyncEvent;
+    h[1] := SyncEvent;
     repeat
       { This prevents a potential deadlock if the background thread
         does a SendMessage to the foreground thread }
@@ -126,9 +143,9 @@
       if WaitResult = WAIT_OBJECT_0 + 2 then
         PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
       if _TimeoutMsecs = INFINITE then begin
-        WaitResult := MsgWaitForMultipleObjects(2, H, False, 1000, QS_SENDMESSAGE);
+        WaitResult := MsgWaitForMultipleObjects(2, h, False, 1000, QS_SENDMESSAGE);
       end else begin
-        WaitResult := MsgWaitForMultipleObjects(2, H, False, _TimeoutMsecs, QS_SENDMESSAGE);
+        WaitResult := MsgWaitForMultipleObjects(2, h, False, _TimeoutMsecs, QS_SENDMESSAGE);
       end;
       CheckThreadError(WaitResult <> WAIT_FAILED);
       if WaitResult = WAIT_OBJECT_0 + 1 then
@@ -136,13 +153,13 @@
       Result := (WaitResult = WAIT_OBJECT_0);
     until Result or (_TimeoutMsecs <> INFINITE);
   end else begin
-    WaitResult := WaitForSingleObject(H[0], _TimeoutMsecs);
+    WaitResult := WaitForSingleObject(h[0], _TimeoutMsecs);
     if WaitResult = WAIT_FAILED then
       RaiseLastOSError;
     Result := (WaitResult <> WAIT_TIMEOUT);
   end;
   if Result then
-    CheckThreadError(GetExitCodeThread(H[0], _ReturnValue));
+    CheckThreadError(GetExitCodeThread(h[0], _ReturnValue));
 end;
 
 {$ELSE}
@@ -150,11 +167,11 @@
 
 function TErrorThread.WaitFor(_TimeoutMsecs: DWORD; out _ReturnValue: DWORD): Boolean;
 var
-  H: THandle;
+  h: THandle;
   WaitResult: Cardinal;
   Msg: TMsg;
 begin
-  H := Handle;
+  h := Handle;
   if GetCurrentThreadID = MainThreadID then begin
     WaitResult := 0;
     repeat
@@ -163,9 +180,9 @@
       if WaitResult = WAIT_OBJECT_0 + 1 then
         PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
       if _TimeoutMsecs = INFINITE then begin
-        WaitResult := MsgWaitForMultipleObjects(2, H, False, 1000, QS_SENDMESSAGE)
+        WaitResult := MsgWaitForMultipleObjects(2, h, False, 1000, QS_SENDMESSAGE)
       end else begin
-        WaitResult := MsgWaitForMultipleObjects(1, H, False, _TimeoutMsecs, QS_SENDMESSAGE);
+        WaitResult := MsgWaitForMultipleObjects(1, h, False, _TimeoutMsecs, QS_SENDMESSAGE);
       end;
       CheckThreadError(WaitResult <> WAIT_FAILED);
       if WaitResult = WAIT_OBJECT_0 + 1 then
@@ -173,13 +190,13 @@
       Result := (WaitResult = WAIT_OBJECT_0);
     until Result or (_TimeoutMsecs <> INFINITE);
   end else begin
-    WaitResult := WaitForSingleObject(H, _TimeoutMsecs);
+    WaitResult := WaitForSingleObject(h, _TimeoutMsecs);
     if WaitResult = WAIT_FAILED then
       RaiseLastOSError;
     Result := (WaitResult <> WAIT_TIMEOUT);
   end;
   if Result then
-    CheckThreadError(GetExitCodeThread(H, _ReturnValue));
+    CheckThreadError(GetExitCodeThread(h, _ReturnValue));
 end;
 {$IFEND}
 

Modified: trunk/ExternalSource/dzlib/u_dzLineBuilder.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzLineBuilder.pas	2020-05-29 15:07:11 UTC (rev 3166)
+++ trunk/ExternalSource/dzlib/u_dzLineBuilder.pas	2020-05-29 15:26:58 UTC (rev 3167)
@@ -65,6 +65,8 @@
     procedure Prepend(_Line: TLineBuilder);
     ///<summary> Extracts the first column from the line, returns false when empty </summary>
     function ExtractFirst(out _Column: string): Boolean;
+    ///<summary> @returns the length of Content </summary>
+    function Length: Integer;
     ///<summary> allows read access to the content that has been built </summary>
     property Content: string read FContent;
     property ColumnCount: Integer read FColumnCount;
@@ -112,6 +114,11 @@
 {$IFEND}
 end;
 
+function TLineBuilder.Length: Integer;
+begin
+  Result := System.Length(FContent);
+end;
+
 procedure TLineBuilder.SetDecimalSeparator(_Value: Char);
 begin
 {$IF Declared(TFormatSettings)}

Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas	2020-05-29 15:07:11 UTC (rev 3166)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas	2020-05-29 15:26:58 UTC (rev 3167)
@@ -576,6 +576,11 @@
 ///<summary> adds a new TTabSheet with the given Caption to the PageControl and returns it </summary>
 function TPageControl_AddTabSheet(_PageControl: TPageControl; const _Caption: string): TTabSheet;
 
+///<summary>
+/// Inserts a TTabSheet with the given caption at the given index into the page control and returns it </summary>
+function TPageControl_InsertTabSheet(_PageControl: TPageControl; _Idx: Integer;
+  const _Caption: string): TTabSheet;
+
 ///<summary> Draws the tab text for a TPageControl as horizontal text, useful, if you
 ///          want to have the tabs on the left or right but don't want vertical text.
 ///         Set the TPageControl's OwnerDraw property to true, the TabHeight property
@@ -2858,6 +2863,13 @@
   Result.Caption := _Caption;
 end;
 
+function TPageControl_InsertTabSheet(_PageControl: TPageControl; _Idx: Integer;
+  const _Caption: string): TTabSheet;
+begin
+  Result := TPageControl_AddTabSheet(_PageControl, _Caption);
+  Result.PageIndex := _Idx;
+end;
+
 procedure DrawTab(_TabControl: TCustomTabControl; const _Caption: string;
   const _Rect: TRect; _Active: Boolean);
 var

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.