From: <tw...@us...> - 2024-08-10 14:03:35
|
Revision: 4289 http://sourceforge.net/p/gexperts/code/4289 Author: twm Date: 2024-08-10 14:03:32 +0000 (Sat, 10 Aug 2024) Log Message: ----------- updated dzlib to latest version Modified Paths: -------------- trunk/ExternalSource/dzlib/dzlib.inc trunk/ExternalSource/dzlib/u_dzConvertUtils.pas trunk/ExternalSource/dzlib/u_dzFileStreams.pas trunk/ExternalSource/dzlib/u_dzFileUtils.pas trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas trunk/ExternalSource/dzlib/u_dzNullableTimespan.pas trunk/ExternalSource/dzlib/u_dzTypInfo.pas trunk/ExternalSource/dzlib/u_dzTypes.pas trunk/ExternalSource/dzlib/u_dzVclUtils.pas Added Paths: ----------- trunk/ExternalSource/dzlib/u_dzTypeInfoUtils.pas Modified: trunk/ExternalSource/dzlib/dzlib.inc =================================================================== --- trunk/ExternalSource/dzlib/dzlib.inc 2024-07-08 15:51:56 UTC (rev 4288) +++ trunk/ExternalSource/dzlib/dzlib.inc 2024-08-10 14:03:32 UTC (rev 4289) @@ -25,6 +25,7 @@ {$DEFINE SUPPORTS_DEPRECATED_TYPES} {$DEFINE HAS_UNIT_WIDESTRINGS} {$DEFINE OPENDIALOG_EXCUTE_HAS_HANDLE} + {$DEFINE ENUM_NAMES_ARE_UTF8} {$ENDIF} {$IFDEF DELPHI2006_UP} @@ -55,6 +56,7 @@ // THandleStream.FHandle is declared as THandle (before that it's an Integer) {$DEFINE THANDLESTREAM_HANDLE_IS_THANDLE} {$DEFINE HAS_TOBJECT_TOSTRING} + {$DEFINE HAS_UTF8TOWIDESTRING} {$ENDIF} {$IFDEF DELPHI2010_UP} Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2024-07-08 15:51:56 UTC (rev 4288) +++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2024-08-10 14:03:32 UTC (rev 4289) @@ -47,7 +47,8 @@ TBaseN = 2..36; const - MaxLongWord = $FFFFFFFF; + MaxLongWord = $FFFFFFFF deprecated; // use u_dzTypes MaxUInt32 + MaxInt64 = $7FFFFFFFFFFFFFFF deprecated; // use u_dzTypes MaxInt64 const /// <summary> @@ -254,6 +255,11 @@ /// @raises EStringConvertError if s can not be converted </summary> function Str2Int64(const _s: string; const _Source: string): Int64; overload; +function TryStr2Int64(const _s: string; var _Value: Int64): Boolean; overload; +{$IFDEF SUPPORTS_UNICODE} +function TryStr2Int64(const _s: AnsiString; var _Value: Int64): Boolean; overload; +{$ENDIF SUPPORTS_UNICODE} + ///<summary> /// tries to guess the decimal separator </summary> function GuessDecimalSeparator(const _s: string): Char; @@ -1177,6 +1183,24 @@ end; {$ENDIF SUPPORTS_UNICODE} +function TryStr2Int64(const _s: string; var _Value: Int64): Boolean; overload; +var + e: Integer; + v: Integer; +begin + Val(_s, v, e); + Result := (e = 0); + if Result then + _Value := v; +end; + +{$IFDEF SUPPORTS_UNICODE} +function TryStr2Int64(const _s: AnsiString; var _Value: Int64): Boolean; overload; +begin + Result := TryStr2Int64(string(_s), _Value); +end; +{$ENDIF SUPPORTS_UNICODE} + function Str2Int64(const _s: string; _Default: Int64): Int64; var e: Integer; Modified: trunk/ExternalSource/dzlib/u_dzFileStreams.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2024-07-08 15:51:56 UTC (rev 4288) +++ trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2024-08-10 14:03:32 UTC (rev 4289) @@ -126,6 +126,13 @@ /// * CreateDisposition := fcCreateTruncateIfExists; /// raises an exception on error </summary> procedure OpenCreateWriteNoSharing; + ///<summary> + /// Opens a new file for writing only (or truncates an existing file): + /// * AccessMode := [faWrite]; + /// * ShareMode := fsShareRead; + /// * CreateDisposition := fcCreateTruncateIfExists; + /// raises an exception on error </summary> + procedure OpenCreateWriteShareRead; ///<summary> Opens the file and seeks to the end. Returns the new position (that is: The file length). </summary> function Append: LongInt; ///<summary> @@ -346,6 +353,14 @@ Open; end; +procedure TdzFile.OpenCreateWriteShareRead; +begin + CreateDisposition := fcCreateTruncateIfExists; + ShareMode := [fsRead]; + AccessMode := [faWrite]; + Open; +end; + procedure TdzFile.Open; var LastError: Cardinal; Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2024-07-08 15:51:56 UTC (rev 4288) +++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2024-08-10 14:03:32 UTC (rev 4289) @@ -935,7 +935,7 @@ /// Uses kernel32.GetFullPathName and then compares the result using SameText. /// Note that this does not handle all possible cases, e.g. two files with totally different /// names could be the same due to hard links, soft links or multiple UNC paths pointing to - // the same directory. </summary> + /// the same directory. </summary> class function IsSameFilename(const _fn1, _fn2: string): Boolean; ///<summary> Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2024-07-08 15:51:56 UTC (rev 4288) +++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2024-08-10 14:03:32 UTC (rev 4289) @@ -772,6 +772,7 @@ pngimage, // support for TImage.LoadGraphics for PNG files {$ENDIF} GraphUtil, + u_dzTypeInfoUtils, u_dzFileUtils; function _(const _s: string): string; @@ -1708,8 +1709,8 @@ Assert(Assigned(_bmp), 'bitmap is not assigned'); Result := (_bmp.PixelFormat = _Expected); if not Result then begin - ActualName := GetEnumName(TypeInfo(TPixelFormat), Ord(_bmp.PixelFormat)); - ExpectedName := GetEnumName(TypeInfo(TPixelFormat), Ord(_Expected)); + ActualName := SafeGetEnumName(TypeInfo(TPixelFormat), Ord(_bmp.PixelFormat)); + ExpectedName := SafeGetEnumName(TypeInfo(TPixelFormat), Ord(_Expected)); Assert(False, 'unexpected PixelFormat ' + ActualName + ' (expected ' + ExpectedName + ')'); end; end; Modified: trunk/ExternalSource/dzlib/u_dzNullableTimespan.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzNullableTimespan.pas 2024-07-08 15:51:56 UTC (rev 4288) +++ trunk/ExternalSource/dzlib/u_dzNullableTimespan.pas 2024-08-10 14:03:32 UTC (rev 4289) @@ -142,6 +142,7 @@ class operator Multiply(_a: TNullableTimespan; _b: Extended): TNullableTimespan; class function Zero: TNullableTimespan; static; + class function OneDay: TNullableTimespan; static; class function FromDays(_Days: Double): TNullableTimespan; static; class function FromHours(_Hours: Extended): TNullableTimespan; overload; static; class function FromHours(_Hours: TNullableExtended): TNullableTimespan; overload; static; @@ -640,6 +641,11 @@ Result.AssignZero; end; +class function TNullableTimespan.OneDay: TNullableTimespan; +begin + Result.AssignDays(1); +end; + class operator TNullableTimespan.GreaterThanOrEqual(_a, _b: TNullableTimespan): Boolean; begin Result := not (_a < _b); Modified: trunk/ExternalSource/dzlib/u_dzTypInfo.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzTypInfo.pas 2024-07-08 15:51:56 UTC (rev 4288) +++ trunk/ExternalSource/dzlib/u_dzTypInfo.pas 2024-08-10 14:03:32 UTC (rev 4289) @@ -16,7 +16,7 @@ TypInfo, u_dzTranslator; - // I am not going to proved support for Variant properties here. I hate Variants. +// I am not going to provide support for Variant properties here. I hate Variants. const ///<summary> property types that can be converted to string </summary> @@ -88,6 +88,9 @@ {$IFDEF DELPHI2007_UP} +uses + u_dzTypes; + function _(const _s: string): string; inline; begin Result := dzlibGetText(_s); @@ -353,3 +356,4 @@ {$ENDIF DELPHI2007_UP} end. + Added: trunk/ExternalSource/dzlib/u_dzTypeInfoUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzTypeInfoUtils.pas (rev 0) +++ trunk/ExternalSource/dzlib/u_dzTypeInfoUtils.pas 2024-08-10 14:03:32 UTC (rev 4289) @@ -0,0 +1,92 @@ +unit u_dzTypeInfoUtils; + +{$INCLUDE 'dzlib.inc'} + +interface + +uses + SysUtils, + TypInfo; + +function SafeGetEnumName(TypeInfo: PTypeInfo; Value: Integer): string; + +implementation + +uses + u_dzTypes; + +function SafeGetEnumName(TypeInfo: PTypeInfo; Value: Integer): string; + + procedure IncPtr(var _p: Pointer); + begin + _p := Pointer(Intptr(_p) + 1); + end; + + // P must point to the length field (that is the first byte) of a ShortString + function AfterShortString(const P: Pointer): Pointer; + begin + Result := Pointer(Intptr(P) + PByte(P)^ + 1); + end; + +{$IFDEF ENUM_NAMES_ARE_UTF8} + +{$IFNDEF HAS_UTF8TOWIDESTRING} + function UTF8ToWideString(const _Utf8: RawByteString): WideString; + begin + Result := UTF8Decode(_Utf8); + end; +{$ENDIF} + +// Older Unicode Delphi versions did not have a UTF8ToString overload for a pointer parameter +{$IFNDEF DELPHIX_ATHENS_UP} + function _UTF8ToString(P: Pointer): WideString; + var + Len: Byte; + Buf: UTF8String; + begin + Result := ''; + Len := PByte(P)^; + if Len <> 0 then begin + SetLength(Buf, Len); + IncPtr(P); + Move(PByte(P)^, Buf[1], Len); + Result := UTF8ToWideString(Buf); + end; + end; +{$ENDIF} +{$ENDIF} + +var + P: Pointer; + T: PTypeData; +begin + if TypeInfo^.Kind = tkInteger then begin + Result := IntToStr(Value); + Exit; + end; + T := GetTypeData(GetTypeData(TypeInfo)^.BaseType^); + if (TypeInfo = System.TypeInfo(Boolean)) or (T^.MinValue < 0) then begin + { LongBool/WordBool/ByteBool have MinValue < 0 and arbitrary + content in Value; Boolean has Value in [0, 1] } + Result := BooleanIdents[Value <> 0]; + if SameText(HexDisplayPrefix, '0x') then + Result := LowerCase(Result); + end else begin + if (Value < T.MinValue) or (Value > T.MaxValue) then + Result := Format('OutOfBounds(%d)', [Value]) + else begin + P := @T^.NameList; + while Value <> 0 do begin + P := AfterShortString(P); + Dec(Value); + end; +{$IFDEF ENUM_NAMES_ARE_UTF8} + Result := _UTF8ToString(P); +{$ELSE} + Result := PShortString(P)^; +{$ENDIF} + end; + end; +end; + +end. Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzTypes.pas 2024-07-08 15:51:56 UTC (rev 4288) +++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2024-08-10 14:03:32 UTC (rev 4289) @@ -169,16 +169,59 @@ {$IFEND} TStringArray = TStringDynArray; TRawByteStringArray = array of RawByteString; - TIntegerArray = array of Integer; - PIntegerArray = ^TIntegerArray; - TSingleArray = array of Single; - PSingleArray = ^TSingleArray; - TDoubleArray = array of Double; - PDoubleArray = ^TDoubleArray; - TExtendedArray = array of Extended; - PExtendedArray = ^TExtendedArray; - TExtendedDynArray = TExtendedArray; + +{$IF not declared(TInt32DynArray)} + TInt32DynArray = array of Int32; +{$IFEND} +{$IF not declared(PInt32DynArray)} + PInt32DynArray = ^TInt32DynArray; +{$IFEND} +{$IF not declared(TIntegerDynArray)} + TIntegerDynArray = TInt32DynArray + {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated {$ENDIF}; // use TInt32DynArray instead +{$IFEND} +{$IF not declared(PIntegerDynArray)} + PIntegerDynArray = PInt32DynArray + {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated {$ENDIF}; // use PInt32DynArray instead +{$IFEND} + TIntegerArray = TInt32DynArray + {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated {$ENDIF}; // use TInt32DynArray or TIntegerDynArray instead + PIntegerArray = PInt32DynArray + {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated {$ENDIF}; // use PInt32DynArray or PIntegerDynArray instead + +{$IF not declared(TSingleDynArray)} + TSingleDynArray = array of Single; +{$IFEND} +{$IF not declared(PSingleDynArray)} + PSingleDynArray = ^TSingleDynArray; +{$IFEND} + TSingleArray = TSingleDynArray + {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated {$ENDIF}; // use TSingleDynArray instead + PSingleArray = PSingleDynArray + {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated {$ENDIF}; // use PSingleDynArray instead + +{$IF not declared(TDoubleDynArray)} + TDoubleDynArray = array of Double; +{$IFEND} +{$IF not declared(PDoubleDynArray)} + PDoubleDynArray = ^TDoubleDynArray; +{$IFEND} + TDoubleArray = TDoubleDynArray + {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated {$ENDIF}; // use TDoubleDynArray instead + PDoubleArray = PDoubleDynArray + {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated {$ENDIF}; // use PDoubleDynArray instead + +{$IF not declared(TExtendedDynArray)} + TExtendedDynArray = array of Extended; +{$IFEND} +{$IF not declared(PExtendedDynArray)} PExtendedDynArray = ^TExtendedDynArray; +{$IFEND} + TExtendedArray = TExtendedDynArray + {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated {$ENDIF}; // use TExtendedDynArray instead + PExtendedArray = PExtendedDynArray + {$IFDEF SUPPORTS_DEPRECATED_TYPES} deprecated {$ENDIF}; // use PExtendedDynArray instead + {$IF not Declared(TBytes)} TBytes = array of Byte; {$IFEND} Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2024-07-08 15:51:56 UTC (rev 4288) +++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2024-08-10 14:03:32 UTC (rev 4289) @@ -1163,6 +1163,20 @@ function TRadioGroup_GetSelectedObject(_rg: TCustomRadioGroup; out _Obj: Pointer): Boolean; overload; function TRadioGroup_GetSelectedObject(_rg: TCustomRadioGroup; out _ObjAsInt: Integer): Boolean; overload; +///<summary> +/// If Highlighted is True, highlights the RadioGroup's Idx'th button, otherwise it un-highlights it, +/// Highlighting the button means setting its Font.Color to the given Color, and un-higlighting +/// means to set its ParentFont property to True </summary> +procedure TRadioGroup_HighlightButton(_rg: TRadioGroup; _Idx: Integer; _Highlighted: Boolean; + _Color: TColor = clRed); + +///<summary> +/// Highlights the currently selected button of the ReadioGroup if it is not the given DefaultIdx. +/// Highlighting the button means setting its Font.Color to the given Color, and un-higlighting +/// means to set its ParentFont property to True </summary> +procedure TRadioGroup_HighlightIfNotDefault(_rg: TRadioGroup; _DefaultIdx: Integer; + _Color: TColor = clRed); + ///<summary> Writes a TPicture object to a String. The Format is /// <pictureformat>#26<picturedata> </summary> function TPicture_WriteToString(_Pic: TPicture): string; @@ -1635,6 +1649,34 @@ ///<summary> Sets the Caption value of a TCheckbox or TRadioButton (which both descend from TButtonControl) </summary> procedure TButtonControl_SetCaption(_bctrl: TButtonControl; const _Value: string); +///<summary> +/// If Highlight is True, hightlightes the button, ohterweise un-highlights it. +/// Highlighting the button means setting its Font.Color to the given Color, and un-higlighting +/// means to set its ParentFont property to True </summary> +procedure TButtonControl_Highlight(_bctrl: TButtonControl; _Highlighted: Boolean; _Color: TColor = clRed); + +///<summary> +/// Highlights the button if its Checked property does not have the default value. +/// Otherwise un-highlights it. +/// Highlighting the button means setting its Font.Color to the given Color, and un-higlighting +/// means to set its ParentFont property to True </summary> +procedure TButtonControl_HighlightIfNotDefault(_bctrl: TButtonControl; _Default: Boolean; + _Color: TColor = clRed); + +///<summary> +/// Highlights the button if is checked. +/// Otherwise un-highlights it. +/// Highlighting the button means setting its Font.Color to the given Color, and un-higlighting +/// means to set its ParentFont property to True </summary> +procedure TButtonControl_HighlightIfChecked(_bctrl: TButtonControl; _Color: TColor = clRed); + +///<summary> +/// Highlights the button if is no checked. +/// Otherwise un-highlights it. +/// Highlighting the button means setting its Font.Color to the given Color, and un-higlighting +/// means to set its ParentFont property to True </summary> +procedure TButtonControl_HighlightIfNotChecked(_bctrl: TButtonControl; _Color: TColor = clRed); + {$IFNDEF DELPHI2009_UP} //Delphi 2009 introduced TCustomButton as the common Ancestor of TButton and TBitBtn. type @@ -4322,6 +4364,27 @@ _ObjAsInt := Integer(Obj); //FI:W541 Casting from Integer to Pointer type (or vice versa) end; +procedure TRadioGroup_HighlightButton(_rg: TRadioGroup; _Idx: Integer; _Highlighted: Boolean; + _Color: TColor = clRed); +begin + if (_Idx < 0) or (_Idx >= _rg.Items.Count) then + Exit; //==> + + TButtonControl_Highlight(TRadioGroup_GetButton(_rg, _Idx), _Highlighted, _Color); +end; + +procedure TRadioGroup_HighlightIfNotDefault(_rg: TRadioGroup; _DefaultIdx: Integer; + _Color: TColor = clRed); +var + Idx: Integer; + i: Integer; +begin + Idx := _rg.ItemIndex; + for i := 0 to _rg.Items.Count - 1 do begin + TRadioGroup_HighlightButton(_rg, i, (i = Idx) and not (i = _DefaultIdx)); + end; +end; + function TRichEdit_WriteToString(_Re: TRichEdit): string; var st: TMemoryStream; @@ -5708,6 +5771,43 @@ THackButtonControl(_bctrl).Caption := _Value; end; +procedure TButtonControl_Highlight(_bctrl: TButtonControl; _Highlighted: Boolean; _Color: TColor = clRed); +var + bctrl: TButtonControlHack absolute _bctrl; +begin + if not Assigned(bctrl) then + Exit; //==> + + if _Highlighted then + bctrl.Font.Color := _Color + else + bctrl.ParentFont := True; +end; + +procedure TButtonControl_HighlightIfNotDefault(_bctrl: TButtonControl; _Default: Boolean; + _Color: TColor = clRed); +var + bctrl: TButtonControlHack absolute _bctrl; +begin + if not Assigned(bctrl) then + Exit; //==> + + if bctrl.Checked <> _Default then + bctrl.Font.Color := _Color + else + bctrl.ParentFont := True; +end; + +procedure TButtonControl_HighlightIfChecked(_bctrl: TButtonControl; _Color: TColor = clRed); +begin + TButtonControl_HighlightIfNotDefault(_bctrl, False, _Color); +end; + +procedure TButtonControl_HighlightIfNotChecked(_bctrl: TButtonControl; _Color: TColor = clRed); +begin + TButtonControl_HighlightIfNotDefault(_bctrl, True, _Color); +end; + type TButtonPopupMenuLink = class(TComponent) private This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |