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

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

Revision: 4076
          http://sourceforge.net/p/gexperts/code/4076
Author:   twm
Date:     2023-10-28 13:01:16 +0000 (Sat, 28 Oct 2023)
Log Message:
-----------
dzlib updated to lastest sources

Modified Paths:
--------------
    trunk/ExternalSource/dzlib/t_NullableNumber.tpl
    trunk/ExternalSource/dzlib/u_dzClassUtils.pas
    trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
    trunk/ExternalSource/dzlib/u_dzFileUtils.pas
    trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
    trunk/ExternalSource/dzlib/u_dzSortProvider.pas
    trunk/ExternalSource/dzlib/u_dzTypes.pas
    trunk/ExternalSource/dzlib/u_dzVclUtils.pas

Modified: trunk/ExternalSource/dzlib/t_NullableNumber.tpl
===================================================================
--- trunk/ExternalSource/dzlib/t_NullableNumber.tpl	2023-10-26 07:30:01 UTC (rev 4075)
+++ trunk/ExternalSource/dzlib/t_NullableNumber.tpl	2023-10-28 13:01:16 UTC (rev 4076)
@@ -89,6 +89,8 @@
     /// <summary> invalid values are considered smaller than any valid values
     /// and equal to each other </summary>
     class function Compare(_a, _b: _NULLABLE_NUMBER_): Integer; static;
+    /// <summary> invalid values are considered equal to each other </summary>
+    class function IsSame(_a, _b: _NULLABLE_NUMBER_): Boolean; static;
     class function Invalid: _NULLABLE_NUMBER_; static;
     class function FromVariant(_a: Variant): _NULLABLE_NUMBER_; static;
     class function FromStr(const _s: string): _NULLABLE_NUMBER_; static;
@@ -318,6 +320,21 @@
     Result := -1;
 end;
 
+class function _NULLABLE_NUMBER_.IsSame(_a, _b: _NULLABLE_NUMBER_): Boolean;
+begin
+  if _a.IsValid then begin
+    if _b.IsValid then
+      Result := (_a.FValue = _b.FValue)
+    else
+      Result := False
+  end else begin
+    if _b.IsValid then
+      Result := False
+    else
+      Result := True;
+  end;
+end;
+
 function _NULLABLE_NUMBER_.Dump: string;
 begin
   Result := ToString('<invalid>'); // do not translate

Modified: trunk/ExternalSource/dzlib/u_dzClassUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzClassUtils.pas	2023-10-26 07:30:01 UTC (rev 4075)
+++ trunk/ExternalSource/dzlib/u_dzClassUtils.pas	2023-10-28 13:01:16 UTC (rev 4076)
@@ -238,6 +238,44 @@
 function TComponent_FindComponent(_Owner: TComponent; const _Name: string; _Recursive: Boolean;
   out _Found: TComponent; _CmpClass: TComponentClass = nil): Boolean;
 
+{$IFDEF DELPHIX_TOKYO_UP}
+///<summary>
+/// Reads a maximum of Count bytes from the stream into the buffer and returns true if at least
+/// one byte could be read. </summary>
+function TStream_TryRead(_st: TStream; _Buffer: TBytes; _Offset, _Count: Int32;
+  out _BytesRead: Int32): Boolean; overload;
+{$IFDEF SUPPORTS_INLINE}
+inline;
+{$ENDIF}
+
+///<summary>
+/// Reads a maximum of Count bytes from the stream into the buffer and returns true if at least
+/// one byte could be read. </summary>
+function TStream_TryRead(_st: TStream; _Buffer: TBytes; _Offset, _Count: Int64;
+  out _BytesRead: Int64): Boolean; overload;
+{$IFDEF SUPPORTS_INLINE}
+inline;
+{$ENDIF}
+{$ENDIF}
+
+///<summary>
+/// Reads a maximum of Count bytes from the stream into the buffer and returns true if at least
+/// one byte could be read. </summary>
+function TStream_TryRead(_st: TStream; var _Buffer; _Count: Int32;
+  out _BytesRead: Int32): Boolean; overload;
+{$IFDEF SUPPORTS_INLINE}
+inline;
+{$ENDIF}
+
+///<summary>
+/// Reads a maximum of Count bytes from the stream into the buffer and returns true if at least
+/// one byte could be read. </summary>
+function TStream_TryRead(_st: TStream; var _Buffer: TBytes; _Count: Int32;
+  out _BytesRead: Int32): Boolean; overload;
+{$IFDEF SUPPORTS_INLINE}
+inline;
+{$ENDIF}
+
 /// <summary>
 /// Write a string to the stream
 /// @param Stream is the TStream to write to.
@@ -1095,6 +1133,36 @@
   Result := _st.Values[Name];
 end;
 
+function TStream_TryRead(_st: TStream; var _Buffer: TBytes; _Count: Int32;
+  out _BytesRead: Int32): Boolean; overload;
+begin
+  _BytesRead := _st.Read(_Buffer, _Count);
+  Result := (_BytesRead > 0);
+end;
+
+function TStream_TryRead(_st: TStream; var _Buffer; _Count: Int32;
+  out _BytesRead: Int32): Boolean; overload;
+begin
+  _BytesRead := _st.Read(_Buffer, _Count);
+  Result := (_BytesRead > 0);
+end;
+
+{$IFDEF DELPHIX_TOKYO_UP}
+function TStream_TryRead(_st: TStream; _Buffer: TBytes; _Offset, _Count: Int32;
+  out _BytesRead: Int32): Boolean; overload;
+begin
+  _BytesRead := _st.Read(_Buffer, _Offset, _Count);
+  Result := (_BytesRead > 0);
+end;
+
+function TStream_TryRead(_st: TStream; _Buffer: TBytes; _Offset, _Count: Int64;
+  out _BytesRead: Int64): Boolean; overload;
+begin
+  _BytesRead := _st.Read64(_Buffer, _Offset, _Count);
+  Result := (_BytesRead > 0);
+end;
+{$ENDIF}
+
 function TStream_WriteString(_Stream: TStream; const _s: RawByteString): Integer;
 var
   Len: Integer;

Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas	2023-10-26 07:30:01 UTC (rev 4075)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas	2023-10-28 13:01:16 UTC (rev 4076)
@@ -177,19 +177,25 @@
 ///<summary>
 /// Reduces an Integer to a Byte value by cutting it off at 0 and 255 </summary>
 function ReduceToByte(const _Value: Integer): Byte;
-{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+{(*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
+
 function ReduceToInt8(const _Value: Integer): Int8;
-{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+{(*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
+
 function ReduceToUInt8(const _Value: Integer): UInt8;
-{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+{(*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
+
 function ReduceToInt16(const _Value: Integer): Int16;
-{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+{(*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
+
 function ReduceToUInt16(const _Value: Integer): UInt16;
-{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+{(*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
+
 function ReduceToInt32(const _Value: Int64): Int32;
-{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+{(*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
+
 function ReduceToUInt32(const _Value: Int64): UInt32;
-{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+{(*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
 
 ///<summary>
 /// Converts a string of the form '-hh:mm:ss', 'hh:mm:ss',
@@ -282,9 +288,9 @@
 /// @returns true, if s could be converted, false otherwise
 /// NOTE: This is not thread safe in Delphi 6 because there it changes the global
 ///       variable DecimalSeparator in SysUtils. </summary>
-{$IFNDEF Win64}
 function TryStr2Float(const _s: string; out _flt: Extended; _DecSeparator: Char = '.'): Boolean; overload;
-{$ENDIF}
+
+{$IF SizeOf(Extended) <> SizeOf(Double)}
 ///<summary>
 /// tries to convert a string to a float, returns false if it fails
 /// @param s is the string to convert
@@ -295,6 +301,7 @@
 /// NOTE: This is not thread safe in Delphi 6 because there it changes the global
 ///       variable DecimalSeparator in SysUtils. </summary>
 function TryStr2Float(const _s: string; out _flt: Double; _DecSeparator: Char = '.'): Boolean; overload;
+{$IFEND}
 function TryStr2Float(const _s: string; out _flt: Single; _DecSeparator: Char = '.'): Boolean; overload;
 
 ///<summary>
@@ -386,17 +393,17 @@
 
 ///<summary>
 /// returns the long word split into an array of byte
-/// @param Value is the LongWord value to split
+/// @param Value is the UInt32 value to split
 /// @param MsbFirst, if true the most significant byte is the first in the array (Motorola format)
 ///                  if false the least significatn byte is the first in the array (Intel format) </summary>
-function LongWord2ByteArr(_Value: LongWord; _MsbFirst: Boolean = False): TBytes;
+function LongWord2ByteArr(_Value: UInt32; _MsbFirst: Boolean = False): TBytes;
 
 ///<summary>
-/// returns the the array of byte combined into a LongWord
+/// returns the the array of byte combined into a UInt32
 /// @param Value is the array to combine
 /// @param MsbFirst, if true the most significant byte is the first in the array (Motorola format)
 ///                  if false the least significatn byte is the first in the array (Intel format) </summary>
-function ByteArr2LongWord(const _Arr: array of Byte; _MsbFirst: Boolean = False): LongWord;
+function ByteArr2LongWord(const _Arr: array of Byte; _MsbFirst: Boolean = False): UInt32;
 
 ///<summary>
 /// returns a 16 bit in reversed byte order, e.g. $1234 => $3412)
@@ -404,12 +411,13 @@
 /// (This is just an alias for system.swap for consistency with Swap32.)
 ///</summary
 function Swap16(_Value: Word): Word;
+{(*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
 
 ///<summary>
 /// returns a 32 bit value in reversed byte order e.g. $12345678 -> $78563412
 /// aka converts intel (little endian) to motorola (big endian) byte order format </summary>
-function Swap32(_Value: LongWord): LongWord;
-function Swap32pas(_Value: LongWord): LongWord;
+function Swap32(_Value: UInt32): UInt32;
+function Swap32pas(_Value: UInt32): UInt32;
 
 ///<summary>
 /// returns a 64 bit value in reversed byte order e.g. $123456789ABCDEF0 -> $F0DEBC9A78563412
@@ -416,7 +424,7 @@
 /// aka converts intel (little endian) to motorola (big endian) byte order format </summary>
 function Swap64(_Value: UInt64): UInt64;
 
-function BitReverse32(v: LongWord): LongWord;
+function BitReverse32(v: UInt32): UInt32;
 
 {$IFDEF SUPPORTS_ENHANCED_RECORDS}
 type
@@ -670,9 +678,7 @@
   u_dzStringUtils;
 
 function _(const _s: string): string;
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
+{(*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
 begin
   Result := dzDGetText(_s, 'dzlib');
 end;
@@ -1210,7 +1216,6 @@
   Result := '.';
 end;
 
-{$IFNDEF Win64}
 function TryStr2Float(const _s: string; out _flt: Extended; _DecSeparator: Char = '.'): Boolean;
 var
 {$IF Declared(TFormatSettings)}
@@ -1235,8 +1240,8 @@
   end;
 {$IFEND}
 end;
-{$ENDIF}
 
+{$IF SizeOf(Extended) <> SizeOf(Double)}
 function TryStr2Float(const _s: string; out _flt: Double; _DecSeparator: Char = '.'): Boolean;
 var
   flt: Extended;
@@ -1245,6 +1250,7 @@
   if Result then
     _flt := flt;
 end;
+{$IFEND}
 
 function TryStr2Float(const _s: string; out _flt: Single; _DecSeparator: Char = '.'): Boolean;
 var
@@ -1319,7 +1325,7 @@
 end;
 {$IFEND}
 
-function LongWord2ByteArr(_Value: LongWord; _MsbFirst: Boolean = False): TBytes;
+function LongWord2ByteArr(_Value: UInt32; _MsbFirst: Boolean = False): TBytes;
 begin
   SetLength(Result, SizeOf(_Value));
   if _MsbFirst then begin
@@ -1335,10 +1341,10 @@
   end;
 end;
 
-function ByteArr2LongWord(const _Arr: array of Byte; _MsbFirst: Boolean = False): LongWord;
+function ByteArr2LongWord(const _Arr: array of Byte; _MsbFirst: Boolean = False): UInt32;
 begin
   if Length(_Arr) <> SizeOf(Result) then
-    raise Exception.CreateFmt(_('Length of byte array (%d) does not match size of a LongWord (%d)'), [Length(_Arr), SizeOf(Result)]);
+    raise Exception.CreateFmt(_('Length of byte array (%d) does not match size of a UInt32 (%d)'), [Length(_Arr), SizeOf(Result)]);
   if _MsbFirst then begin
     Result := _Arr[0] shl 24 + _Arr[1] shl 16 + _Arr[2] shl 8 + _Arr[3];
   end else begin
@@ -1347,9 +1353,6 @@
 end;
 
 function Swap16(_Value: Word): Word;
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
 begin
   Result := swap(_Value);
 end;
@@ -1359,15 +1362,22 @@
 //  rol   ax, 8
 //end;
 
-function Swap32(_Value: LongWord): LongWord;
-asm
-  bswap eax
+function Swap32pas(_Value: UInt32): UInt32;
+begin
+  Result := ((_Value shr 24) and $FF) + (((_Value shr 16) and $FF) shl 8) + (((_Value shr 8) and $FF) shl 16) + ((_Value and $FF) shl 24);
 end;
 
-function Swap32pas(_Value: LongWord): LongWord;
+{$IFDEF CPU64}
+function Swap32(_Value: UInt32): UInt32;
 begin
-  Result := ((_Value shr 24) and $FF) + (((_Value shr 16) and $FF) shl 8) + (((_Value shr 8) and $FF) shl 16) + ((_Value and $FF) shl 24);
+  Result := Swap32pas(_Value);
 end;
+{$ELSE}
+function Swap32(_Value: UInt32): UInt32;
+asm
+  bswap eax
+end;
+{$ENDIF}
 
 function Swap64(_Value: UInt64): UInt64;
 asm
@@ -1377,7 +1387,7 @@
   BSWAP   EAX
 end;
 
-function BitReverse32(v: LongWord): LongWord;
+function BitReverse32(v: UInt32): UInt32;
 // source (C code):
 // https://apps.topcoder.com/forums/?module=Thread&threadID=514884&start=2
 begin
@@ -1487,7 +1497,7 @@
 var
   Bytes: TByteArr8 absolute FValue;
 begin
-  Result := Bytes[_byteNo];
+  Result := Bytes[_ByteNo];
 end;
 
 procedure TBits64.SetByte(_ByteNo: TByteNumber; _Value: Byte);
@@ -1582,14 +1592,19 @@
 end;
 
 function TBits32.GetByte(_ByteNo: TByteNumber): Byte;
+var
+  BitNo: TBitNumber;
 begin
-  Result := (FValue shr (_ByteNo * 8)) and $FF;
+  BitNo := _ByteNo * 8;
+  Result := (FValue shr BitNo) and $FF;
 end;
 
 procedure TBits32.SetByte(_ByteNo: TByteNumber; _Value: Byte);
+var
+  BitNo: TBitNumber;
 begin
-  _ByteNo := _ByteNo * 8;
-  FValue := FValue and ($FFFFFFFF xor ($FF shl _ByteNo)) or (_Value shl _ByteNo);
+  BitNo := _ByteNo * 8;
+  FValue := FValue and ($FFFFFFFF xor ($FF shl BitNo)) or (_Value shl BitNo);
 end;
 
 procedure TBits32.Init(_Value: TValue);
@@ -1738,14 +1753,19 @@
 end;
 
 function TBits16.GetByte(_ByteNo: TByteNumber): Byte;
+var
+  BitNo: TBitNumber;
 begin
-  Result := (FValue shr (_ByteNo * 8)) and $FF;
+  BitNo := _ByteNo * 8;
+  Result := (FValue shr BitNo) and $FF;
 end;
 
 procedure TBits16.SetByte(_ByteNo: TByteNumber; _Value: Byte);
+var
+  BitNo: TBitNumber;
 begin
-  _ByteNo := _ByteNo * 8;
-  FValue := FValue and ($FFFF xor ($FF shl _ByteNo)) or (_Value shl _ByteNo);
+  BitNo := _ByteNo * 8;
+  FValue := FValue and ($FFFF xor ($FF shl BitNo)) or (_Value shl BitNo);
 end;
 
 class operator TBits16.Equal(_a, _b: TBits16): Boolean;

Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileUtils.pas	2023-10-26 07:30:01 UTC (rev 4075)
+++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas	2023-10-28 13:01:16 UTC (rev 4076)
@@ -117,15 +117,16 @@
     /// @param List is a string list to which the files will be appended, may be nil
     /// @param IncludePath determines whether the List of filenames includes the full path or not </summary>
     class function Execute(const _Mask: string; _List: TStrings;
-      _MayHaveAttr: TFileAttributeSet = ALL_FILES_ATTRIB_SET; _IncludePath: Boolean = False; _Sort: Boolean = True): Integer;
+      _MayHaveAttr: TFileAttributeSet = ALL_FILES_ATTRIB_SET; _IncludePath: Boolean = False;
+      _Sort: Boolean = True; _Recursive: Boolean = False): Integer;
     /// <summary>
     /// creates a TSimpleDirEnumerator, calls its FindAll method and frees it
     /// @param List is a string list to which the files will be appended, may be nil
     /// @param IncludePath determines whether the List of filenames includes the full path or not </summary>
     class function EnumFilesOnly(const _Mask: string; _List: TStrings;
-      _IncludePath: Boolean = False; _Sort: Boolean = True): Integer; overload;
+      _IncludePath: Boolean = False; _Sort: Boolean = True; _Recursive: Boolean = False): Integer; overload;
     class function EnumFilesOnly(const _Mask: string;
-      _IncludePath: Boolean = False; _Sort: Boolean = True): TStringArray; overload;
+      _IncludePath: Boolean = False; _Sort: Boolean = True; _Recursive: Boolean = False): TStringArray; overload;
     ///<summary>
     /// Calls the given callback for all files matching the mask. To Abort, raise EAbort. </summary>
     class procedure EnumFilesOnly(const _Mask: string; _Callback: TOnFileEnumCallback;
@@ -1026,7 +1027,8 @@
     /// @returns True, if the last extension of Filename matches the given extension.
     ///                Comparison is case insensitive
     ///          False if the extensions don't machch. </summary>
-    class function HasFileExtLast(const _Filename: string; const _Ext: string): Boolean;
+    class function HasFileExtLast(const _Filename: string; const _Ext: string): Boolean; overload;
+    class function HasFileExtLast(const _Filename: string; const _Ext: TStringArray): Boolean; overload;
 
     ///<summary>
     /// Sets the file's date and time to the given time or to the current time
@@ -1377,14 +1379,14 @@
   end;
 end;
 
-class function TSimpleDirEnumerator.EnumFilesOnly(const _Mask: string; _IncludePath,
-  _Sort: Boolean): TStringArray;
+class function TSimpleDirEnumerator.EnumFilesOnly(const _Mask: string; _IncludePath: Boolean;
+  _Sort: Boolean; _Recursive: Boolean): TStringArray;
 var
   sl: TStringList;
 begin
   sl := TStringList.Create;
   try
-    EnumFilesOnly(_Mask, sl, _IncludePath, _Sort);
+    EnumFilesOnly(_Mask, sl, _IncludePath, _Sort, _Recursive);
     Result := TStringArray_FromStrings(sl);
   finally
     FreeAndNil(sl);
@@ -1392,17 +1394,22 @@
 end;
 
 class function TSimpleDirEnumerator.EnumFilesOnly(const _Mask: string; _List: TStrings;
-  _IncludePath, _Sort: Boolean): Integer;
+  _IncludePath, _Sort: Boolean; _Recursive: Boolean): Integer;
 begin
-  Result := Execute(_Mask, _List, [dfaArchive], _IncludePath, _Sort);
+  Result := Execute(_Mask, _List, [dfaArchive], _IncludePath, _Sort, _Recursive);
 end;
 
 class function TSimpleDirEnumerator.Execute(const _Mask: string; _List: TStrings;
   _MayHaveAttr: TFileAttributeSet = ALL_FILES_ATTRIB_SET;
-  _IncludePath: Boolean = False; _Sort: Boolean = True): Integer;
+  _IncludePath: Boolean = False; _Sort: Boolean = True; _Recursive: Boolean = False): Integer;
 var
   enum: TSimpleDirEnumerator;
   List: TStringList;
+  dirs: TStringArray;
+  BaseDirBS: string;
+  DirIdx: Integer;
+  MaskOnly: string;
+  SubDirBS: string;
 begin
   enum := TSimpleDirEnumerator.Create(_Mask, _MayHaveAttr);
   try
@@ -1420,6 +1427,23 @@
   finally
     FreeAndNil(enum);
   end;
+  if _Recursive then begin
+    BaseDirBS := itpd(ExtractFileDir(_Mask));
+    MaskOnly := ExtractFileName(_Mask);
+    dirs := EnumDirsOnly(BaseDirBS + '*', True);
+    for DirIdx := Low(dirs) to High(dirs) do begin
+      SubDirBS := itpd(dirs[DirIdx]);
+      List := TStringList.Create;
+      try
+        TSimpleDirEnumerator.EnumFilesOnly(SubDirBS + MaskOnly, List, _IncludePath, _Sort, True);
+        if _Sort then
+          List.Sort;
+        _List.AddStrings(List);
+      finally
+        FreeAndNil(List);
+      end;
+    end;
+  end;
 end;
 
 function TSimpleDirEnumerator.FindAll(_List: TStrings = nil; _IncludePath: Boolean = False): Integer;
@@ -1556,6 +1580,20 @@
   Result := SameText(_Ext, ExtractFileExtFull(_Filename));
 end;
 
+class function TFileSystem.HasFileExtLast(const _Filename: string;
+  const _Ext: TStringArray): Boolean;
+var
+  i: Integer;
+begin
+  for i := Low(_Ext) to High(_Ext) do begin
+    if HasFileExtLast(_Filename, _Ext[i]) then begin
+      Result := True;
+      Exit; //==>
+    end;
+  end;
+  Result := False;
+end;
+
 class function TFileSystem.HasFileExtLast(const _Filename, _Ext: string): Boolean;
 begin
   Result := SameText(_Ext, ExtractFileExtLast(_Filename));

Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas	2023-10-26 07:30:01 UTC (rev 4075)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas	2023-10-28 13:01:16 UTC (rev 4076)
@@ -21,6 +21,8 @@
 {$IFNDEF NO_OPTIMIZE_DZ_GRAPHIC_UTILS_HINT}
 {$MESSAGE HINT 'optimization is off, consider turning it on for significantly better performance'}
 {$ENDIF}
+// if optimization is turned off, we also turn off inlining
+{$UNDEF SUPPORTS_INLINE}
 {$ELSE}
 // If optimization is on, we turn off assertions, just in case the programmer forgot.
 // The reason for this is that we have some assertions below that might significantly impact
@@ -257,8 +259,13 @@
   TDrawTextFlagSetNoAlign = set of TDrawTextFlagsNoAlign;
 
 ///<summary>
-/// Calculates the Rect necessary for drawing the text.
-/// @returns the calculated height </summary>
+/// Uses WinApi.DrawText to draw the given text on the canvas.
+/// @param Flags determines how the text is drawn. if it contains dtfCalcRect, this function
+///              does not draw the text but only calculates the Rect necessary for drawing it.
+/// @returns 0, if the call to WinApi.DrawText fails
+///          the calculated height of the text in logical units.
+///          If dtfBottomSingle or dtfVCenterSingle is specified, the return value is the offset
+///          from Rect.top to the bottom of the drawn text. </summary>
 function TCanvas_DrawText(_Canvas: TCanvas; const _Text: string; var _Rect: TRect; _Flags: TDrawTextFlagSet): Integer;
 {$IFDEF SUPPORTS_INLINE}
 inline;
@@ -499,7 +506,8 @@
 procedure TBitmap_AssignMono824(_Buffer: PByte; _bmp: TBitmap; _YIsReversed: Boolean);
 
 ///<summary>
-/// Assign a buffer containing a bitmap in Mono 8 format to a 8 bit gray scale TBitmap </summary>
+/// Assign a buffer containing a bitmap in Mono 8 format to a 8 bit gray scale TBitmap
+/// @NOTE: The bitmap is assumed to already have the correct size and pixel format </summary>
 procedure TBitmap_AssignMono8(_Buffer: PByte; _bmp: TBitmap; _YIsReversed: Boolean); overload;
 procedure TBitmap_AssignMono8(_Buffer: PByte; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64); overload;
 
@@ -509,10 +517,15 @@
   /// next value </summary>
   TBufferBitsToMono8Func = function(var _BufPtr: Pointer): Byte;
   TBufferBitsToMono8Meth = function(var _BufPtr: Pointer): Byte of object;
+  TBufferBitsToRgb8Func = function(var _BufPtr: Pointer): TdzRgbTriple;
+  TBufferBitsToRgb8Meth = function(var _BufPtr: Pointer): TdzRgbTriple of object;
 
 ///<summary>
 /// Converts a 12 bit value at the given position to a Byte and increments BufPtr by 2 </summary>
 function BufferBits12ToMono8(var _BufPtr: Pointer): Byte;
+///<summary>
+/// Converts a 12 bit value at the given position to a rainbow color and increments BufPtr by 2 </summary>
+function BufferBits12ToRgb8(var _BufPtr: Pointer): TdzRgbTriple;
 
 ///<summary>
 /// Assign a buffer containing a bitmap in Monochrome format to a 8 bit gray scale TBitmap
@@ -526,6 +539,11 @@
 procedure TBitmap_AssignToMono8(_BufferBitsToMono8Meth: TBufferBitsToMono8Meth;
   _Buffer: Pointer; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64 = 0); overload;
 
+procedure TBitmap_AssignToRgb8(_BufferBitsToRgb8Func: TBufferBitsToRgb8Func;
+  _Buffer: Pointer; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64 = 0); overload;
+procedure TBitmap_AssignToRgb8(_BufferBitsToRgb8Meth: TBufferBitsToRgb8Meth;
+  _Buffer: Pointer; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64 = 0); overload;
+
 ///<summary>
 /// converts a pf24bit or pf32bit monochrome bitmap to a pf8bit monochrome bitmap </summary>
 function TBitmap_MonoToMono8(_bmp: TBitmap): TBitmap; overload;
@@ -817,37 +835,28 @@
 ///<summary>
 /// @param Hue is a value between 0 and 1 </summary>
 function RainbowColor(_Hue: Double): TColor; overload;
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
+{{*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
 
-{$IFDEF SUPPORTS_ENHANCED_RECORDS}
 ///<summary>
 /// @param Hue is a value between 0 and 1 </summary>
 procedure RainbowColor(_Hue: Double; out _Color: TdzRgbTriple); overload;
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
-{$ENDIF}
+// Note: Cannot be declared as inline
+
 ///<summary>
 /// @param Brightness is a grayscale value </summary>
 function RainbowColor(_Brightness: Byte): TColor; overload;
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
+{{*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
+
 procedure RainbowColor(_Brightness: Byte; out _Red, _Green, _Blue: Byte); overload;
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
+{{*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
+
 procedure RainbowColor(_Brightness: Byte; out _Pixel: TdzRgbTriple); overload;
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
+{{*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
+
 function RainbowColor(_MinHue, _MaxHue, _Hue: Integer): TColor; overload;
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
+{{*}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{*)}
 
+
 function TryStr2Color(const _s: string; out _Color: TColor): Boolean;
 
 function TPicture_TryLoadMatchingFile(_pic: TPicture; const _FileMask: string): Boolean;
@@ -1998,6 +2007,15 @@
   IncPtr(_BufPtr, 2);
 end;
 
+function BufferBits12ToRgb8(var _BufPtr: Pointer): TdzRgbTriple;
+var
+  Value: Double;
+begin
+  Value := PUInt16(_BufPtr)^ / (1 shl 12 - 1);
+  RainbowColor(Value, Result);
+  IncPtr(_BufPtr, 2);
+end;
+
 procedure TBitmap_AssignToMono8(_BufferBitsToMono8Func: TBufferBitsToMono8Func;
   _Buffer: Pointer; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64); overload;
 var
@@ -2072,6 +2090,80 @@
   end;
 end;
 
+procedure TBitmap_AssignToRgb8(_BufferBitsToRgb8Func: TBufferBitsToRgb8Func;
+  _Buffer: Pointer; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64 = 0);
+var
+  y: Integer;
+  x: Integer;
+  w: Integer;
+  h: Integer;
+  ScanLine: PdzRgbTriple;
+  Buf: Pointer;
+begin
+  Assert(AssertPixelFormat(_bmp, pf24bit));
+
+  w := _bmp.Width;
+  h := _bmp.Height;
+
+  Assert((_RowStride = 0) or (_RowStride >= w));
+
+  for y := 0 to _bmp.Height - 1 do begin
+    if _YIsReversed then begin
+      ScanLine := _bmp.ScanLine[h - 1];
+    end else begin
+      ScanLine := _bmp.ScanLine[y];
+    end;
+    Buf := _Buffer;
+    for x := 0 to w - 1 do begin
+      ScanLine^ := _BufferBitsToRgb8Func(Buf);
+      Inc(ScanLine);
+    end;
+    if _RowStride > 0 then begin
+      IncPtr(_Buffer, _RowStride);
+    end else begin
+      // we assume that _BufferBitsToRgb8Func inrements the buffer correctly
+      _Buffer := Buf;
+    end;
+  end;
+end;
+
+procedure TBitmap_AssignToRgb8(_BufferBitsToRgb8Meth: TBufferBitsToRgb8Meth;
+  _Buffer: Pointer; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64 = 0);
+var
+  y: Integer;
+  x: Integer;
+  w: Integer;
+  h: Integer;
+  ScanLine: PdzRgbTriple;
+  Buf: Pointer;
+begin
+  Assert(AssertPixelFormat(_bmp, pf24bit));
+
+  w := _bmp.Width;
+  h := _bmp.Height;
+
+  Assert((_RowStride = 0) or (_RowStride >= w));
+
+  for y := 0 to _bmp.Height - 1 do begin
+    if _YIsReversed then begin
+      ScanLine := _bmp.ScanLine[h - 1];
+    end else begin
+      ScanLine := _bmp.ScanLine[y];
+    end;
+    Buf := _Buffer;
+    for x := 0 to w - 1 do begin
+      ScanLine^ := _BufferBitsToRgb8Meth(Buf);
+      Inc(ScanLine);
+    end;
+    if _RowStride > 0 then begin
+      IncPtr(_Buffer, _RowStride);
+    end else begin
+      // we assume that _BufferBitsToRgb8Meth inrements the buffer correctly
+      _Buffer := Buf;
+    end;
+  end;
+end;
+
 type
   PByteArray = SysUtils.PByteArray;
   TCopyScanline = procedure(_Width: Integer; _SrcLine: Pointer; _DestLine: Pointer);
@@ -4032,7 +4124,13 @@
   end;
 end;
 
-{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+procedure TdzRgbTriple_SetValues(_Triple: TdzRgbTriple; _Red, _Green, _Blue: Byte);
+begin
+  _Triple.Red := _Red;
+  _Triple.Green := _Green;
+  _Triple.Blue := _Blue;
+end;
+
 procedure RainbowColor(_Hue: Double; out _Color: TdzRgbTriple);
 var
   Value: Double;
@@ -4041,16 +4139,15 @@
   Value := EnsureRange(_Hue, 0, 1) * 6;
   IntValue := Round(Frac(Value) * 255);
   case Trunc(Value) of
-    0: _Color.SetValues(255, IntValue, 0);
-    1: _Color.SetValues(255 - IntValue, 255, 0);
-    2: _Color.SetValues(0, 255, IntValue);
-    3: _Color.SetValues(0, 255 - IntValue, 255);
-    4: _Color.SetValues(IntValue, 0, 255);
+    0: TdzRgbTriple_SetValues(_Color, 255, IntValue, 0);
+    1: TdzRgbTriple_SetValues(_Color, 255 - IntValue, 255, 0);
+    2: TdzRgbTriple_SetValues(_Color, 0, 255, IntValue);
+    3: TdzRgbTriple_SetValues(_Color, 0, 255 - IntValue, 255);
+    4: TdzRgbTriple_SetValues(_Color, IntValue, 0, 255);
   else // 5
-    _Color.SetValues(255, 0, 255 - IntValue);
+    TdzRgbTriple_SetValues(_Color, 255, 0, 255 - IntValue);
   end;
 end;
-{$ENDIF}
 
 procedure RainbowColor(_Brightness: Byte; out _Red, _Green, _Blue: Byte);
 var

Modified: trunk/ExternalSource/dzlib/u_dzSortProvider.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSortProvider.pas	2023-10-26 07:30:01 UTC (rev 4075)
+++ trunk/ExternalSource/dzlib/u_dzSortProvider.pas	2023-10-28 13:01:16 UTC (rev 4076)
@@ -134,7 +134,14 @@
 
 function TdzIntegerArraySortProvider.doCompare(_IndexA, _IndexB: Integer): Integer;
 begin
+{$IFOPT R+}
+{$DEFINE WAS_R_PLUS}
+{$R-}
+{$ENDIF}
   Result := CompareValue(FOriginal^[_IndexA], FOriginal^[_IndexB]);
+{$IFDEF WAS_R_PLUS}
+{$R+}
+{$ENDIF}
 end;
 
 { TdzSortProvider }

Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas	2023-10-26 07:30:01 UTC (rev 4075)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas	2023-10-28 13:01:16 UTC (rev 4076)
@@ -186,6 +186,8 @@
 
 type
   TMethodPointer = procedure of object;
+const
+  NilEvent: TMethod = (Code: nil; Data: nil);
 
 type
   TRectLTWH = record

Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas	2023-10-26 07:30:01 UTC (rev 4075)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas	2023-10-28 13:01:16 UTC (rev 4076)
@@ -763,12 +763,21 @@
   end;
 {$ENDIF DELPHI2009_UP}
 
-///<summary> sets the control and all its child controls Enabled property and changes their
-///          caption to reflect this
-///          @param Control is the TControl to change
-///          @param Enabled is a boolean with the new value for the Enabled property. </summary>
+///<summary>
+/// sets the control and all its child controls Enabled property and changes their
+/// caption to reflect this
+/// @param Control is the TControl to change
+/// @param Enabled is a boolean with the new value for the Enabled property. </summary>
 procedure TControl_SetEnabled(_Control: TControl; _Enabled: Boolean);
 
+///<summary>
+/// Sets the Enabled property for all controls in the given array.
+/// @param Controls is the array of controls to process
+/// @param Enabled is the value to set the Enabled property to
+/// @param Recursive determines if also controls that are placed on the given controls should be
+///                  processed. Defaults to False. </summary>
+procedure TControls_SetEnabled(_Controls: array of TControl; _Enabled: Boolean; _Recursive: Boolean = False);
+
 ///<summary> Calls protected TControl.Resize (which calls TControl.OnResize if assigned) </summary>
 procedure TControl_Resize(_Control: TControl);
 
@@ -1523,7 +1532,7 @@
 ///                lvrCaptions means resize so the captions fit
 ///                lvrContent menas resize so the contents fit
 ///                both can be combined. </summary>
-procedure TListView_ResizeColumn(_lc: TListColumn; _Options: TLIstViewResizeOptionSet);
+procedure TListView_ResizeColumn(_lc: TListColumn; _Options: TLIstViewResizeOptionSet = [lvrCaptions, lvrContent]);
 ///<summary>
 /// Resize all columns of a TListView in vsReport ViewStyle
 /// @param lc is the TListColumn to resize
@@ -1854,7 +1863,6 @@
 {$IFDEF dzMESSAGEDEBUG}
   u_dzWmMessageToString,
 {$ENDIF dzMESSAGEDEBUG}
-  u_dzSortProvider,
   u_dzLineBuilder,
   u_dzTypesUtils,
   u_dzOsUtils,
@@ -2774,6 +2782,11 @@
   end;
 end;
 
+const
+  // 2 pixels right and left, like in TStringGrid.DrawCell
+  // plus 1 additional pixel that seems to be necessary since Windows 10
+  DrawCellAdditionalPixels = 3;
+
 procedure HandleRow(_Grid: TGridHack; _Col, _Row: Integer; var _MinWidth: Integer);
 var
   ColWidth: Integer;
@@ -2884,7 +2897,7 @@
 
       if goVertLine in Grid.Options then
         Inc(MinWidth, Grid.GridLineWidth);
-      Inc(MinWidth, 4); // 2 pixels to the left and right, as in TStringGrid.DrawCell
+      Inc(MinWidth, DrawCellAdditionalPixels * 2);
 
       if not (roReduceMinWidth in _Options) then begin
         if MinWidth < Grid.DefaultColWidth then
@@ -3003,8 +3016,12 @@
   if dgColLines in Grid.Options then
     // there is one more grid line than there are columns
     Inc(Result, Grid.GridLineWidth);
-  if dgIndicator in Grid.Options then
-    Inc(Result, 21); // ColWidht[0] does not work :-(
+  if dgIndicator in Grid.Options then begin
+    Inc(Result, 21);
+    if dgColLines in Grid.Options then
+      // an additional line for the indicator
+      Inc(Result, Grid.GridLineWidth);
+  end;
 end;
 
 procedure TDbGrid_Resize(_Grid: TCustomDbGrid; _Options: TResizeOptionSet = [];
@@ -3014,7 +3031,8 @@
   Grid: TDbGridHack;
   i: Integer;
   TotalWidth: Integer;
-  sp: TdzIntegerArraySortProvider;
+  GridClientWidth: Integer;
+  MaxWidth: Integer;
   WidestIdx: Integer;
   Additional: Integer;
 begin
@@ -3022,7 +3040,11 @@
   SetLength(MinWidths, Grid.Columns.Count);
   TotalWidth := 0;
   for i := 0 to Grid.Columns.Count - 1 do begin
-    MinWidths[i] := Grid.Columns[i].DefaultWidth;
+    // Unfortunately DefaultWidth reads Width which we set later in this procedure
+    // and therefore DefaultWidth will increase every time this procedure is called.
+    // So we can only set MinWidths[] to _MinWidth.
+//    MinWidths[i] := Grid.Columns[i].DefaultWidth;
+    MinWidths[i] := _MinWidth;
     Inc(TotalWidth, MinWidths[i]);
   end;
 
@@ -3030,24 +3052,35 @@
     Additional := TDbGrid_CalcAdditionalWidth(_Grid);
     if dgColLines in Grid.Options then
       Inc(Additional, Grid.GridLineWidth * Grid.Columns.Count);
-    Inc(Additional, 4 * Grid.Columns.Count); // 2 pixels right and left, like in TStringGrid.DrawCell
+    Inc(Additional, DrawCellAdditionalPixels * 2 * Grid.Columns.Count);
     Inc(TotalWidth, Additional);
-    sp := TdzIntegerArraySortProvider.Create(MinWidths);
-    try
-      while TotalWidth > _Grid.ClientWidth do begin
-        WidestIdx := sp.GetRealPos(High(MinWidths));
-        if MinWidths[WidestIdx] <= _MinWidth then
+    GridClientWidth := _Grid.ClientWidth;
+    if TotalWidth > GridClientWidth then begin
+      while TotalWidth > GridClientWidth do begin
+        // Get the widest column and reduce its size to the _MinWidth value.
+        // Repeat this until that widest column has reached _MinWidht or
+        // until all columns fit into the grid's ClientWidth
+        MaxWidth := MinWidths[0];
+        WidestIdx := 0;
+        for i := 1 to High(MinWidths) do begin
+          if MinWidths[i] > MaxWidth then begin
+            MaxWidth := MinWidths[i];
+            WidestIdx := i;
+          end;
+        end;
+        if MaxWidth <= _MinWidth then begin
+          // The widest column already has the minimum width
           Break;
-        Dec(TotalWidth, MinWidths[WidestIdx] - _MinWidth);
+        end;
+        Dec(TotalWidth, MaxWidth - _MinWidth);
         MinWidths[WidestIdx] := _MinWidth;
-        if TotalWidth < _Grid.ClientWidth then begin
-          MinWidths[WidestIdx] := MinWidths[WidestIdx] + (_Grid.ClientWidth - TotalWidth);
+        if TotalWidth < GridClientWidth then begin
+          // All columns now fit into the ClientWidth
+          // -> add any slack to the widest one and exit the loop
+          MinWidths[WidestIdx] := MinWidths[WidestIdx] + (GridClientWidth - TotalWidth);
           Break;
         end;
-        sp.Update;
       end;
-    finally
-      FreeAndNil(sp);
     end;
   end;
   TDbGrid_Resize(_Grid, _Options, MinWidths);
@@ -3057,6 +3090,7 @@
 var
   Col, Row: Integer;
   Grid: TDbGridHack;
+  GridCanvas: TCanvas;
   MinWidth: Integer;
   ColWidth: Integer;
   ColText: string;
@@ -3071,6 +3105,7 @@
   cw: Integer;
 begin
   Grid := TDbGridHack(_Grid);
+  GridCanvas := Grid.Canvas;
   MaxCol := Grid.ColCount - 1 - Grid.IndicatorOffset;
   MinCol := 0;
   SetLength(ColWidths, MaxCol + 1);
@@ -3084,26 +3119,30 @@
     MinWidth := _MinWidths[Col];
     if not (roIgnoreHeader in _Options) then begin
       ColText := DBColumn.Title.Caption;
-      ColWidth := Grid.Canvas.TextWidth(ColText);
+      GridCanvas.Font := Grid.TitleFont;
+      ColWidth := GridCanvas.TextWidth(ColText);
       if ColWidth > MinWidth then
         MinWidth := ColWidth;
     end;
     for Row := FirstRow to MaxRow do begin
       ColText := Grid.GetEditText(Col + Grid.IndicatorOffset, Row);
-      ColWidth := Grid.Canvas.TextWidth(ColText);
+      GridCanvas.Font := Grid.Font;
+      ColWidth := GridCanvas.TextWidth(ColText);
       if ColWidth > MinWidth then
         MinWidth := ColWidth;
     end;
     if dgColLines in Grid.Options then
       Inc(MinWidth, Grid.GridLineWidth);
-    Inc(MinWidth, 4); // 2 pixels right and left, like in TStringGrid.DrawCell
+    Inc(MinWidth, DrawCellAdditionalPixels * 2);
     ColWidths[Col] := MinWidth;
     Inc(SumWidths, MinWidth);
   end;
   if roUseGridWidth in _Options then begin
     cw := Grid.ClientWidth;
-    if Grid.ScrollBars in [ssBoth, ssVertical] then
-      Dec(cw, GetSystemMetrics(SM_CXVSCROLL));
+    // Apparently for a DbGrid the visibility of the vertical scroll bar is not reflected in
+    // the grid's Scrollbars property, so to be on the safe side, we assume that it is visible
+    // if Grid.ScrollBars in [ssBoth, ssVertical] then
+    Dec(cw, GetSystemMetrics(SM_CXVSCROLL));
     if SumWidths < cw then begin
       Additional := (cw - SumWidths) div (MaxCol + 1);
       for Col := MinCol to MaxCol do begin
@@ -3322,9 +3361,19 @@
     raise EdzStatusBarNoMatchingPanel.CreateFmt(_('Could not find status bar panel with text "%s"'), [_Text]);
 end;
 
-procedure SetControlEnabled(_Control: TControl; _Enabled: Boolean);
+procedure TControls_SetEnabled(_Controls: array of TControl; _Enabled: Boolean; _Recursive: Boolean = False);
+var
+  i: Integer;
+  ctrl: TControl;
 begin
-  TControl_SetEnabled(_Control, _Enabled);
+  for i := Low(_Controls) to High(_Controls) do begin
+    ctrl := _Controls[i];
+    if _Recursive and (ctrl is TWinControl) then begin
+      TControl_SetEnabled(ctrl, _Enabled);
+    end else begin
+      ctrl.Enabled := _Enabled;
+    end;
+  end;
 end;
 
 procedure TControl_SetEnabled(_Control: TControl; _Enabled: Boolean);
@@ -5532,8 +5581,6 @@
 end;
 
 function TPopupMenu_AppendMenuItem(_pm: TPopupMenu; const _Caption: string): TMenuItem; overload;
-const
-  NilEvent: TMethod = (Code: nil; Data: nil);
 begin
   Result := TPopupMenu_AppendMenuItem(_pm, _Caption, TNotifyEvent(NilEvent));
 end;

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