From: <tw...@us...> - 2023-02-18 16:03:04
|
Revision: 3965 http://sourceforge.net/p/gexperts/code/3965 Author: twm Date: 2023-02-18 16:03:00 +0000 (Sat, 18 Feb 2023) Log Message: ----------- updated to latest version from OSDN Modified Paths: -------------- trunk/ExternalSource/dzlib/dzlib.inc trunk/ExternalSource/dzlib/u_dzAdvancedObject.pas trunk/ExternalSource/dzlib/u_dzClassUtils.pas trunk/ExternalSource/dzlib/u_dzDateUtils.pas trunk/ExternalSource/dzlib/u_dzFileUtils.pas trunk/ExternalSource/dzlib/u_dzLineBuilder.pas trunk/ExternalSource/dzlib/u_dzMiscUtils.pas trunk/ExternalSource/dzlib/u_dzQuicksort.pas trunk/ExternalSource/dzlib/u_dzSortUtils.pas trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas trunk/ExternalSource/dzlib/u_dzStringUtils.pas trunk/ExternalSource/dzlib/u_dzTranslator.pas trunk/ExternalSource/dzlib/u_dzTypInfo.pas trunk/ExternalSource/dzlib/u_dzTypes.pas trunk/ExternalSource/dzlib/u_dzTypesUtils.pas trunk/ExternalSource/dzlib/u_dzVclUtils.pas trunk/ExternalSource/dzlib/u_dzVersionInfo.pas Modified: trunk/ExternalSource/dzlib/dzlib.inc =================================================================== --- trunk/ExternalSource/dzlib/dzlib.inc 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/dzlib.inc 2023-02-18 16:03:00 UTC (rev 3965) @@ -82,6 +82,10 @@ {$DEFINE HAS_TMONITOR_PIXELSPERINCH} {$ENDIF} +{$IFDEF DELPHIXE3_UP} +{$DEFINE SUPPORTS_RECORD_HELPERS_FOR_SIMPLE_TYPES} +{$ENDIF} + {$IFDEF DELPHIX_BERLIN_UP} // TMform.GetDesignDpi was introduced in Delphi 10.0 Seattle {$DEFINE HAS_TFORM_GETDESIGNDPI} Modified: trunk/ExternalSource/dzlib/u_dzAdvancedObject.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzAdvancedObject.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzAdvancedObject.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -107,11 +107,17 @@ function TryGetFloatProperty(const _Name: string; out _Value: Double): Boolean; overload; function TryGetFloatProperty(const _Name: string; out _Value: Single): Boolean; overload; {$IFDEF SUPPORTS_EXTENDED} + class function GetFloatProperty(_Instance: TObject; const _Name: string): Extended; overload; + class function GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Extended): Extended; overload; function GetFloatProperty(const _Name: string; const _Default: Extended): Extended; overload; function GetFloatProperty(const _Name: string): Extended; overload; + class function SetFloatProperty(_Instance: TObject; const _Name: string; const _Value: Extended): Boolean; overload; {$ELSE} + class function GetFloatProperty(_Instance: TObject; const _Name: string): Double; overload; + class function GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Double): Double; overload; function GetFloatProperty(const _Name: string; const _Default: Double): Double; overload; function GetFloatProperty(const _Name: string): Double; overload; + class function SetFloatProperty(_Instance: TObject; const _Name: string; const _Value: Double): Boolean; overload; {$ENDIF} ///<summary> @@ -153,6 +159,7 @@ class function GetObjectProperty(_Instance: TObject; const _Name: string; _Default: TObject): TObject; overload; function GetObjectProperty(const _Name: string): TObject; overload; class function GetObjectProperty(_Instance: TObject; const _Name: string): TObject; overload; + class function SetObjectProperty(_Instance: TObject; const _Name: string; _Value: TObject): Boolean; ///<summary> /// Access an event property @@ -298,10 +305,20 @@ class function TAdvancedObject.SetIntProperty(_Instance: TObject; const _Name: string; _Value: Integer): Boolean; begin - Result := u_dzTypInfo.TrySetIntProperty(_Instance, _Name, _Value); + Result := u_dzTypInfo.TrySetIntProperty(_Instance, _Name, _Value); end; {$IFDEF SUPPORTS_EXTENDED} +class function TAdvancedObject.GetFloatProperty(_Instance: TObject; const _Name: string): Extended; +begin + Result := u_dzTypInfo.GetFloatProperty(_Instance, _Name); +end; + +class function TAdvancedObject.GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Extended): Extended; +begin + Result := u_dzTypInfo.GetFloatProperty(_Instance, _Name, _Default); +end; + function TAdvancedObject.GetFloatProperty(const _Name: string; const _Default: Extended): Extended; begin Result := u_dzTypInfo.GetFloatProperty(Self, _Name, _Default); @@ -311,7 +328,23 @@ begin Result := u_dzTypInfo.GetFloatProperty(Self, _Name); end; + +class function TAdvancedObject.SetFloatProperty(_Instance: TObject; const _Name: string; const _Value: Extended): Boolean; +begin + Result := u_dzTypInfo.TrySetFloatProperty(_Instance, _Name, _Value); +end; + {$ELSE} +class function TAdvancedObject.GetFloatProperty(_Instance: TObject; const _Name: string): Double; +begin + Result := u_dzTypInfo.GetFloatProperty(_Instance, _Name); +end; + +class function TAdvancedObject.GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Double): Double; +begin + Result := u_dzTypInfo.GetFloatProperty(_Instance, _Name, _Default); +end; + function TAdvancedObject.GetFloatProperty(const _Name: string; const _Default: Double): Double; overload; begin Result := u_dzTypInfo.GetFloatProperty(Self, _Name, _Default); @@ -321,6 +354,11 @@ begin Result := u_dzTypInfo.GetFloatProperty(Self, _Name); end; + +class function TAdvancedObject.SetFloatProperty(_Instance: TObject; const _Name: string; const _Value: Double): Boolean; +begin + Result := u_dzTypInfo.TrySetFloatProperty(_Instance, _Name, _Value); +end; {$ENDIF} function TAdvancedObject.GetIntProperty(const _Name: string): Integer; @@ -356,6 +394,11 @@ Result := GetObjectProperty(Self, _Name); end; +class function TAdvancedObject.SetObjectProperty(_Instance: TObject; const _Name: string; _Value: TObject): Boolean; +begin + Result := u_dzTypInfo.TrySetObjectProperty(_Instance, _Name, _Value); +end; + function TAdvancedObject.GetStringProperty(const _Name, _Default: string): string; begin Result := u_dzTypInfo.GetStringProperty(Self, _Name, _Default); @@ -586,7 +629,7 @@ SetLength(Result, cnt); for i := 0 to cnt - 1 do begin PropInfo := Props^[i]; - Result[i] := String(PropInfo.Name); + Result[i] := string(PropInfo.Name); end; finally FreeMem(Props); Modified: trunk/ExternalSource/dzlib/u_dzClassUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -19,6 +19,7 @@ Registry, u_dzTranslator, u_dzTypes, + u_dzMiscUtils, // for inlining u_dzDateUtils; // we need this for the $IF Declared() directives // NOTE: The naming convention is <extended-class>_<Methodname> @@ -711,7 +712,6 @@ uses StrUtils, u_dzConvertUtils, - u_dzMiscUtils, u_dzStringUtils; function _(const _s: string): string; Modified: trunk/ExternalSource/dzlib/u_dzDateUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzDateUtils.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzDateUtils.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -13,8 +13,10 @@ interface uses + Windows, // for inlining SysUtils, u_dzTranslator, + u_dzStringUtils, // for inlining u_dzTypes; type @@ -161,8 +163,7 @@ uses SysConst, StrUtils, - DateUtils, - u_dzStringUtils; + DateUtils; function _(const _s: string): string; {$IFDEF SUPPORTS_INLINE} Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -135,7 +135,8 @@ /// @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 EnumDirsOnly(const _Mask: string; _List: TStrings; - _IncludePath: Boolean = False; _Sort: Boolean = True): Integer; + _IncludePath: Boolean = False; _Sort: Boolean = True): Integer; overload; + class function EnumDirsOnly(const _Mask: string; _IncludePath: Boolean = False; _Sort: Boolean = True): TStringArray; overload; /// <summary> /// Calls SysUtils.FindFirst on first call and SysUtls.FindNext in later /// calls. @@ -735,7 +736,9 @@ /// the full paths. /// @returns the number of matching files </summary> class function FindMatchingFiles(const _Mask: string; _sl: TStrings; _IncludePath: Boolean = False; - _Sort: Boolean = True): Integer; + _Sort: Boolean = True): Integer; overload; + class function FindMatchingFiles(const _Mask: string; + _IncludePath: Boolean = False; _Sort: Boolean = True): TStringArray; overload; /// <summary> /// tries to find a matching file @@ -757,9 +760,10 @@ class function FileExists(const _Filename: string; _RaiseException: Boolean): Boolean; overload; deprecated; // use AssertFileExists instead ///<summary> /// Checks if the given file exists. Note that wildcards are not supported! If you - /// need wildcards, use FindMatchingFile. + /// need wildcards, use AssertMatchingFileExists. /// @raises EFileNotFound if the file does not exist. </summary> class procedure AssertFileExists(const _Filename: string); + class procedure AssertMatchingFileExists(const _Mask: string); ///<summary> /// @param RaiseException determines whether an exception should be raised if the directory does not exist @@ -773,8 +777,8 @@ ///<summary> /// @param DirNames is a TStrings object containing a list of directory names to check. - /// @retursn true, if all directories in the list exist, false otherwise - /// Note: Passing an empty list, result in true. </summary> + /// @returns true, if all directories in the list exist, false otherwise + /// @NOTE: Passing an empty list will return True. </summary> class function AllDirsExist(_DirNames: TStrings): Boolean; /// <summary> @@ -788,7 +792,7 @@ /// @param Force is a boolean which controls whether this function will try to delete /// readonly directories, If true, it will use SetFileAttr to reset the /// readonly attribut and try to delete the directory again. - /// @returns true, if the directory could be deleted, false otherwise. + /// @returns True, if the directory could be deleted, false otherwise. /// @raises EOSError if there was an error and RaiseException was true </summary> class function RemoveDir(const _DirName: string; _RaiseException: Boolean = True; _Force: Boolean = False): Boolean; @@ -808,7 +812,7 @@ /// if it fails. If false, it will not raise an exception /// but just return false if deleting the directory fails. /// @param Force specifies whether it should also delete readonly files - /// @returns true, if the directory could be deleted, false otherwise. + /// @returns True, if the directory could be deleted, false otherwise. /// @raises EOSError if there was an error and RaiseException was true </summary> class function DelDirTree(const _DirName: string; _RaiseException: Boolean = True; _Force: Boolean = False): Boolean; @@ -1010,7 +1014,21 @@ ///<summary> /// Short for ChangeFileExtLast(_Filename, '') </summary> class function RemoveFileExtLast(const _Filename: string): string; + ///<summary> + /// @param Ext is the full file extension to check for, including the leading dot. + /// @returns True, if the full extension of Filename matches the given extension. + /// Comparison is case insensitive + /// False if the extensions don't machch. </summary> + class function HasFileExtFull(const _Filename: string; const _Ext: string): Boolean; + ///<summary> + /// @param Ext is the last file extension to check for, including the leading dot. + /// @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; + + ///<summary> /// Sets the file's date and time to the given time or to the current time /// @param Fileanme is the name of the file to touch /// @param lpSystemTime is a pointer to a TSystemTime record givng the time, @@ -1314,6 +1332,19 @@ end; end; +class function TSimpleDirEnumerator.EnumDirsOnly(const _Mask: string; _IncludePath, _Sort: Boolean): TStringArray; +var + dirs: TStringList; +begin + dirs := TStringList.Create; + try + EnumDirsOnly(_Mask, dirs, _IncludePath, _Sort); + Result := TStringArray_FromStrings(dirs); + finally + FreeAndNil(dirs); + end; +end; + class procedure TSimpleDirEnumerator.EnumFilesOnly(const _Mask: string; _Callback: TOnFileEnumCallback; _IncludePath: Boolean = False; _Sort: Boolean = True); var @@ -1512,6 +1543,16 @@ Result := GetRemoteVolumeName(_DriveLetter + ':\'); end; +class function TFileSystem.HasFileExtFull(const _Filename, _Ext: string): Boolean; +begin + Result := SameText(_Ext, ExtractFileExtFull(_Filename)); +end; + +class function TFileSystem.HasFileExtLast(const _Filename, _Ext: string): Boolean; +begin + Result := SameText(_Ext, ExtractFileExtLast(_Filename)); +end; + class function TFileSystem.GetRemoteVolumeName(const _Share: string): string; var Res: LongBool; @@ -2477,6 +2518,12 @@ raise EFileNotFound.CreateFmt(_('File not found: %s'), [_Filename]); end; +class procedure TFileSystem.AssertMatchingFileExists(const _Mask: string); +begin + if FindMatchingFile(_Mask) <> mfFile then + raise EFileNotFound.CreateFmt(_('Matching file not found: %s'), [_Mask]); +end; + class function TFileSystem.DirExists(const _DirName: string): Boolean; begin Result := SysUtils.DirectoryExists(_DirName); @@ -2545,6 +2592,24 @@ Result := FindMatchingFile(_Mask, fn); end; +class function TFileSystem.FindMatchingFiles(const _Mask: string; + _IncludePath: Boolean; _Sort: Boolean): TStringArray; +var + Cnt: Integer; + sl: TStringList; + i: Integer; +begin + sl := TStringList.Create; + try + Cnt := FindMatchingFiles(_Mask, sl, _IncludePath, _Sort); + SetLength(Result, Cnt); + for i := 0 to Cnt - 1 do + Result[i] := sl[i]; + finally + FreeAndNil(sl); + end; +end; + class function TFileSystem.FindMatchingFiles(const _Mask: string; _sl: TStrings; _IncludePath: Boolean = False; _Sort: Boolean = True): Integer; begin Modified: trunk/ExternalSource/dzlib/u_dzLineBuilder.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzLineBuilder.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzLineBuilder.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -69,6 +69,7 @@ function Length: Integer; ///<summary> allows read access to the content that has been built </summary> property Content: string read FContent; + ///<summary> Number of columns that have been added to this line </summary> property ColumnCount: Integer read FColumnCount; property DecimalSeparator: Char read GetDecimalSeparator write SetDecimalSeparator default '.'; property ListSeparator: string read FListSeparator write FListSeparator; Modified: trunk/ExternalSource/dzlib/u_dzMiscUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -249,9 +249,7 @@ procedure NotImplemented; begin -{$IFNDEF console} - if mrAbort = MessageDlg('Function not implemented!', mtWarning, [mbAbort, mbIgnore], 0) then -{$ENDIF} + if ID_YES <> Windows.MessageBox(0, 'Function not implemented! Continue anyway?', 'Warning', MB_YESNO + MB_ICONWARNING) then raise ENotImplemented.Create('Function not implemented'); end; {$ENDIF debug} Modified: trunk/ExternalSource/dzlib/u_dzQuicksort.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzQuicksort.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzQuicksort.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -10,58 +10,132 @@ interface uses + Classes, + SysUtils, u_dzSortUtils; type - // for binary search + ///<summary> + /// raised in the sorted list templates instead of EListError so it is possible to + /// specifically ignore these exceptions in the debugger if they are handled in code </summary> + EdzListError = class(EListError) + end; + +type + ///<sumary> + /// Method pointer for passing to BinarySearch + /// @param Key is the key to compare to as an untyped const parameter + /// @param Index is the index of te item in the list to compare this key to. + /// @returns 0 if Key = Item[Idx].Key + /// 1 if Key > Item[Idx].Key + /// -1 if Key < Item[Idx].Key</summary> TCompareToItemMeth1 = function(const _Key; _Idx: Integer): Integer of object; - TCompareToItemMeth2 = function(_Key: pointer; _Idx: Integer): Integer of object; + ///<sumary> + /// Method pointer for passing to BinarySearch + /// @param Key is a pointer to the key to compare to + /// @param Index is the index of te item in the list to compare this key to. + /// @returns 0 if Key = Item[Idx].Key + /// 1 if Key > Item[Idx].Key + /// -1 if Key < Item[Idx].Key</summary> + TCompareToItemMeth2 = function(_Key: Pointer; _Idx: Integer): Integer of object; + ///<summary> -/// Call Quicksort with two method pointers for -/// comparing and swapping two elements. -/// @longcode(## -/// Quicksort(0, Count-1, self.CompareItems, self.SwapItems); -/// ##) } +/// Quicksort with two method pointers for comparing and swapping two elements. +/// The method pointer signatures are declared in u_dzSortUtils. +/// @longcode(## +/// Quicksort(0, Count-1, self.CompareItems, self.SwapItems); +/// ##) </summary> procedure QuickSort(_Left, _Right: Integer; _CompareMeth: TCompareItemsMeth; _SwapMeth: TSwapItemsMeth); overload; ///<summary> -/// Call Quicksort with an interface that does the comparison and swapping -/// comparing and swapping two elements. -/// @longcode(## -/// Quicksort(0, Count-1, CompareAndSwapInterface); -/// ##) } +/// Quicksort with an ISortDataHandler interface that does the comparison and swapping +/// The ISortDataHandler interface are declared in u_dzSortUtils. +/// @longcode(## +/// Quicksort(0, Count-1, CompareAndSwapInterface); +/// ##) </summary> procedure QuickSort(_Left, _Right: Integer; _DataHandler: ISortDataHandler); overload; ///<summary> -/// Call BinarySearch with a method pointer that -/// compares an index to the Item sought. -/// @param Index contains the index where the item is supposed to be -/// (Its index, if it was found or the index where it would be inserted if not) -/// @param Duplicates determines whether duplicates are allowed in the list or not -/// @returns true, if the item was found, false otherwise -/// @longcode(## -/// Found := BinarySearch(0, count-1, Idx, Key, Self.CompareToKey); -/// ##) } +/// Quicksort with an ISortDataHandlerEx interface that does the comparison and swapping +/// and also give the number of items to sort. +/// The ISortDataHandlerEx interface are declared in u_dzSortUtils. +/// @longcode(## +/// Quicksort(0, Count-1, CountCompareAndSwapInterface); +/// ##) </summary> +procedure QuickSort(_DataHandler: ISortDataHandlerEx); overload; + +///<summary> +/// BinarySearch with a method pointer that compares an index to the Item sought. +/// @param Index contains the index, where the item was found (if Result = True), +/// or where it would be inserted (if Result = False) +/// @param Duplicates determines whether to check for duplicates in the list +/// If True, Index will always be that of first item that matches the key. +/// If False, Index will be any item that matches the key. +/// @returns True, if the item was found, False otherwise +/// @longcode(## +/// Found := BinarySearch(0, Count - 1, Idx, Key, Self.CompareToKey); +/// ##) </summary> function BinarySearch(_Left, _Right: Integer; out _Index: Integer; const _Key; _CompareMeth: TCompareToItemMeth1; _Duplicates: Boolean = False): Boolean; overload; +///<summary> +/// BinarySearch with a method pointer that compares an index to the Item sought. +/// @param Index contains the index, where the item was found (if Result = True), +/// or where it would be inserted (if Result = False) +/// @param Duplicates determines whether to check for duplicates in the list +/// If True, Index will always be that of first item that matches the key. +/// If False, Index will be any item that matches the key. +/// @returns True, if the item was found, False otherwise +/// @longcode(## +/// Found := BinarySearch(0, Count - 1, Idx, Key, Self.CompareToKey); +/// ##) </summary> function BinarySearch(_Left, _Right: Integer; out _Index: Integer; - _Key: pointer; _CompareMeth: TCompareToItemMeth2; + _Key: Pointer; _CompareMeth: TCompareToItemMeth2; _Duplicates: Boolean = False): Boolean; overload; type ICompareToKey = interface ['{CEB61050-D71F-4F67-B9BC-FD496A079F75}'] + ///<summary> + /// Compares the key (stored in the interface) to the the item with the given index. + /// @param Index is the index of te item in the list to compare this key to. + /// @returns 0 if Key = Item[Idx].Key + /// 1 if Key > Item[Idx].Key + /// -1 if Key < Item[Idx].Key</summary> function CompareTo(_Idx: Integer): Integer; end; +type + ICompareToKeyEx = interface(ICompareToKey)['{10673750-EE58-40E3-A144-CA9EF517EBCA}'] + function Count: Integer; + end; + +///<summary> +/// BinarySearch with an ICompareToKey interface that compares an index to the Item sought. +/// @param Index contains the index, where the item was found (if Result = True), +/// or where it would be inserted (if Result = False) +/// @param Duplicates determines whether to check for duplicates in the list +/// If True, Index will always be that of first item that matches the key. +/// If False, Index will be any item that matches the key. +/// @returns True, if the item was found, False otherwise +/// @longcode(## +/// Found := BinarySearch(0, Count - 1, Idx, Key, CompareToInt); +/// ##) } </summary> function BinarySearch(_Left, _Right: Integer; out _Index: Integer; _CompareInt: ICompareToKey; _Duplicates: Boolean = False): Boolean; overload; +function BinarySearch(out _Index: Integer; + _CompareExInt: ICompareToKeyEx; _Duplicates: Boolean = False): Boolean; overload; + implementation +procedure QuickSort(_DataHandler: ISortDataHandlerEx); overload; +begin + QuickSort(0, _DataHandler.Count - 1, _DataHandler); +end; + procedure QuickSort(_Left, _Right: Integer; _DataHandler: ISortDataHandler); overload; var I, J, P: Integer; @@ -204,5 +278,11 @@ _Index := _Left; end; +function BinarySearch(out _Index: Integer; + _CompareExInt: ICompareToKeyEx; _Duplicates: Boolean = False): Boolean; +begin + Result := BinarySearch(0, _CompareExInt.Count - 1, _Index, _CompareExInt, _Duplicates); +end; + end. Modified: trunk/ExternalSource/dzlib/u_dzSortUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzSortUtils.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzSortUtils.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -30,12 +30,19 @@ /// <0 if Item[Idx1] < Item[Idx2] /// >0 if Item[Idx1] > Item[Idx2] </summary> function Compare(_Idx1, _Idx2: Integer): Integer; - ///<summary> - /// Swap the items at the given indexes </summary> + ///<summary> + /// Swap the items at the given indexes </summary> procedure Swap(_Idx1, _Idx2: Integer); end; type + ///<summary> + /// Adds a Count method to the ISortDataHander interface </summary> + ISortDataHandlerEx = interface(ISortDataHandler)['{C2DD7397-C0C3-4519-AA24-7FB2EF559DAD}'] + function Count: Integer; + end; + +type IQSDataHandler = ISortDataHandler {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated // use ISortDataHandler instead Modified: trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -18,8 +18,8 @@ type ///<summary> /// A helper component that turns a TBitBtn into a button that works similar to a TSpeedButton - /// but can receive the focus. It allows to either set a caption or a Glyph, but will ignore - /// the Glyph if Caption is <> ''. + /// but can receive the focus. It allows to either set a caption and a Glyp and even supports + /// word wrapping and setting a margin. /// Clicking the button will first set its Tag property to 0 (up) or down (1) and then call the /// original OnClick method. /// To use it create it with TdzSpeedBitBtn.Create(BitBtn) where BitBtn is an already existing @@ -34,6 +34,9 @@ FUpBmp: TBitmap; FDownBmp: TBitmap; FData: Pointer; + FNeedsNewGlyphs: Boolean; + FOrigMargin: Integer; + FOrigSpacing: Integer; procedure doOnClick(_Sender: TObject); procedure HandleOnClick(_Sender: TObject); function GetDown: Boolean; @@ -40,6 +43,8 @@ procedure SetDown(const Value: Boolean); procedure UpdateGlyph; function GetBitBtn: TBitBtn; + procedure PrepareBmp(_w, _h: Integer; _Color: TColor; _Edge: UINT; out _bmp: TBitmap); + procedure PrepareBmps; protected procedure NewWindowProc(var _Msg: TMessage); override; public @@ -108,250 +113,256 @@ { TdzSpeedBitBtn } constructor TdzSpeedBitBtn.Create(_btn: TWinControl); +begin + inherited Create(_btn); + FOrigOnClick := BitBtn.OnClick; + FCaption := BitBtn.Caption; - procedure PrepareBmp(_w, _h: Integer; _Color: TColor; _Edge: UINT; out _bmp: TBitmap); - var - cnv: TCanvas; + FOrigBmp := TBitmap.Create; + FOrigBmp.Assign(BitBtn.Glyph); + FOrigBmp.Transparent := True; - procedure HandleBmpOnly; - var - x: Integer; - y: Integer; - begin - x := BitBtn.Margin; - y := (_h - FOrigBmp.Height) div 2; - if x = -1 then begin - // center image in the button - x := (_w - FOrigBmp.Width) div 2; - end else begin - // left align image - end; - cnv.Draw(x, y, FOrigBmp); - end; + BitBtn.Caption := ''; - procedure HandleTextOnlySingleLine; - var - x: Integer; - r: TRect; - HorizontalAlignment: TDrawTextHorizontalAlignment; - begin - x := BitBtn.Margin; - if x = -1 then begin - HorizontalAlignment := dthaCenter; - r := Rect(2, 0, _w - 3, _h); - end else begin - HorizontalAlignment := dthaLeft; - r := Rect(x + 2, 0, _w - 3, _h); - end; - TCanvas_DrawTextSingleLine(cnv, FCaption, r, HorizontalAlignment, dtvaCenter, []); - end; + FUpBmp := TBitmap.Create; + FDownBmp := TBitmap.Create; - procedure HandleTextOnlyMultiLine; - var - x: Integer; - r: TRect; - TextWidth: Integer; - TextHeight: Integer; - begin - x := BitBtn.Margin; - if x = -1 then begin - // center - r := Rect(2, 0, _w - 3, _h - 4); - TCanvas_DrawText(cnv, FCaption, r, [dtfCalcRect, dtfCenter, dtfWordBreak]); - TextHeight := r.Bottom - r.Top; - r.Left := 2; - r.Top := Max(0, (_h - TextHeight) div 2); - r.Right := _w - 3; - r.Bottom := Min(_h - 4, r.Top + TextHeight); - TCanvas_DrawText(cnv, FCaption, r, [dtfCenter, dtfWordBreak]); - end else begin - // left align the centered text - // Yes, that doesn't make much sense, but TBitBtn works that way. - // Actually it's even worse: TBitBtn draws the text centered on the possible button width - // and then moves it to the right which clips the text if it is too wide. - // We don't make that mistake here but still center the text and then move it. - r := Rect(x + 2, 0, _w - 3, _h - 4); - TCanvas_DrawText(cnv, FCaption, r, [dtfCalcRect, dtfCenter, dtfWordBreak]); - TextWidth := r.Right - r.Left; - TextHeight := r.Bottom - r.Top; - r.Left := x + 2; - r.Top := Max(0, (_h - TextHeight) div 2); - r.Right := Min(_w - 3, x + 2 + TextWidth); - r.Bottom := Min(_h - 4, r.Top + TextHeight); - TCanvas_DrawText(cnv, FCaption, r, [dtfCenter, dtfWordBreak]); - end; - end; + PrepareBmps; - procedure HandleTextOnly; - begin - {$IFDEF HAS_BITBTN_WORDWRAP} - if BitBtn.WordWrap then begin - HandleTextOnlyMultiLine; - end else - {$ENDIF}begin - HandleTextOnlySingleLine; - end; - end; + BitBtn.OnClick := HandleOnClick; - procedure HandleBmpAndSingleLineText; - var - TextSize: TSize; - RequiredWidth: Integer; - r: TRect; - x: Integer; - begin - TextSize := cnv.TextExtent(FCaption); - if BitBtn.Margin = -1 then begin - // center image and text on the button - RequiredWidth := FOrigBmp.Width + BitBtn.Spacing + TextSize.cx; - x := (_w - RequiredWidth) div 2; - cnv.Draw(x, (_h - FOrigBmp.Width) div 2, FOrigBmp); - r.Left := x + BitBtn.Margin + BitBtn.Spacing + FOrigBmp.Width; - r.Top := (_h - TextSize.cy) div 2; - r.Right := r.Left + TextSize.cx; - r.Bottom := r.Top + TextSize.cy; - TCanvas_DrawText(cnv, FCaption, r, [dtfLeft, dtfTopSingle, dtfSingleLine, dtfNoClip]); - end else begin - // left align image and text - cnv.Draw(BitBtn.Margin, (_h - FOrigBmp.Height) div 2, FOrigBmp); - r.Left := BitBtn.Margin + BitBtn.Spacing + FOrigBmp.Width; - r.Top := (_h - TextSize.cy) div 2; - r.Right := r.Left + TextSize.cx; - r.Bottom := r.Top + TextSize.cy; - TCanvas_DrawText(cnv, FCaption, r, [dtfLeft, dtfTopSingle, dtfSingleLine, dtfNoClip]); - end; - end; + FOrigMargin := BitBtn.Margin; + FOrigSpacing := BitBtn.Spacing; + BitBtn.Margin := -1; + BitBtn.Spacing := 0; - procedure HandleBmpAndMultilineText; - var - r: TRect; - TextWidth: Integer; - TextHeight: Integer; - RequiredWidth: Integer; - x: Integer; - begin - if BitBtn.Margin = -1 then begin - // center image and text on the button + UpdateGlyph; +end; - r := Rect(0, 0, _w - FOrigBmp.Width - 1 - BitBtn.Spacing, _h - 2); - TCanvas_DrawText(cnv, FCaption, r, [dtfCalcRect, dtfCenter, dtfWordBreak]); - TextWidth := r.Right - r.Left; - TextHeight := r.Bottom - r.Top; - RequiredWidth := FOrigBmp.Width + BitBtn.Spacing + TextWidth; - x := (_w - RequiredWidth) div 2; - cnv.Draw(x, (_h - FOrigBmp.Height) div 2, FOrigBmp); +destructor TdzSpeedBitBtn.Destroy; +begin + // If we get here, either the constructor failed (which automatically calls the destructor) + // or BitBtn was already destroyed, so we must not access it at all. + FUpBmp.Free; + FDownBmp.Free; + FOrigBmp.Free; + inherited; +end; - r.Left := x + FOrigBmp.Width + BitBtn.Spacing; - r.Top := (_h - TextHeight) div 2; - r.Right := r.Left + TextWidth; - r.Bottom := r.Top + TextHeight; - TCanvas_DrawText(cnv, FCaption, r, [dtfCenter, dtfWordBreak]); - end else begin - // left align image and text +procedure TdzSpeedBitBtn.PrepareBmps; +var + w: Integer; + h: Integer; + ColBack1: TColor; + ColBack2: TColor; +begin + w := BitBtn.ClientWidth; + h := BitBtn.ClientHeight; - r := Rect(0, 0, _w - BitBtn.Margin - FOrigBmp.Width - 1 - BitBtn.Spacing, _h - 2); - TCanvas_DrawText(cnv, FCaption, r, [dtfCalcRect, dtfCenter, dtfWordBreak]); - TextWidth := r.Right - r.Left; - TextHeight := r.Bottom - r.Top; + ColBack1 := RGB(240, 240, 240); // clBtnFace; + ColBack2 := RGB(245, 245, 245); // a bit lighter than clBtnFace; - cnv.Draw(BitBtn.Margin, (_h - FOrigBmp.Width) div 2, FOrigBmp); + PrepareBmp(w, h, ColBack1, EDGE_RAISED, FUpBmp); + PrepareBmp(w, h, ColBack2, EDGE_SUNKEN, FDownBmp); +end; - r.Left := BitBtn.Margin + FOrigBmp.Width + BitBtn.Spacing; - r.Top := (_h - TextWidth) div 2; - r.Right := r.Left + TextWidth; - r.Bottom := r.Top + TextHeight; - TCanvas_DrawText(cnv, FCaption, r, [dtfCenter, dtfWordBreak]); - end; +procedure TdzSpeedBitBtn.PrepareBmp(_w, _h: Integer; _Color: TColor; _Edge: UINT; out _bmp: TBitmap); +var + cnv: TCanvas; + + procedure HandleBmpOnly; + var + X: Integer; + Y: Integer; + begin + X := FOrigMargin; + Y := (_h - FOrigBmp.Height) div 2; + if X = -1 then begin + // center image in the button + X := (_w - FOrigBmp.Width) div 2; + end else begin + // left align image end; + cnv.Draw(X, Y, FOrigBmp); + end; - procedure HandleBmpAndText; - begin - // This is complicated. For now we will only support buttons with - // Layout=blGlyphLeft - {$IFDEF HAS_BITBTN_WORDWRAP} - if BitBtn.WordWrap then begin - HandleBmpAndMultilineText; - end else - {$ENDIF}begin - HandleBmpAndSingleLineText; - end; + procedure HandleTextOnlySingleLine; + var + X: Integer; + r: TRect; + HorizontalAlignment: TDrawTextHorizontalAlignment; + begin + X := FOrigMargin; + if X = -1 then begin + HorizontalAlignment := dthaCenter; + r := Rect(2, 0, _w - 3, _h); + end else begin + HorizontalAlignment := dthaLeft; + r := Rect(X + 2, 0, _w - 3, _h); end; + TCanvas_DrawTextSingleLine(cnv, FCaption, r, HorizontalAlignment, dtvaCenter, []); + end; + procedure HandleTextOnlyMultiLine; var + X: Integer; r: TRect; + TextWidth: Integer; + TextHeight: Integer; begin - _bmp := TBitmap.Create; - _bmp.Width := _w; - _bmp.Height := _h; - _bmp.TransparentColor := clFuchsia; + X := FOrigMargin; + if X = -1 then begin + // center + r := Rect(2, 0, _w - 3, _h - 4); + TCanvas_DrawText(cnv, FCaption, r, [dtfCalcRect, dtfCenter, dtfWordBreak]); + TextHeight := r.Bottom - r.Top; + r.Left := 2; + r.Top := Max(0, (_h - TextHeight) div 2); + r.Right := _w - 3; + r.Bottom := Min(_h - 4, r.Top + TextHeight); + TCanvas_DrawText(cnv, FCaption, r, [dtfCenter, dtfWordBreak]); + end else begin + // left align the centered text + // Yes, that doesn't make much sense, but TBitBtn works that way. + // Actually it's even worse: TBitBtn draws the text centered on the possible button width + // and then moves it to the right which clips the text if it is too wide. + // We don't make that mistake here but still center the text and then move it. + r := Rect(X + 2, 0, _w - 3, _h - 4); + TCanvas_DrawText(cnv, FCaption, r, [dtfCalcRect, dtfCenter, dtfWordBreak]); + TextWidth := r.Right - r.Left; + TextHeight := r.Bottom - r.Top; + r.Left := X + 2; + r.Top := Max(0, (_h - TextHeight) div 2); + r.Right := Min(_w - 3, X + 2 + TextWidth); + r.Bottom := Min(_h - 4, r.Top + TextHeight); + TCanvas_DrawText(cnv, FCaption, r, [dtfCenter, dtfWordBreak]); + end; + end; - cnv := _bmp.Canvas; + procedure HandleTextOnly; + begin +{$IFDEF HAS_BITBTN_WORDWRAP} + if BitBtn.WordWrap then begin + HandleTextOnlyMultiLine; + end else +{$ENDIF}begin + HandleTextOnlySingleLine; + end; + end; - cnv.Brush.Color := _Color; - cnv.Brush.Style := bsSolid; - cnv.FillRect(Rect(0, 0, _w, _h)); + procedure HandleBmpAndSingleLineText; + var + TextSize: TSize; + RequiredWidth: Integer; + r: TRect; + X: Integer; + begin + TextSize := cnv.TextExtent(FCaption); + if FOrigMargin = -1 then begin + // center image and text on the button + RequiredWidth := FOrigBmp.Width + FOrigSpacing + TextSize.cx; + X := (_w - RequiredWidth) div 2; + cnv.Draw(X, (_h - FOrigBmp.Width) div 2, FOrigBmp); + r.Left := X + FOrigMargin + FOrigSpacing + FOrigBmp.Width; + r.Top := (_h - TextSize.cy) div 2; + r.Right := r.Left + TextSize.cx; + r.Bottom := r.Top + TextSize.cy; + TCanvas_DrawText(cnv, FCaption, r, [dtfLeft, dtfTopSingle, dtfSingleLine, dtfNoClip]); + end else begin + // left align image and text + cnv.Draw(FOrigMargin, (_h - FOrigBmp.Height) div 2, FOrigBmp); + r.Left := FOrigMargin + FOrigSpacing + FOrigBmp.Width; + r.Top := (_h - TextSize.cy) div 2; + r.Right := r.Left + TextSize.cx; + r.Bottom := r.Top + TextSize.cy; + TCanvas_DrawText(cnv, FCaption, r, [dtfLeft, dtfTopSingle, dtfSingleLine, dtfNoClip]); + end; + end; - r := Rect(0, 0, _w - 1, _h - 2); - DrawEdge(cnv.Handle, r, _Edge, BF_RECT); + procedure HandleBmpAndMultilineText; + var + r: TRect; + TextWidth: Integer; + TextHeight: Integer; + RequiredWidth: Integer; + X: Integer; + begin + if FOrigMargin = -1 then begin + // center image and text on the button + r := Rect(0, 0, _w - FOrigBmp.Width - 1 - FOrigSpacing, _h - 2); + TCanvas_DrawText(cnv, FCaption, r, [dtfCalcRect, dtfCenter, dtfWordBreak]); + TextWidth := r.Right - r.Left; + TextHeight := r.Bottom - r.Top; + RequiredWidth := FOrigBmp.Width + FOrigSpacing + TextWidth; + X := (_w - RequiredWidth) div 2; + cnv.Draw(X, (_h - FOrigBmp.Height) div 2, FOrigBmp); - cnv.Brush.Style := bsClear; - cnv.Font := BitBtn.Font; + r.Left := X + FOrigBmp.Width + FOrigSpacing; + r.Top := (_h - TextHeight) div 2; + r.Right := r.Left + TextWidth; + r.Bottom := r.Top + TextHeight; + TCanvas_DrawText(cnv, FCaption, r, [dtfCenter, dtfWordBreak]); + end else begin + // left align image and text + r := Rect(0, 0, _w - FOrigMargin - FOrigBmp.Width - 1 - FOrigSpacing, _h - 2); + TCanvas_DrawText(cnv, FCaption, r, [dtfCalcRect, dtfCenter, dtfWordBreak]); + TextWidth := r.Right - r.Left; + TextHeight := r.Bottom - r.Top; - if FCaption <> '' then begin - if (FOrigBmp.Width <> 0) and (FOrigBmp.Height <> 0) then begin - HandleBmpAndText; - end else begin - // text only - HandleTextOnly; - end; - end else begin - HandleBmpOnly; + cnv.Draw(FOrigMargin, (_h - FOrigBmp.Width) div 2, FOrigBmp); + + r.Left := FOrigMargin + FOrigBmp.Width + FOrigSpacing; + r.Top := (_h - TextWidth) div 2; + r.Right := r.Left + TextWidth; + r.Bottom := r.Top + TextHeight; + TCanvas_DrawText(cnv, FCaption, r, [dtfCenter, dtfWordBreak]); end; end; + procedure HandleBmpAndText; + begin + // This is complicated. For now we will only support buttons with + // Layout=blGlyphLeft +{$IFDEF HAS_BITBTN_WORDWRAP} + if BitBtn.WordWrap then begin + HandleBmpAndMultilineText; + end else +{$ENDIF}begin + HandleBmpAndSingleLineText; + end; + end; + var - w: Integer; - h: Integer; - ColBack1: TColor; - ColBack2: TColor; + r: TRect; begin - inherited Create(_btn); - FOrigOnClick := BitBtn.OnClick; - FCaption := BitBtn.Caption; + _bmp.Width := _w; + _bmp.Height := _h; + _bmp.TransparentColor := clFuchsia; - FOrigBmp := TBitmap.Create; - FOrigBmp.Assign(BitBtn.Glyph); - FOrigBmp.Transparent := True; + cnv := _bmp.Canvas; - BitBtn.Caption := ''; + cnv.Brush.Color := _Color; + cnv.Brush.Style := bsSolid; + cnv.FillRect(Rect(0, 0, _w, _h)); - w := BitBtn.ClientWidth; - h := BitBtn.ClientHeight; + r := Rect(0, 0, _w - 1, _h - 2); + DrawEdge(cnv.Handle, r, _Edge, BF_RECT); - ColBack1 := rgb(240, 240, 240); // clBtnFace; - ColBack2 := rgb(245, 245, 245); // a bit lighter than clBtnFace; + cnv.Brush.Style := bsClear; + cnv.Font := BitBtn.Font; - PrepareBmp(w, h, ColBack1, EDGE_RAISED, FUpBmp); - PrepareBmp(w, h, ColBack2, EDGE_SUNKEN, FDownBmp); - - BitBtn.OnClick := HandleOnClick; - - BitBtn.Margin := -1; - BitBtn.Spacing := 0; - - UpdateGlyph; + if FCaption <> '' then begin + if (FOrigBmp.Width <> 0) and (FOrigBmp.Height <> 0) then begin + HandleBmpAndText; + end else begin + // text only + HandleTextOnly; + end; + end else begin + HandleBmpOnly; + end; end; -destructor TdzSpeedBitBtn.Destroy; -begin - // If we get here, either the constructor failed (which automatically calls the destructor) - // or BitBtn was already destroyed, so we must not access it at all. - FUpBmp.Free; - FDownBmp.Free; - FOrigBmp.Free; - inherited; -end; - procedure TdzSpeedBitBtn.doOnClick(_Sender: TObject); begin if Assigned(FOrigOnClick) then @@ -372,6 +383,20 @@ _Msg.Result := 1; end else inherited; + end else if (_Msg.Msg = CM_FONTCHANGED) +{$IF Declared(WM_DPICHANGED_AFTERPARENT)} + or (_Msg.Msg = WM_DPICHANGED_AFTERPARENT) +{$IFEND} + or (_Msg.Msg = WM_SIZE) then begin + FNeedsNewGlyphs := True; + inherited; + end else if _Msg.Msg = WM_PAINT then begin + if FNeedsNewGlyphs then begin + PrepareBmps; + UpdateGlyph; + FNeedsNewGlyphs := False; + end; + inherited; end else inherited; end; @@ -462,7 +487,7 @@ SetUp(i); end else SetDown(i); - break; //==> + Break; //==> end; end; doOnClick; Modified: trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -27,6 +27,8 @@ function TStringArray_Contains(const _arr: TStringArray; const _s: string; out _Idx: Integer): Boolean; overload; function TStringArray_Contains(const _arr: TStringArray; const _s: string): Boolean; overload; +function TStringArray_AsCsv(const _arr: TStringArray; const _Separator: string = ','): string; + function TStringArray_FromStrings(_sl: TStrings): TStringArray; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} @@ -168,6 +170,23 @@ Result := TStringArray_Contains(_arr, _s, Idx); end; +function TStringArray_AsCsv(const _arr: TStringArray; const _Separator: string = ','): string; +var + i: Integer; + len: Integer; +begin + len := Length(_arr); + case len of + 0: Result := ''; + 1: Result := _arr[0]; + else + Result := _arr[0]; + for i := 1 to len - 1 do begin + Result := Result + _Separator + _arr[i]; + end; + end; +end; + function TStringArray_Concat(const _Arr1, _Arr2: array of string): TStringArray; var Len1: Integer; Modified: trunk/ExternalSource/dzlib/u_dzStringUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -56,6 +56,12 @@ {$ENDIF SUPPORTS_UNICODE} ///<summary> +/// Cuts off the string at the first #0 and returns the new length </summary> +function StrTrimNul(var _s: AnsiString): Integer; +///<summary> use StrTrimNul </summary> +function StrTrimZero(var _s: AnsiString): integer; deprecated; // use StrTrimNul + +///<summary> /// Converts an array of byte to a string, interpreting the bytes as AnsiString </summary> function ByteArrayToString(const _buf: array of Byte): string; ///<summary> @@ -1523,6 +1529,25 @@ Result := string(s); end; +function StrTrimNul(var _s: AnsiString): Integer; +var + i: Integer; +begin + Result := Length(_s); + for i := 1 to Result do begin + if _s[i] = #0 then begin + Result := i - 1; + SetLength(_s, Result); + Exit; //==> + end; + end; +end; + +function StrTrimZero(var _s: AnsiString): Integer; +begin + Result := StrTrimNul(_s); +end; + function IsStringIn(const _s: string; const _Arr: array of string; out _Idx: Integer): Boolean; var i: Integer; Modified: trunk/ExternalSource/dzlib/u_dzTranslator.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzTranslator.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzTranslator.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -12,6 +12,9 @@ {$ENDIF} {$ENDIF} +// if defined, any code requiring VCL units is omited below, use this for WinAPI only programs +{.$define NoVCL} + interface uses @@ -75,7 +78,8 @@ implementation -{$IFNDEF console} +{$IFNDEF CONSOLE} +{$IFNDEF NoVCL} uses Windows, Controls, @@ -82,7 +86,8 @@ ActnList, Graphics, ExtCtrls; -{$ENDIF console} +{$ENDIF NoVCL} +{$ENDIF CONSOLE} function _(const _s: string): string; begin @@ -390,7 +395,8 @@ {$ENDIF} {$ENDIF} -{$IFNDEF console} +{$IFNDEF CONSOLE} +{$IFNDEF NoVCL} // ignore these VCL properties / classes TP_GlobalIgnoreClassProperty(TAction, 'Category'); TP_GlobalIgnoreClassProperty(TControl, 'ImeName'); @@ -397,7 +403,8 @@ TP_GlobalIgnoreClassProperty(TControl, 'HelpKeyword'); TP_TryGlobalIgnoreClass(TFont); TP_GlobalIgnoreClassProperty(TNotebook, 'Pages'); -{$ENDIF console} +{$ENDIF NoVCL} +{$ENDIF CONSOLE} // for more ignores, see u_dzTranslatorDB, u_dzTranslatorADO and other u_dzTranslatorXxx units {$IFDEF DXGETTEXTDEBUG} Modified: trunk/ExternalSource/dzlib/u_dzTypInfo.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzTypInfo.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzTypInfo.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -61,14 +61,17 @@ {$IFDEF SUPPORTS_EXTENDED} function GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Extended): Extended; overload; function GetFloatProperty(_Instance: TObject; const _Name: string): Extended; overload; +function TrySetFloatProperty(_Instance: TObject; const _Name: string; const _Value: Extended): Boolean; overload; {$ELSE} function GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Double): Double; overload; function GetFloatProperty(_Instance: TObject; const _Name: string): Double; overload; +function TrySetFloatProperty(_Instance: TObject; const _Name: string; const _Value: Double): Boolean; overload; {$ENDIF SUPPORTS_EXTENDED} function TryGetObjectProperty(_Instance: TObject; const _Name: string; out _Value: TObject): Boolean; function GetObjectProperty(_Instance: TObject; const _Name: string; _Default: TObject): TObject; overload; function GetObjectProperty(_Instance: TObject; const _Name: string): TObject; overload; +function TrySetObjectProperty(_Instance: TObject; const _Name: string; _Value: TObject): Boolean; function TryGetEventProperty(_Instance: TObject; const _Name: string; out _Value: TMethod): Boolean; function GetEventProperty(_Instance: TObject; const _Name: string; _Default: TMethod): TMethod; overload; @@ -156,6 +159,17 @@ if not TryGetFloatProperty(_Instance, _Name, Result) then raise EPropertyError.CreateFmt(_('Float property %s not found.'), [_Name]); end; + +function TrySetFloatProperty(_Instance: TObject; const _Name: string; const _Value: Extended): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind in FLOAT_PROPERTY_TYPES); + if Result then + SetPropValue(_Instance, PropInfo, _Value); +end; + {$ELSE} function GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Double): Double; begin @@ -168,6 +182,16 @@ if not TryGetFloatProperty(_Instance, _Name, Result) then raise EPropertyError.CreateFmt(_('Float property %s not found.'), [_Name]); end; + +function TrySetFloatProperty(_Instance: TObject; const _Name: string; const _Value: Double): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind in FLOAT_PROPERTY_TYPES); + if Result then + SetPropValue(_Instance, PropInfo, _Value); +end; {$ENDIF} function TryGetIntProperty(_Instance: TObject; const _Name: string; out _Value: Integer): Boolean; @@ -245,6 +269,17 @@ raise EPropertyError.CreateFmt(_('Object property %s not found.'), [_Name]); end; +function TrySetObjectProperty(_Instance: TObject; const _Name: string; _Value: TObject): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkClass); + if Result then begin + SetObjectProp(_Instance, PropInfo, _Value); + end; +end; + function TryGetEventProperty(_Instance: TObject; const _Name: string; out _Value: TMethod): Boolean; var PropInfo: PPropInfo; Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzTypes.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -171,6 +171,7 @@ TSingleArray = array of Single; TDoubleArray = array of Double; TExtendedArray = array of Extended; + TExtendedDynArray = TExtendedArray; {$IF not Declared(TBytes)} TBytes = array of Byte; {$IFEND} Modified: trunk/ExternalSource/dzlib/u_dzTypesUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzTypesUtils.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzTypesUtils.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -61,6 +61,14 @@ {$ENDIF} overload; +///<summary> +/// Quicksort for the Array between Lo and Hi </summary> +procedure TSingleDynArray_Sort(var _Arr: TSingleDynArray; _Lo, _Hi: Integer); + +///<summary> +/// Quicksort for the Array between Lo and Hi </summary> +procedure TDoubleDynArray_Sort(var _Arr: TDoubleDynArray; _Lo, _Hi: Integer); + implementation function TRect_Width(const _Rect: TRect): Integer; @@ -113,4 +121,62 @@ and (_Rect.Top <= _y) and (_Rect.Bottom >= _y); end; +procedure TSingleDynArray_Sort(var _Arr: TSingleDynArray; _Lo, _Hi: Integer); +var + Lo, Hi: Integer; + Pivot, t: Single; +begin + Lo := _Lo; + Hi := _Hi; + if Lo > Hi then + Exit; //==> + Pivot := _Arr[(Lo + Hi) div 2]; + repeat + while _Arr[Lo] < Pivot do + Inc(Lo); + while _Arr[Hi] > Pivot do + Dec(Hi); + if Lo <= Hi then begin + t := _Arr[Lo]; + _Arr[Lo] := _Arr[Hi]; + _Arr[Hi] := t; + Inc(Lo); + Dec(Hi); + end; + until Lo > Hi; + if Hi > _Lo then + TSingleDynArray_Sort(_Arr, _Lo, Hi); + if Lo < _Hi then + TSingleDynArray_Sort(_Arr, Lo, _Hi); +end; + +procedure TDoubleDynArray_Sort(var _Arr: TDoubleDynArray; _Lo, _Hi: Integer); +var + Lo, Hi: Integer; + Pivot, t: Single; +begin + Lo := _Lo; + Hi := _Hi; + if Lo > Hi then + Exit; //==> + Pivot := _Arr[(Lo + Hi) div 2]; + repeat + while _Arr[Lo] < Pivot do + Inc(Lo); + while _Arr[Hi] > Pivot do + Dec(Hi); + if Lo <= Hi then begin + t := _Arr[Lo]; + _Arr[Lo] := _Arr[Hi]; + _Arr[Hi] := t; + Inc(Lo); + Dec(Hi); + end; + until Lo > Hi; + if Hi > _Lo then + TDoubleDynArray_Sort(_Arr, _Lo, Hi); + if Lo < _Hi then + TDoubleDynArray_Sort(_Arr, Lo, _Hi); +end; + end. Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -1030,6 +1030,8 @@ /// @param IncludeDisabled determines whether the disabled items should also be returned if they are checked /// @returns the number of Items in Checked </summary> function TCheckListBox_GetChecked(_clb: TCheckListBox; _Checked: TStrings = nil; _IncludeDisabled: Boolean = False): Integer; overload; +/// todo: Why did I ever think it a good idea to return a string? A TStringArray would have been +/// a much better choice. function TCheckListBox_GetChecked(_clb: TCheckListBox; _IncludeDisabled: Boolean = False): string; overload; ///<summary> Returns the objects associated with the checked items /// @param clb is the TCheckListBox Modified: trunk/ExternalSource/dzlib/u_dzVersionInfo.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzVersionInfo.pas 2023-02-15 08:26:12 UTC (rev 3964) +++ trunk/ExternalSource/dzlib/u_dzVersionInfo.pas 2023-02-18 16:03:00 UTC (rev 3965) @@ -185,6 +185,11 @@ u_dzTranslator, u_dzOsUtils; +function _(const _s: string): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + Result := dzlibGetText(_s); +end; + { TCustomFileInfo } constructor TCustomFileInfo.Create; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |