From: <tw...@us...> - 2020-01-01 16:23:28
|
Revision: 3022 http://sourceforge.net/p/gexperts/code/3022 Author: twm Date: 2020-01-01 16:23:25 +0000 (Wed, 01 Jan 2020) Log Message: ----------- * added additional cond. defines to dzlib.inc for features that jedi.inc does not cover * lots of changes to cater for missing features in Delphi 6, 7 and 2005 (e.g. nested types, enhanced records but also TFormatSettings and several string functions, inline, static, for in ...) * in u_dzErrorThread I had to change the implementation of WaitFor because Delphi 6 does not have the SyncEvent variable. Modified Paths: -------------- trunk/ExternalSource/dzlib/dzlib.inc trunk/ExternalSource/dzlib/u_dzConvertUtils.pas trunk/ExternalSource/dzlib/u_dzDateUtils.pas trunk/ExternalSource/dzlib/u_dzErrorThread.pas trunk/ExternalSource/dzlib/u_dzFileStreams.pas trunk/ExternalSource/dzlib/u_dzFileUtils.pas trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas trunk/ExternalSource/dzlib/u_dzLineBuilder.pas trunk/ExternalSource/dzlib/u_dzMapFileReader.pas trunk/ExternalSource/dzlib/u_dzMiscUtils.pas trunk/ExternalSource/dzlib/u_dzNamedThread.pas trunk/ExternalSource/dzlib/u_dzOsUtils.pas trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas trunk/ExternalSource/dzlib/u_dzSortProvider.pas trunk/ExternalSource/dzlib/u_dzSortUtils.pas trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas trunk/ExternalSource/dzlib/u_dzStringUtils.pas trunk/ExternalSource/dzlib/u_dzTranslator.pas trunk/ExternalSource/dzlib/u_dzTypesUtils.pas trunk/ExternalSource/dzlib/u_dzVariantUtils.pas trunk/ExternalSource/dzlib/u_dzVclUtils.pas trunk/ExternalSource/dzlib/u_dzVersionInfo.pas Modified: trunk/ExternalSource/dzlib/dzlib.inc =================================================================== --- trunk/ExternalSource/dzlib/dzlib.inc 2020-01-01 15:33:15 UTC (rev 3021) +++ trunk/ExternalSource/dzlib/dzlib.inc 2020-01-01 16:23:25 UTC (rev 3022) @@ -1,5 +1,15 @@ {$INCLUDE 'dzlibjedi.inc'} +{$IFDEF DELPHI7_UP} +// TBitBtn.WordWrap was introduced in Delphi 7 +{$DEFINE HAS_BITBTN_WORDWRAP} +{$ENDIF} + +{$IFDEF DELPHI2005_UP} +// Delphi 6 and 7 understood deprecated, but not for types +{$DEFINE SUPPORTS_DEPRECATED_TYPES} +{$ENDIF} + {$IFDEF DELPHIX_TOKYO_UP} {$DEFINE FILECTRL_DIRECTORYEXISTS_IS_DEPRECATED} {$ENDIF} Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-01-01 15:33:15 UTC (rev 3021) +++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-01-01 16:23:25 UTC (rev 3022) @@ -14,11 +14,14 @@ u_dzTypes, u_dzTranslator; +{$IF Declared(TFormatSettings)} +// Delphi 6 does not have that type var ///<summary> /// contains the User's format setting, but with decimal separator = '.' and no thousands /// separator </summary> DZ_FORMAT_DECIMAL_POINT: TFormatSettings; +{$IFEND} type ///<summary> @@ -221,7 +224,9 @@ /// @param flt is the float, only valid if the function returns true /// @param DecSeparator is the decimal separator to use, defaults to '.', /// if passed as #0, GuessDecimalSeparator is called to guess it -/// @returns true, if s could be converted, false otherwise </summary> +/// @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} @@ -231,7 +236,9 @@ /// @param flt is the float, only valid if the function returns true /// @param DecSeparator is the decimal separator to use, defaults to '.', /// if passed as #0, GuessDecimalSeparator is called to guess it -/// @returns true, if s could be converted, false otherwise </summary> +/// @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> function TryStr2Float(const _s: string; out _flt: Double; _DecSeparator: Char = '.'): Boolean; overload; function TryStr2Float(const _s: string; out _flt: Single; _DecSeparator: Char = '.'): Boolean; overload; @@ -304,6 +311,7 @@ /// @note that the value will get rounded to full seconds. </summary> function SecondsToHumanReadableString(const _Seconds: Extended): string; overload; +{$IF Declared(TFormatSettings)} ///<summary> /// returns the default locale settings as read from the user's regional settings </summary> function GetUserDefaultLocaleSettings: TFormatSettings; deprecated; // use u_dzStringUtils.GetUserDefaultLocaleSettings instead @@ -310,6 +318,7 @@ ///<summary> /// returns the default locale settings as read from the system's regional settings </summary> function GetSystemDefaultLocaleSettings: TFormatSettings; deprecated; // use u_dzStringUtils.GetSystemDefaultLocaleSettings instead +{$IFEND} ///<summary> /// returns the long word split into an array of byte @@ -330,7 +339,7 @@ /// aka converts intel (little endian) to motorola (big endian) byte order format /// (This is just an alias for system.swap for consistency with Swap32.) ///</summary -function Swap16(_Value: Word): Word; inline; +function Swap16(_Value: Word): Word; ///<summary> /// returns a 32 bit value in reversed byte order e.g. $12345678 -> $78563412 @@ -340,6 +349,7 @@ function BitReverse32(v: LongWord): LongWord; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} type TBoolToStr = record private @@ -362,6 +372,7 @@ class function Create(const _TrueStr, _FalseStr: string): TBoolToStr; static; function ToString(_b: Boolean): string; end; +{$ENDIF} ///<summary> Uses 'True' and 'False' (no translation) </summary> function Bool2Str(_b: Boolean): string; @@ -369,6 +380,7 @@ type TBitNumber32 = 0..31; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} type ///<summary> /// Stores up to 32 bits similar to the Delphi TBits class but @@ -390,9 +402,11 @@ function Value: LongWord; function AsString: string; end; +{$ENDIF} type TBitNumber8 = 0..8; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} type ///<summary> /// Stores up to 8 bits similar to the Delphi TBits class but @@ -422,7 +436,7 @@ // There is no BitwiseNot operator, but the LogicalNot also works class operator LogicalNot(_a: TBits8): TBits8; end; - +{$ENDIF} { TODO -otwm : Create a generic TdzBits record that stores the value in a dynamically allocated byte array. Since this array is automatically initialized/finalized, it can still be a record rather than a class. } @@ -447,7 +461,10 @@ StrUtils, u_dzStringUtils; -function _(const _s: string): string; inline; +function _(const _s: string): string; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzDGetText(_s, 'dzlib'); end; @@ -704,18 +721,19 @@ function Float2Str(_flt: Extended; _DecSeparator: Char = '.'): string; var - FormatSettings: TFormatSettings; + s: AnsiString; begin + Str(_flt, s); + Result := string(s); if _DecSeparator = #0 then _DecSeparator := DecimalSeparator; - FormatSettings := DZ_FORMAT_DECIMAL_POINT; - FormatSettings.DecimalSeparator := _DecSeparator; - Result := SysUtils.FloatToStr(_flt, FormatSettings); + if _DecSeparator <> '.' then + Result := ReplaceStr(Result, '.', _DecSeparator); end; function Float2Str(_flt: Extended; _Width, _Decimals: Integer; _DecSeparator: Char): string; var - s: ShortString; + s: AnsiString; begin Str(_flt: _Width: _Decimals, s); Result := string(s); @@ -818,13 +836,27 @@ function TryStr2Float(const _s: string; out _flt: Extended; _DecSeparator: Char = '.'): Boolean; var +{$IF Declared(TFormatSettings)} FmtSettings: TFormatSettings; +{$ELSE} + SysDecimalSeparator: Char; +{$IFEND} begin if _DecSeparator = #0 then _DecSeparator := GuessDecimalSeparator(_s); +{$IF Declared(TFormatSettings)} FmtSettings := DZ_FORMAT_DECIMAL_POINT; FmtSettings.DecimalSeparator := _DecSeparator; Result := TextToFloat(PChar(_s), _flt, fvExtended, FmtSettings); +{$ELSE} + SysDecimalSeparator := DecimalSeparator; + try + SysUtils.DecimalSeparator := _DecSeparator; + Result := TextToFloat(PChar(_s), _flt, fvExtended); + finally + SysUtils.DecimalSeparator := SysDecimalSeparator; + end; +{$IFEND} end; {$ENDIF} @@ -897,6 +929,7 @@ Result := SecondsToHumanReadableString(Round(_Seconds)); end; +{$IF Declared(TFormatSettings)} function GetSystemDefaultLocaleSettings: TFormatSettings; begin Result := u_dzStringUtils.GetSystemDefaultLocaleSettings; @@ -906,6 +939,7 @@ begin Result := u_dzStringUtils.GetUserDefaultLocaleSettings; end; +{$IFEND} function LongWord2ByteArr(_Value: LongWord; _MsbFirst: Boolean = False): TBytes; begin @@ -934,7 +968,10 @@ end; end; -function Swap16(_Value: Word): Word; inline; +function Swap16(_Value: Word): Word; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := swap(_Value); end; @@ -970,6 +1007,7 @@ Result := (v shr 16) or (v shl 16); end; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} { TBits32 } function TBits32.AsString: string; @@ -1096,6 +1134,7 @@ begin Result := FValue; end; +{$ENDIF} function Bool2Str(_b: Boolean): string; begin @@ -1105,6 +1144,7 @@ Result := 'False'; // do not translate end; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} { TBoolToStr } class function TBoolToStr.Create(const _TrueStr, _FalseStr: string): TBoolToStr; @@ -1137,9 +1177,11 @@ begin Result := Create('Y', 'N'); end; +{$ENDIF} function GetLocalizedOneLetterYesStr: string; begin + // todo: This should really use PGetText, e.g. PGetText('Yes/No one letter', 'Y') // Translator: Convert to the equivalent of 'Y' (only one letter) Result := _('Y(es)'); // if it wasn't translated we use English 'Y' @@ -1149,6 +1191,7 @@ function GetLocalizedOneLetterNoStr: string; begin + // todo: This should really use PGetText, e.g. PGetText('Yes/No one letter', 'N') // Translator: Convert to the equivalent of 'N' (only one letter) Result := _('N(o)'); // if it wasn't translated we use English 'N' @@ -1156,6 +1199,7 @@ Result := 'N'; end; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} class function TBoolToStr.CreateYNLocalized: TBoolToStr; begin Result := Create(GetLocalizedOneLetterYesStr, GetLocalizedOneLetterNoStr); @@ -1165,6 +1209,7 @@ begin Result := FBoolStrings[_b]; end; +{$ENDIF} function AssertYNStringLength: Boolean; var @@ -1194,9 +1239,11 @@ end; initialization +{$IF Declared(TFormatSettings)} DZ_FORMAT_DECIMAL_POINT := u_dzStringUtils.GetUserDefaultLocaleSettings; DZ_FORMAT_DECIMAL_POINT.DecimalSeparator := '.'; DZ_FORMAT_DECIMAL_POINT.ThousandSeparator := #0; +{$IFEND} Assert(AssertYNStringLength); Assert(AssertSwap32); Modified: trunk/ExternalSource/dzlib/u_dzDateUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzDateUtils.pas 2020-01-01 15:33:15 UTC (rev 3021) +++ trunk/ExternalSource/dzlib/u_dzDateUtils.pas 2020-01-01 16:23:25 UTC (rev 3022) @@ -1,7 +1,11 @@ {.GXFormatter.config=twm} -/// <summary> implements some utility functions for converting TDateTime to and from strings -/// in ISO 6801 format (note that these functions do not implement the complete -/// standard but only the extended form without omitting date parts). </summary> +///<summary> +/// Implements some utility functions for converting TDateTime to and from strings +/// in ISO 6801 format (note that these functions do not implement the complete +/// standard but only the extended form without omitting date parts). +/// NOTE: Many of these function rely on passing a TFormatSettings parameter to RTL +/// functions. Since TFormatSettings is not available in Delphi 6 these functions +/// are also not available. </summary> unit u_dzDateUtils; {$I dzlibjedi.inc} @@ -48,9 +52,10 @@ /// @returns a string with the date (and optionally the time) in the format /// 'yyyy-mm-dd hh:mm:ss' /// </summary> -function DateTime2Iso(_dt: TDateTime; _IncludeTime: Boolean = False): string; inline; -function Date2Iso(_Date: TDateTime): string; inline; +function DateTime2Iso(_dt: TDateTime; _IncludeTime: Boolean = False): string; +function Date2Iso(_Date: TDateTime): string; +{$IF Declared(TFormatSettings)} /// <summary> /// Converts the time part of a TDateTime value to a string in ISO 8601 format /// @param dt is the TDateTime value to convert @@ -63,7 +68,10 @@ /// 'hh:mm:ss.nnn' /// </summary> function Time2Iso(_dt: TDateTime; _IncludeSeconds: Boolean = True; - _IncludeMilliSeconds: Boolean = False; _Separator: Char = #0): string; inline; + _IncludeMilliSeconds: Boolean = False; _Separator: Char = #0): string; +{$IFEND} + +{$IF Declared(TFormatSettings)} /// <summary> /// converts a string that contains a time in ISO 8601 format to a TDateTime value /// @param s is the string to convert, it must be in the form 'hh:mm:ss' or 'hh:mm' @@ -72,7 +80,11 @@ /// Time2Iso, e.g. 00:00:00.999. /// </summary> function Iso2Time(const _s: string): TDateTime; +{$IFEND} + +{$IF Declared(TFormatSettings)} function TryIso2Time(const _s: string; out _Time: TDateTime): Boolean; +{$IFEND} ///<summary> /// Assumes the format hhhh<separator>mm where separator can be #0 meaning no separator @@ -82,6 +94,7 @@ /// TryHHmm2Hours('234h', 'h') and TryHHmm2Hours('234h00', 'h') are both valid. </summary> function TryHHmm2Hours(const _s: string; out _Hours: Extended; const _Separator: Char = #0): Boolean; +{$IF Declared(TFormatSettings)} /// <summary> /// converts a string that contains a date in ISO 8601 format to a TDateTime value /// @param s is the string to convert, it must be in the form 'yyyy-mm-dd' or 'yyyymmdd', it must @@ -90,7 +103,9 @@ /// </summary> function Iso2Date(const _s: string): TDateTime; function TryIso2Date(const _s: string; out _Date: TDateTime): Boolean; +{$IFEND} +{$IF Declared(TFormatSettings)} /// <summary> /// converts a string that contains a date and time in ISO 8601 format to a TDateTime value /// @param s is the string to convert, it must be in the form 'yyyy-mm-dd hh:mm[:ss]' @@ -98,7 +113,9 @@ /// </summary> function Iso2DateTime(const _s: string): TDateTime; function TryIso2DateTime(const _s: string; out _DateTime: TDateTime): Boolean; +{$IFEND} +{$IF Declared(TFormatSettings)} ///<summary> /// Tries to convert a date/time string to a TDateTime value. /// Date/time formats are tried in the following order: @@ -109,17 +126,23 @@ /// (I had to decide between the sane UK format or the brain dead US format, i chose the UK format.) /// </summary> function TryStr2DateTime(const _s: string; out _DateTime: TDateTime): Boolean; +{$IFEND} +{$IF Declared(TFormatSettings)} ///<summary> /// Tries to convert a string that contains the date and time in /// German format (dd.mm.yyyy hh:mm:ss.zzz) to a TDateTimeValue /// @returns true, if the function succeeded, false if not </summary> function Tryddmmyyyyhhmmss2DateTime(const _s: string; out _DateTime: TDateTime): Boolean; +{$IFEND} function Date2ddmmyyyy(_Date: TDateTime): string; +{$IF Declared(TFormatSettings)} function ddmmyyyy2Date(const _s: string): TDateTime; function Tryddmmyyyy2Date(const _s: string; out _Date: TDateTime): Boolean; +{$IFEND} +{$IF Declared(TFormatSettings)} ///<summary> /// Tries to to convert a string to a date. Date formats are tried in the following order: /// * format configured in Windows @@ -130,6 +153,7 @@ /// </summary> function TryStr2Date(const _s: string; out _dt: TDateTime): Boolean; function Str2Date(const _s: string): TDateTime; +{$IFEND} implementation @@ -139,7 +163,10 @@ DateUtils, u_dzStringUtils; -function _(const _s: string): string; inline; +function _(const _s: string): string; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzDGetText(_s, 'dzlib'); end; @@ -191,6 +218,9 @@ end; function DateTime2Iso(_dt: TDateTime; _IncludeTime: Boolean = False): string; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin if _IncludeTime then DateTimeToString(Result, 'yyyy-mm-dd hh:nn:ss', _dt) // do not translate @@ -198,7 +228,10 @@ DateTimeToString(Result, 'yyyy-mm-dd', _dt); // do not translate end; -function Date2Iso(_Date: TDateTime): string; inline; +function Date2Iso(_Date: TDateTime): string; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := DateTime2Iso(_Date, False); end; @@ -208,6 +241,8 @@ DateTimeToString(Result, 'dd.mm.yyyy', _Date); // do not translate end; +{$IF Declared(TFormatSettings)} + function Tryddmmyyyy2Date(const _s: string; out _Date: TDateTime): Boolean; var Settings: TFormatSettings; @@ -217,7 +252,10 @@ Settings.ShortDateFormat := 'dd.mm.yyyy'; // do not translate Result := TryStrToDate(_s, _Date, Settings); end; +{$IFEND} +{$IF Declared(TFormatSettings)} + function ddmmyyyy2Date(const _s: string): TDateTime; var Settings: TFormatSettings; @@ -227,9 +265,15 @@ Settings.ShortDateFormat := 'dd.mm.yyyy'; // do not translate Result := StrToDate(_s, Settings); end; +{$IFEND} +{$IF Declared(TFormatSettings)} + function Time2Iso(_dt: TDateTime; _IncludeSeconds: Boolean = True; - _IncludeMilliSeconds: Boolean = False; _Separator: Char = #0): string; inline; + _IncludeMilliSeconds: Boolean = False; _Separator: Char = #0): string; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} var fmt: string; Settings: TFormatSettings; @@ -245,6 +289,7 @@ end; DateTimeToString(Result, fmt, _dt, Settings); end; +{$IFEND} function TryHHmm2Hours(const _s: string; out _Hours: Extended; const _Separator: Char = #0): Boolean; var @@ -275,6 +320,8 @@ _Hours := hh + mm / 60; end; +{$IF Declared(TFormatSettings)} + function TryIso2Time(const _s: string; out _Time: TDateTime): Boolean; var Settings: TFormatSettings; @@ -284,7 +331,10 @@ Settings.ShortTimeFormat := 'hh:nn:ss'; // do not translate Result := TryStrToTime(_s, _Time, Settings); end; +{$IFEND} +{$IF Declared(TFormatSettings)} + function Iso2Time(const _s: string): TDateTime; var Settings: TFormatSettings; @@ -294,7 +344,10 @@ Settings.ShortTimeFormat := 'hh:nn:ss'; // do not translate Result := StrToTime(_s, Settings); end; +{$IFEND} +{$IF Declared(TFormatSettings)} + function TryIso2Date(const _s: string; out _Date: TDateTime): Boolean; var Settings: TFormatSettings; @@ -318,13 +371,19 @@ Result := TryEncodeDate(Year, Month, Day, _Date); end; end; +{$IFEND} +{$IF Declared(TFormatSettings)} + function Iso2Date(const _s: string): TDateTime; begin if not TryIso2Date(_s, Result) then raise EConvertError.CreateFmt(_('''%s'' is not a valid date'), [_s]); end; +{$IFEND} +{$IF Declared(TFormatSettings)} + function TryIso2DateTime(const _s: string; out _DateTime: TDateTime): Boolean; var Settings: TFormatSettings; @@ -336,7 +395,10 @@ Settings.ShortTimeFormat := 'hh:nn:ss.zzz'; // do not translate Result := TryStrToDateTime(_s, _DateTime, Settings); end; +{$IFEND} +{$IF Declared(TFormatSettings)} + function Iso2DateTime(const _s: string): TDateTime; var Settings: TFormatSettings; @@ -348,7 +410,10 @@ Settings.ShortTimeFormat := 'hh:nn:ss.zzz'; // do not translate Result := StrToDateTime(_s, Settings); end; +{$IFEND} +{$IF Declared(TFormatSettings)} + function Tryddmmyyyyhhmmss2DateTime(const _s: string; out _DateTime: TDateTime): Boolean; var Settings: TFormatSettings; @@ -360,7 +425,10 @@ Settings.ShortTimeFormat := 'hh:nn:ss.zzz'; // do not translate Result := TryStrToDateTime(_s, _DateTime, Settings); end; +{$IFEND} +{$IF Declared(TFormatSettings)} + function TryStr2DateTime(const _s: string; out _DateTime: TDateTime): Boolean; begin Result := True; @@ -380,7 +448,10 @@ Result := False; end; end; +{$IFEND} +{$IF Declared(TFormatSettings)} + function TryStr2Date(const _s: string; out _dt: TDateTime): Boolean; var UKSettings: TFormatSettings; @@ -402,11 +473,14 @@ Result := False; end; end; +{$IFEND} +{$IF Declared(TFormatSettings)} function Str2Date(const _s: string): TDateTime; begin if not TryStr2Date(_s, Result) then raise EConvertError.CreateFmt(_('''%s'' is not a valid date'), [_s]); end; +{$IFEND} end. Modified: trunk/ExternalSource/dzlib/u_dzErrorThread.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzErrorThread.pas 2020-01-01 15:33:15 UTC (rev 3021) +++ trunk/ExternalSource/dzlib/u_dzErrorThread.pas 2020-01-01 16:23:25 UTC (rev 3022) @@ -20,6 +20,12 @@ FExceptionClass: TClass; FErrorMessage: string; FHasFinished: Boolean; +{$IF not Declared(SyncEvent)} + // In Delphi 6 these are private in TThread so we can't simply access them but must implement + // them ourselves. + procedure CheckThreadError(ErrCode: Integer); overload; + procedure CheckThreadError(Success: Boolean); overload; +{$IFEND} protected ///<summary> /// Calls inherited to set the thread name and then the doExecute method. @@ -35,7 +41,7 @@ /// @param TimeoutMsecs is the desired timeout in milliseconds /// @param ReturnValue is the result of the thread procecedure (the ReturnValue property /// of TThread). Only valid if Result = True. - /// @retursn True, if the thread has terminated, False otherwise. </summary> + /// @returns True, if the thread has terminated, False otherwise. </summary> function WaitFor(_TimeoutMsecs: DWORD; out _ReturnValue: DWORD): Boolean; overload; function WaitFor(_TimeoutMsecs: DWORD): Boolean; overload; ///<summary> @@ -53,8 +59,25 @@ implementation +uses + RTLConsts; + { TErrorThread } +{$IF not Declared(SyncEvent)} +procedure TErrorThread.CheckThreadError(ErrCode: Integer); +begin + if ErrCode <> 0 then + raise EThread.CreateFmt(SThreadError, [SysErrorMessage(ErrCode), ErrCode]); +end; + +procedure TErrorThread.CheckThreadError(Success: Boolean); +begin + if not Success then + CheckThreadError(GetLastError); +end; +{$IFEND} + procedure TErrorThread.doExecute; begin // does nothing @@ -85,6 +108,8 @@ Result := WaitFor(_TimeoutMsecs, Dummy); end; +{$IF Declared(SyncEvent)} + function TErrorThread.WaitFor(_TimeoutMsecs: DWORD; out _ReturnValue: DWORD): Boolean; var H: array[0..1] of THandle; @@ -120,4 +145,43 @@ CheckThreadError(GetExitCodeThread(H[0], _ReturnValue)); end; +{$ELSE} +// Delphi 6 did not have a SyncEvent variable (later versions declare it in Classes) + +function TErrorThread.WaitFor(_TimeoutMsecs: DWORD; out _ReturnValue: DWORD): Boolean; +var + H: THandle; + WaitResult: Cardinal; + Msg: TMsg; +begin + H := Handle; + if GetCurrentThreadID = MainThreadID then begin + WaitResult := 0; + repeat + { This prevents a potential deadlock if the background thread + does a SendMessage to the foreground thread } + if WaitResult = WAIT_OBJECT_0 + 1 then + PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE); + if _TimeoutMsecs = INFINITE then begin + WaitResult := MsgWaitForMultipleObjects(2, H, False, 1000, QS_SENDMESSAGE) + end else begin + WaitResult := MsgWaitForMultipleObjects(1, H, False, _TimeoutMsecs, QS_SENDMESSAGE); + end; + CheckThreadError(WaitResult <> WAIT_FAILED); + if WaitResult = WAIT_OBJECT_0 + 1 then + CheckSynchronize; + Result := (WaitResult = WAIT_OBJECT_0); + until Result or (_TimeoutMsecs <> INFINITE); + end else begin + WaitResult := WaitForSingleObject(H, _TimeoutMsecs); + Result := True; + if WaitResult = WAIT_FAILED then + RaiseLastOSError; + Result := (WaitResult <> WAIT_TIMEOUT); + end; + if Result then + CheckThreadError(GetExitCodeThread(H, _ReturnValue)); +end; +{$IFEND} + end. Modified: trunk/ExternalSource/dzlib/u_dzFileStreams.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2020-01-01 15:33:15 UTC (rev 3021) +++ trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2020-01-01 16:23:25 UTC (rev 3022) @@ -227,7 +227,10 @@ u_dzFileUtils, u_dzMiscUtils; -function _(const _s: string): string; inline; +function _(const _s: string): string; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzDGetText(_s, 'dzlib'); end; Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2020-01-01 15:33:15 UTC (rev 3021) +++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2020-01-01 16:23:25 UTC (rev 3022) @@ -167,23 +167,24 @@ type /// <summary> + /// possible return values for the callback function </summary> + TCopyProgressResult = ( + prContinue, // continue with the copy/move operation + prCancel, // cancel the operation, cannot be resumed + prStop, // stop the operation, can be resumed, if cfwRestartable was passed + prQuiet); // continue the operation, do not call the callback + + /// <summary> + /// reason for calling the callback function </summary> + TCopyProgressReason = ( + prChunkFinished, // a chunk of the file has been copied + prStreamSwitch); // started to copy a new stream (set in the first callback) + +type + /// <summary> /// Represents the status of a CopyFile/MoveFileWithProgress operation, passed /// as parameter to the callback function. </summary> TCopyProgressStatus = class - public - type - /// <summary> - /// possible return values for the callback function </summary> - TProgressResult = ( - prContinue, // continue with the copy/move operation - prCancel, // cancel the operation, cannot be resumed - prStop, // stop the operation, can be resumed, if cfwRestartable was passed - prQuiet); // continue the operation, do not call the callback - /// <summary> - /// reason for calling the callback function </summary> - TProgressReason = ( - prChunkFinished, // a chunk of the file has been copied - prStreamSwitch); // started to copy a new stream (set in the first callback) protected FTotalFileSize: LARGE_INTEGER; FTotalBytesTransferred: LARGE_INTEGER; @@ -190,7 +191,7 @@ FStreamSize: LARGE_INTEGER; FStreamBytesTransferred: LARGE_INTEGER; FStreamNumber: LongWord; - FCallbackReason: TProgressReason; + FCallbackReason: TCopyProgressReason; FSourceFile: THandle; FDestinationFile: THandle; public @@ -211,7 +212,7 @@ property StreamNumber: LongWord read FStreamNumber; /// <summary> /// reason for callback </summary> - property CallbackReason: TProgressReason read FCallbackReason; + property CallbackReason: TCopyProgressReason read FCallbackReason; /// <summary> /// Handle of source file </summary> property SourceFile: THandle read FSourceFile; @@ -226,7 +227,7 @@ /// @param Continue determines whether to continue copying or aborting, defaults /// to prContinue </summary> TCopyFileProgressEvt = procedure(_Status: TCopyProgressStatus; - var _Continue: TCopyProgressStatus.TProgressResult) of object; + var _Continue: TCopyProgressResult) of object; /// <summary> /// defines the action to take if a file already exists but has a different content </summary> @@ -269,7 +270,7 @@ procedure doOnSyncingFile(const _SrcFile, _DstFile: string; _Total, _Done: Int64); function doOnFileExists(const _SrcDir, _DstDir, _Filename: string): TFileExistsAction; function doOnQueryFileSync(const _SrcFile, _DstFile: string): TQueryFileSyncAction; - procedure ProgressStatusCallback(_Status: TCopyProgressStatus; var _Continue: TCopyProgressStatus.TProgressResult); + procedure ProgressStatusCallback(_Status: TCopyProgressStatus; var _Continue: TCopyProgressResult); public /// <summary> /// Checks if there are files in the source directory that are already in @@ -316,40 +317,46 @@ function PathBS: string; end; +type + TCopyFileFlags = (cfFailIfExists, cfForceOverwrite, cfRaiseException); + TCopyFileFlagSet = set of TCopyFileFlags; + TCopyFileFlagIfExists = (cfeFailIfExists, cfeOverwriteIfExists); + TCopyFileFlagOverwriteReadonly = (cforDoNotOverwriteReadonly, cforOverwriteReadonly); + TMoveFileExFlags = (mfCopyAllowed, {mfCreateHardlink,}mfDelayUntilReboot, mfFailIfNotTrackable, + mfReplaceExisting, mfWriteThrough); + TMoveFileExFlagSet = set of TMoveFileExFlags; + TMatchingFileResult = (mfNotFound, mfDirectory, mfFile, mfSpecial); + TCopyFileWithProgressRestartable = (cfwrNotRestartable, cfwrRestartable); + TCopyFileWithProgressFlags = (cfwFailIfExists, cfwRestartable, cfwRaiseException); + TCopyFileWithProgressFlagSet = set of TCopyFileWithProgressFlags; + TCopyFileWithProgressResult = (cfwOK, cfwAborted, cfwError); + TMoveFileWithProgressFlags = ( + mfwFailIfExists, /// < fail if the destination file already exists + mfwAllowCopy, /// < allow using copy and delete if necessary + mfwDelayUntilReboot, /// < wait until next reboot for moving the file + mfwWriteThrough, /// < Setting this value guarantees that a move performed as a copy and delete operation is flushed to disk before the function returns. + mfwFailIfNotTrackable, /// < The function fails if the source file is a link source, but the file cannot be tracked after the move. + mfwRaiseException); /// < raise an exception if there is an error + TMoveFileWithProgressFlagSet = set of TMoveFileWithProgressFlags; + TCopyDirCreateIntermediate = (cdciCreateIntermediate, cdciDoNotCreateIntermediate); + +const /// <summary> + /// set of char constant containing all characters that are invalid in a filename </summary> + INVALID_FILENAME_CHARS: set of AnsiChar = ['\', '/', ':', '*', '?', '"', '<', '>', '|']; + +type + /// <summary> /// This class owns all utility functions as class methods so they don't pollute the name space </summary> TFileSystem = class public - type - TCopyFileFlags = (cfFailIfExists, cfForceOverwrite, cfRaiseException); - TCopyFileFlagSet = set of TCopyFileFlags; - TCopyFileFlagIfExists = (cfeFailIfExists, cfeOverwriteIfExists); - TCopyFileFlagOverwriteReadonly = (cforDoNotOverwriteReadonly, cforOverwriteReadonly); - TMoveFileExFlags = (mfCopyAllowed, {mfCreateHardlink,} mfDelayUntilReboot, mfFailIfNotTrackable, - mfReplaceExisting, mfWriteThrough); - TMoveFileExFlagSet = set of TMoveFileExFlags; - TMatchingFileResult = (mfNotFound, mfDirectory, mfFile, mfSpecial); - TCopyFileWithProgressRestartable = (cfwrNotRestartable, cfwrRestartable); - TCopyFileWithProgressFlags = (cfwFailIfExists, cfwRestartable, cfwRaiseException); - TCopyFileWithProgressFlagSet = set of TCopyFileWithProgressFlags; - TCopyFileWithProgressResult = (cfwOK, cfwAborted, cfwError); - TMoveFileWithProgressFlags = ( - mfwFailIfExists, /// < fail if the destination file already exists - mfwAllowCopy, /// < allow using copy and delete if necessary - mfwDelayUntilReboot, /// < wait until next reboot for moving the file - mfwWriteThrough, /// < Setting this value guarantees that a move performed as a copy and delete operation is flushed to disk before the function returns. - mfwFailIfNotTrackable, /// < The function fails if the source file is a link source, but the file cannot be tracked after the move. - mfwRaiseException); /// < raise an exception if there is an error - TMoveFileWithProgressFlagSet = set of TMoveFileWithProgressFlags; - TCopyDirCreateIntermediate = (cdciCreateIntermediate, cdciDoNotCreateIntermediate); - const - /// <summary> - /// set of char constant containing all characters that are invalid in a filename </summary> - INVALID_FILENAME_CHARS: set of AnsiChar = ['\', '/', ':', '*', '?', '"', '<', '>', '|']; class function CheckAccessToFile(DesiredAccess: DWORD; const Filename: WideString): Boolean; ///<summary> /// wraps the windows API function GetFullPathName </summary> - class function GetFullPathName(const _fn: string): string; static; + class function GetFullPathName(const _fn: string): string; +{$IFDEF SUPPORTS_STATIC} + static; +{$ENDIF} /// <summary> /// Returns a temporary filename. /// @param Directory is a string with the directory to create the file in, defaults @@ -841,6 +848,7 @@ /// @Returns true if the file exists and is writable </summary> class function IsFileWritable(const _Filename: string): Boolean; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} /// <summary> /// creates a backup of the file appending the current date and time to the base /// file name. If the copy operation fails, an underscore and a number will be appended @@ -854,7 +862,7 @@ /// @returns the full filename of the created backup file /// @raises EBackupFailed if the copy operation failed even for the 1000th attempt. </summary> class function BackupFile(const _Filename: string; const _BackupDir: string = ''): string; - +{$ENDIF} ///<summary> /// Generates a backup of the filename by appending the current date and time to the base /// @param Filename is the name of the file to back up @@ -861,7 +869,10 @@ /// @param BackupDir is a directory in which to create the backup file, if empty /// the same directory as the original file is used /// @returns the full filename for the backup file </summary> - class function GenerateBackupFilename(const _Filename: string; _BackupDir: string = ''): string; static; + class function GenerateBackupFilename(const _Filename: string; _BackupDir: string = ''): string; +{$IFDEF SUPPORTS_STATIC} + static; +{$ENDIF} ///<summary> /// Uses kernel32.GetFullPathName and then compares the result using SameText. @@ -877,20 +888,38 @@ /// @param DateTime is a TDateTime value to append /// @param IncludeTime determines whether to append the date only or date and time /// see also AppendDate and AppendDateAndTime </summary> - class function AppendDateTime(const _Filename: string; _DateTime: TDateTime; _IncludeTime: Boolean): string; overload; static; + class function AppendDateTime(const _Filename: string; _DateTime: TDateTime; _IncludeTime: Boolean): string; overload; +{$IFDEF SUPPORTS_STATIC} + static; +{$ENDIF} ///<summary> /// Appends the current date to the filename in the format _YYYY-MM-DD </summary> - class function AppendDate(const _Filename: string): string; overload; static; + class function AppendDate(const _Filename: string): string; overload; +{$IFDEF SUPPORTS_STATIC} + static; +{$ENDIF} + ///<summary> /// Appends the given date to the filename in the format _YYYY-MM-DD </summary> - class function AppendDate(const _Filename: string; _Date: TDateTime): string; overload; static; + class function AppendDate(const _Filename: string; _Date: TDateTime): string; overload; +{$IFDEF SUPPORTS_STATIC} + static; +{$ENDIF} + ///<summary> /// Appends the current date and time to the filename in the format _YYYY-MM-DD_HH-MM-SS </summary> - class function AppendDateAndTime(const _Filename: string): string; overload; static; + class function AppendDateAndTime(const _Filename: string): string; overload; +{$IFDEF SUPPORTS_STATIC} + static; +{$ENDIF} + ///<summary> /// Appends the given date and time to the filename in the format _YYYY-MM-DD_HH-MM-SS </summary> - class function AppendDateAndTime(const _Filename: string; _DateTime: TDateTime): string; overload; static; + class function AppendDateAndTime(const _Filename: string; _DateTime: TDateTime): string; overload; +{$IFDEF SUPPORTS_STATIC} + static; +{$ENDIF} /// <summary> /// @returns a TFileInfoRec containing the filename, filesize and last access @@ -946,6 +975,7 @@ class function RemoveFileExtLast(const _Filename: string): string; end; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} type TFilename = record private @@ -1070,17 +1100,18 @@ class operator Add(_a, _b: TSearchPath): TSearchPath; class operator Add(_a: TSearchPath; const _b: string): TSearchPath; end; +{$ENDIF} type /// <summary> + /// callback event for generating a filename for the given generation </summary> + TOnGenerateFilename = procedure(_Sender: TObject; _Generation: Integer; var _Filename: string) of object; + +type + /// <summary> /// This class handles keeping generations of files, e.g. log files. The default /// is to keep 10 generations </summary> TFileGenerationHandler = class - public - type - /// <summary> - /// callback event for generating a filename for the given generation </summary> - TOnGenerateFilename = procedure(_Sender: TObject; _Generation: Integer; var _Filename: string) of object; private FBaseName: string; FSuffix: string; @@ -1122,11 +1153,11 @@ /// <summary> /// This is an abbreviation for IncludeTrailingPathDelimiter </summary> -function itpd(const _DirName: string): string; inline; +function itpd(const _DirName: string): string; ///<summary> /// This is an abbreviation for ExcludeTrailingPathDelimiter </summary> -function etpd(const _DirName: string): string; inline; +function etpd(const _DirName: string): string; ///<summary> /// Assign a filename and open the file. @@ -1146,17 +1177,26 @@ u_dzDateUtils, u_dzFileStreams; -function _(const _s: string): string; inline; +function _(const _s: string): string; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzDGetText(_s, 'dzlib'); end; -function itpd(const _DirName: string): string; inline; +function itpd(const _DirName: string): string; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := IncludeTrailingPathDelimiter(_DirName); end; -function etpd(const _DirName: string): string; inline; +function etpd(const _DirName: string): string; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := ExcludeTrailingPathDelimiter(_DirName); end; @@ -1872,6 +1912,7 @@ Result := _BackupDir + Base + '_' + ReplaceChars(DateTime2Iso(Now, True), ': ', '-_') + Ext; end; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} class function TFileSystem.BackupFile(const _Filename: string; const _BackupDir: string = ''): string; var i: Integer; @@ -1900,6 +1941,7 @@ + BackupFilename.Extension; end; end; +{$ENDIF} class function TFileSystem.ContainsWildcard(const _Mask: string): Boolean; begin @@ -1962,7 +2004,7 @@ type TProgressRedir = class(TCopyProgressStatus) - strict private + private FOnProgress: TCopyFileProgressEvt; private FCancelFlag: BOOL; @@ -1970,7 +2012,7 @@ FExceptAddr: Pointer; FExceptMsg: string; FExceptClass: string; - function doProgress(): TCopyProgressStatus.TProgressResult; + function doProgress(): TCopyProgressResult; public constructor Create(_OnProgress: TCopyFileProgressEvt); end; @@ -2098,6 +2140,7 @@ class function TFileSystem.CopyMatchingFiles(const _Mask, _SrcDir, _DestDir: string; _Flags: TCopyFileFlagSet; _FilesSkipped: TStrings = nil): Integer; var + i: integer; Files: TStringList; s: string; SrcDirBs: string; @@ -2109,7 +2152,8 @@ Files := TStringList.Create; try TSimpleDirEnumerator.Execute(SrcDirBs + _Mask, Files, [dfaHidden, dfaSysFile, dfaArchive]); - for s in Files do begin + for i := 0 to Files.Count -1 do begin + s := Files[i]; if Self.CopyFile(SrcDirBs + s, DestDirBS + s, _Flags) then Inc(Result) else begin @@ -2687,7 +2731,7 @@ FOnProgress := _OnProgress; end; -function TProgressRedir.doProgress(): TCopyProgressStatus.TProgressResult; +function TProgressRedir.doProgress(): TCopyProgressResult; begin Result := prContinue; try @@ -2911,7 +2955,7 @@ end; procedure TDirectorySync.ProgressStatusCallback(_Status: TCopyProgressStatus; - var _Continue: TCopyProgressStatus.TProgressResult); + var _Continue: TCopyProgressResult); begin try doOnSyncingFile(FCurrentSource, FCurrentDest, _Status.TotalFileSize.QuadPart, _Status.TotalBytesTransferred.QuadPart); @@ -3078,6 +3122,7 @@ TTextRec(_File).Mode := 0; end; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} { TFilename } class operator TFilename.Implicit(const _s: string): TFilename; @@ -3552,6 +3597,7 @@ begin Result := FValue; end; +{$ENDIF} initialization // according to MSDN: Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-01-01 15:33:15 UTC (rev 3021) +++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-01-01 16:23:25 UTC (rev 3022) @@ -48,18 +48,25 @@ Blue: Byte; Green: Byte; Red: Byte; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} function GetColor: TColor; procedure SetColor(_Color: TColor); procedure SetGray(_Value: Byte); function GetLuminance: Byte; function GetFastLuminance: Byte; overload; - class function GetFastLuminance(_Red, _Green, _Blue: Byte): Byte; overload; static; + class function GetFastLuminance(_Red, _Green, _Blue: Byte): Byte; overload; static; inline; function GetBrightness(_Channel: TRgbBrightnessChannelEnum): Byte; procedure SetBrightness(_Value: Byte); procedure GetHls(out _Hls: THlsRec); procedure SetHls(const _Hls: THlsRec); +{$ENDIF} end; +function TdzRgbTriple_GetFastLuminance(const _Triple: TdzRgbTriple): Byte; +procedure TdzRgbTriple_SetColor(var _Triple: TdzRgbTriple; _Color: TColor); + +function GetFastLuminance(_Red, _Green, _Blue: Byte): Byte; + type TdzRgbTripleArray = packed array[0..MaxInt div SizeOf(TdzRgbTriple) - 1] of TdzRgbTriple; PdzRgbTripleArray = ^TdzRgbTripleArray; @@ -71,6 +78,7 @@ Green: Byte; Red: Byte; Reserved: Byte; +{$IFDEF SUPPORTS_ENHANCED_RECORDS} function GetColor: TColor; procedure SetColor(_Color: TColor); procedure SetGray(_Value: Byte); @@ -80,6 +88,7 @@ procedure SetBrightness(_Value: Byte); procedure GetHls(out _Hue, _Luminance, _Saturation: Word); procedure SetHls(_Hue, _Luminance, _Saturation: Word); +{$ENDIF} end; type @@ -146,31 +155,31 @@ procedure TCanvas_DrawTriangle(_Canvas: TCanvas; _Tip: TPoint; _Height: Integer); function TCanvas_BitBlt(_Canvas: TCanvas; _DestPos: TPoint; _Size: TPoint; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _Rop: DWORD = SRCCOPY): LongBool; overload; function TCanvas_BitBlt(_Canvas: TCanvas; _DestRect: TRect; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _Rop: DWORD = SRCCOPY): LongBool; overload; function TCanvas_BitBlt(_Canvas: TCanvas; _DestPos: TPoint; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _Rop: DWORD = SRCCOPY): LongBool; overload; -function TCanvas_BitBlt(_Canvas: TCanvas; _DestPos: TPoint; _Src: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; inline; overload; +function TCanvas_BitBlt(_Canvas: TCanvas; _DestPos: TPoint; _Src: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; overload; ///<summary> abbreviation for StretchBlt that takes TRect </summary> function dzStretchBlt(_DestHandle: Hdc; _DestRect: TRect; - _SrcHandle: Hdc; _SrcRect: TRect; _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _SrcHandle: Hdc; _SrcRect: TRect; _Rop: DWORD = SRCCOPY): LongBool; overload; ///<summary> abbreviation for StretchBlt that takes TCanvas and TRect </summary> function dzStretchBlt(_DestCnv: TCanvas; _DestRect: TRect; - _SrcHandle: Hdc; _SrcRect: TRect; _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _SrcHandle: Hdc; _SrcRect: TRect; _Rop: DWORD = SRCCOPY): LongBool; overload; ///<summary> abbreviation for StretchBlt that takes TRect and TBitmap </summary> function dzStretchBlt(_DestHandle: Hdc; _DestRect: TRect; - _Src: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _Src: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; overload; ///<summary> abbreviation for StretchBlt that takes TCanvas, TRect and TBitmap </summary> function dzStretchBlt(_DestCnv: TCanvas; _DestRect: TRect; - _Src: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _Src: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; overload; ///<summary> /// Abbreviation for StretchBlt that takes two TBitmap, resizes and keeps the spect ratio, @@ -177,22 +186,23 @@ /// using stretchmode HALFTONE (which usually gives the best quality but is a bit slower). /// The original stretchmode and the brush origin are preserved. /// https://msdn.microsoft.com/en-us/library/windows/desktop/dd145089(v=vs.85).aspx </summary> -function dzStretchBlt(_DestBmp, _SrcBmp: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; {inline; } -overload; +function dzStretchBlt(_DestBmp, _SrcBmp: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; overload; ///<summary> abbreviation for BitBlt that takes TPoint / TRect and TBitmap parameters </summary> function dzBitBlt(_DestHandle: Hdc; _DestPos: TPoint; _Size: TPoint; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _Rop: DWORD = SRCCOPY): LongBool; overload; function dzBitBlt(_DestHandle: Hdc; _DestRect: TRect; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _Rop: DWORD = SRCCOPY): LongBool; overload; function dzBitBlt(_DestHandle: Hdc; _DestPos: TPoint; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _Rop: DWORD = SRCCOPY): LongBool; overload; function dzBitBlt(_DestHandle: Hdc; _DestPos: TPoint; _Src: TBitmap; - _Rop: DWORD = SRCCOPY): LongBool; inline; overload; + _Rop: DWORD = SRCCOPY): LongBool; overload; +procedure TBitmap_SetSize(_bmp: TBitmap; _Width, _Height: integer); + function TBitmap_BitBlt(_DestBmp: TBitmap; _DestPos: TPoint; _Size: TPoint; _Src: TBitmap; _SrcPos: TPoint; _Rop: DWORD = SRCCOPY): LongBool; overload; function TBitmap_BitBlt(_DestBmp: TBitmap; _DestRect: TRect; _Src: TBitmap; _SrcPos: TPoint; @@ -199,7 +209,8 @@ _Rop: DWORD = SRCCOPY): LongBool; overload; function TBitmap_BitBlt(_DestBmp: TBitmap; _DestPos: TPoint; _Src: TBitmap; _SrcPos: TPoint; _Rop: DWORD = SRCCOPY): LongBool; overload; -function TBitmap_BitBlt(_DestBmp: TBitmap; _DestPos: TPoint; _Src: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; overload; +function TBitmap_BitBlt(_DestBmp: TBitmap; _DestPos: TPoint; _Src: TBitmap; + _Rop: DWORD = SRCCOPY): LongBool; overload; ///<summary> load a jpeg file and assign it to the bitmap </summary> procedure TBitmap_LoadJpg(_bmp: TBitmap; const _JpgFn: string); overload; @@ -376,12 +387,18 @@ jpeg, // if you get a compile error here you might need to add Vcl.Imaging to the unit scope names u_dzConvertUtils; -function _(const _s: string): string; inline; +function _(const _s: string): string; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzDGetText(_s, 'dzlib'); end; function dzStretchBlt(_DestHandle: Hdc; _DestRect: TRect; _SrcHandle: Hdc; _SrcRect: TRect; _Rop: DWORD): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := StretchBlt(_DestHandle, _DestRect.Left, _DestRect.Top, TRect_Width(_DestRect), TRect_Height(_DestRect), _SrcHandle, _SrcRect.Left, _SrcRect.Top, TRect_Width(_SrcRect), TRect_Height(_SrcRect), _Rop); @@ -388,11 +405,17 @@ end; function dzStretchBlt(_DestCnv: TCanvas; _DestRect: TRect; _SrcHandle: Hdc; _SrcRect: TRect; _Rop: DWORD): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzStretchBlt(_DestCnv.Handle, _DestRect, _SrcHandle, _SrcRect, _Rop); end; function dzStretchBlt(_DestHandle: Hdc; _DestRect: TRect; _Src: TBitmap; _Rop: DWORD): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := StretchBlt(_DestHandle, _DestRect.Left, _DestRect.Top, TRect_Width(_DestRect), TRect_Height(_DestRect), _Src.Canvas.Handle, 0, 0, _Src.Width, _Src.Height, _Rop); @@ -399,11 +422,17 @@ end; function dzStretchBlt(_DestCnv: TCanvas; _DestRect: TRect; _Src: TBitmap; _Rop: DWORD): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzStretchBlt(_DestCnv.Handle, _DestRect, _Src, _Rop); end; function dzStretchBlt(_DestBmp, _SrcBmp: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} var DstHandle: Hdc; OrigBltMode: Integer; @@ -447,7 +476,10 @@ end; function dzBitBlt(_DestHandle: Hdc; _DestPos: TPoint; _Size: TPoint; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD): LongBool; overload; + _Rop: DWORD): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := Windows.BitBlt( _DestHandle, @@ -458,7 +490,10 @@ end; function dzBitBlt(_DestHandle: Hdc; _DestRect: TRect; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD): LongBool; overload; + _Rop: DWORD): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := Windows.BitBlt( _DestHandle, @@ -469,7 +504,10 @@ end; function dzBitBlt(_DestHandle: Hdc; _DestPos: TPoint; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD): LongBool; overload; + _Rop: DWORD): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := Windows.BitBlt( _DestHandle, @@ -481,6 +519,9 @@ end; function dzBitBlt(_DestHandle: Hdc; _DestPos: TPoint; _Src: TBitmap; _Rop: DWORD): LongBool; overload; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := Windows.BitBlt( _DestHandle, @@ -493,6 +534,9 @@ function TCanvas_BitBlt(_Canvas: TCanvas; _DestPos: TPoint; _Size: TPoint; _Src: TBitmap; _SrcPos: TPoint; _Rop: DWORD = SRCCOPY): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzBitBlt( _Canvas.Handle, @@ -505,6 +549,9 @@ function TCanvas_BitBlt(_Canvas: TCanvas; _DestRect: TRect; _Src: TBitmap; _SrcPos: TPoint; _Rop: DWORD = SRCCOPY): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzBitBlt( _Canvas.Handle, @@ -516,6 +563,9 @@ function TCanvas_BitBlt(_Canvas: TCanvas; _DestPos: TPoint; _Src: TBitmap; _SrcPos: TPoint; _Rop: DWORD = SRCCOPY): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzBitBlt( _Canvas.Handle, @@ -526,6 +576,9 @@ end; function TCanvas_BitBlt(_Canvas: TCanvas; _DestPos: TPoint; _Src: TBitmap; _Rop: DWORD = SRCCOPY): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := dzBitBlt( _Canvas.Handle, @@ -678,6 +731,25 @@ _Canvas.Polygon([_Tip, Point(BaselineLeft, BaselineY), Point(BaselineRight, BaselineY)]); end; +function TdzRgbTriple_GetFastLuminance(const _Triple: TdzRgbTriple): Byte; +begin + Result := GetFastLuminance(_Triple.Red, _Triple.Green, _Triple.Blue); +end; + +procedure TdzRgbTriple_SetColor(var _Triple: TdzRgbTriple; _Color: TColor); +begin + _Color := ColorToRGB(_Color); + _Triple.Red := GetRValue(_Color); + _Triple.Green := GetGValue(_Color); + _Triple.Blue := GetBValue(_Color); +end; + +function GetFastLuminance(_Red, _Green, _Blue: Byte): Byte; +begin + Result := Round(0.299 * _Red + 0.587 * _Green + 0.114 * _Blue); +end; + +{$IFDEF SUPPORTS_ENHANCED_RECORDS} { TdzRgbTriple } function TdzRgbTriple.GetBrightness(_Channel: TRgbBrightnessChannelEnum): Byte; @@ -936,7 +1008,17 @@ begin SetColor(ColorHLSToRGB(_Hue, _Luminance, _Saturation)); end; +{$ENDIF} +procedure TBitmap_SetSize(_bmp: TBitmap; _Width, _Height: integer); +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} +begin + _bmp.Width := _Width; + _bmp.Height := _Height; +end; + {$IF Declared(TBitmap32)} procedure TBitmap_LoadJpg(_bmp: TBitmap32; const _JpgFn: string); @@ -1511,7 +1593,7 @@ _DstBmp.PixelFormat := pf24bit; w := _SrcBmp.Width; h := _SrcBmp.Height; - _DstBmp.SetSize(w, h); + TBitmap_SetSize(_DstBmp, w, h); for y := 0 to h - 1 do begin SrcLine := _SrcBmp.ScanLine[y]; @@ -1539,7 +1621,7 @@ w := _SrcBmp.Width; h := _SrcBmp.Height; _DstBmp.Palette := MakeGrayPalette; - _DstBmp.SetSize(w, h); + TBitmap_SetSize(_DstBmp, w, h); for y := 0 to h - 1 do begin SrcLine := _SrcBmp.ScanLine[y]; @@ -1602,7 +1684,7 @@ _SrcBmp.PixelFormat := pf8bit; _DstBmp.PixelFormat := pf8bit; _DstBmp.Palette := MakeGrayPalette; - _DstBmp.SetSize(_SrcBmp.Width, _SrcBmp.Height); + TBitmap_SetSize(_DstBmp, _SrcBmp.Width, _SrcBmp.Height); WorkAreaWidth := _SrcBmp.Width - 2; WorkAreaHeight := _SrcBmp.Height - 2; @@ -1729,7 +1811,7 @@ _SrcBmp.PixelFormat := pf24bit; _DstBmp.PixelFormat := pf24bit; - _DstBmp.SetSize(_SrcBmp.Width, _SrcBmp.Height); + TBitmap_SetSize(_DstBmp, _SrcBmp.Width, _SrcBmp.Height); WorkAreaWidth := _SrcBmp.Width - 2; WorkAreaHeight := _SrcBmp.Height - 2; @@ -1873,7 +1955,7 @@ _SrcBmp.PixelFormat := pf8bit; _DstBmp.PixelFormat := pf8bit; _DstBmp.Palette := MakeGrayPalette; - _DstBmp.SetSize(_SrcBmp.Width, _SrcBmp.Height); + TBitmap_SetSize(_DstBmp, _SrcBmp.Width, _SrcBmp.Height); WorkAreaWidth := _SrcBmp.Width - 2; WorkAreaHeight := _SrcBmp.Height - 2; @@ -2009,7 +2091,7 @@ _SrcBmp.PixelFormat := pf24bit; _DstBmp.PixelFormat := pf24bit; - _DstBmp.SetSize(_SrcBmp.Width, _SrcBmp.Height); + TBitmap_SetSize(_DstBmp, _SrcBmp.Width, _SrcBmp.Height); WorkAreaWidth := _SrcBmp.Width - 2; WorkAreaHeight := _SrcBmp.Height - 2; @@ -2127,7 +2209,10 @@ end; function TBitmap_BitBlt(_DestBmp: TBitmap; _DestPos: TPoint; _Size: TPoint; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD = SRCCOPY): LongBool; overload; + _Rop: DWORD = SRCCOPY): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := TCanvas_BitBlt( _DestBmp.Canvas, @@ -2139,7 +2224,10 @@ end; function TBitmap_BitBlt(_DestBmp: TBitmap; _DestRect: TRect; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD = SRCCOPY): LongBool; overload; + _Rop: DWORD = SRCCOPY): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := TCanvas_BitBlt( _DestBmp.Canvas, @@ -2150,7 +2238,10 @@ end; function TBitmap_BitBlt(_DestBmp: TBitmap; _DestPos: TPoint; _Src: TBitmap; _SrcPos: TPoint; - _Rop: DWORD = SRCCOPY): LongBool; overload; + _Rop: DWORD = SRCCOPY): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := TCanvas_BitBlt( _DestBmp.Canvas, @@ -2160,7 +2251,10 @@ _Rop); end; -function TBitmap_BitBlt(_DestBmp: TBitmap; _DestPos: TPoint; _Src: TBitmap; _Rop: DWORD): LongBool; overload; +function TBitmap_BitBlt(_DestBmp: TBitmap; _DestPos: TPoint; _Src: TBitmap; _Rop: DWORD): LongBool; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin Result := TCanvas_BitBlt( _DestBmp.Canvas, @@ -2171,19 +2265,28 @@ end; function ColorBrightness(_Red, _Green, _Blue: Byte): Byte; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin - Result := TdzRgbTriple.GetFastLuminance(_Red, _Green, _Blue); + Result := GetFastLuminance(_Red, _Green, _Blue); end; function ColorBrightness(_Color: TColor): Byte; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} var RGB: TdzRgbTriple; begin - RGB.SetColor(_Color); - Result := RGB.GetFastLuminance; + TdzRgbTriple_SetColor(RGB, _Color); + Result := TdzRgbTriple_GetFastLuminance(RGB); end; function BestForegroundForColor(_Red, _Green, _Blue: Byte): TColor; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin if ColorBrightness(_Red, _Green, _Blue) < 123 then Result := clWhite @@ -2192,6 +2295,9 @@ end; function BestForegroundForColor(_Color: TColor): TColor; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} begin if ColorBrightness(_Color) < 123 then Result := clWhite @@ -2322,6 +2428,9 @@ end; function RainbowColor(_MinHue, _MaxHue, _Hue: Integer): TColor; overload; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} // taken from https://stackoverflow.com/a/19719171/49925 begin Result := RainbowColor((_Hue - _MinHue) / (_MaxHue - _MinHue + 1)); Modified: trunk/ExternalSource/dzlib/u_dzLineBuilder.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzLineBuilder.pas 2020-01-01 15:33:15 UTC (rev 3021) +++ trunk/ExternalSource/dzlib/u_dzLineBuilder.pas 2020-01-01 16:23:25 UTC (rev 3022) @@ -12,10 +12,16 @@ private FListSeparator: string; FContent: string; +{$IF Declared(TFormatSettings)} FFormatSettings: TFormatSettings; +{$ELSE} + FDecimalSeparator: Char; +{$IFEND} FQuoteChar: Char; FColumnCount: Integer; FForceQuoted: Boolean; + function GetDecimalSeparator: Char; + procedure SetDecimalSeparator(_Value: Char); public ///<summary> Creates a TLineBuilder instance with the given separator /// @param ListSeparator is the separator string to use, defaults to TAB (#9) @@ -60,12 +66,14 @@ ///<summary> allows read access to the content that has been built </summary> property Content: string read FContent; property ColumnCount: Integer read FColumnCount; - property DecimalSeparator: Char read FFormatSettings.DecimalSeparator write FFormatSettings.DecimalSeparator default '.'; + property DecimalSeparator: Char read GetDecimalSeparator write SetDecimalSeparator default '.'; property ListSeparator: string read FListSeparator write FListSeparator; ///<summary> If set to true, every column will be enclosed in quotes </summary> property ForceQuoted: Boolean read FForceQuoted write FForceQuoted; property QuoteChar: Char read FQuoteChar write FQuoteChar; +{$IF Declared(TFormatSettings)} property FormatSettings: TFormatSettings read FFormatSettings; +{$IFEND} end; implementation @@ -82,13 +90,35 @@ begin inherited Create; FListSeparator := _ListSeparator; +{$IF Declared(TFormatSettings)} FFormatSettings := GetUserDefaultLocaleSettings; FFormatSettings.DecimalSeparator := _DecimalSeparator; FFormatSettings.ThousandSeparator := #0; +{$ELSE} + FDecimalSeparator := _DecimalSeparator; +{$IFEND} FQuoteChar := '"'; FColumnCount := 0; end; +function TLineBuilder.GetDecimalSeparator: Char; +begin +{$IF Declared(TFormatSettings)} + Result := FFormatSettings.DecimalSeparator; +{$ELSE} + Result := FDecimalSeparator; +{$IFEND} +end; + +procedure TLineBuilder.SetDecimalSeparator(_Value: Char); +begin +{$IF Declared(TFormatSettings)} + FFormatSettings.DecimalSeparator := _Value; +{$ELSE} + FDecimalSeparator := _Value; +{$IFEND} +end; + procedure TLineBuilder.Add(_IntValue: Integer); begin Add(IntToStr(_IntValue)); @@ -105,19 +135,67 @@ end; procedure TLineBuilder.Add(_FloatValue: Extended; _Decimals: Integer); +{$IF Declared(TFormatSettings)} begin Add(FloatToStrF(_FloatValue, fffixed, 18, _Decimals, FFormatSettings)); end; +{$ELSE} +var + SysDecimalSep: Char; + SysThousandSep: Char; +begin + SysDecimalSep := SysUtils.DecimalSeparator; + SysThousandSep := SysUtils.ThousandSeparator; + try + Add(FloatToStrF(_FloatValue, fffixed, 18, _Decimals)); + finally + SysUtils.DecimalSeparator := SysDecimalSep; + SysUtils.ThousandSeparator := SysThousandSep; + end; +end; +{$IFEND} procedure TLineBuilder.Add(_FloatValue: Extended); +{$IF Declared(TFormatSettings)} begin Add(FloatToStr(_FloatValue, FFormatSettings)); end; +{$ELSE} +var + SysDecimalSep: Char; + SysThousandSep: Char; +begin + SysDecimalSep := SysUtils.DecimalSeparator; + SysThousandSep := SysUtils.ThousandSeparator; + try + Add(FloatToStr(_FloatValue)); + finally + SysUtils.DecimalSeparator := SysDecimalSep; + SysUtils.ThousandSeparator := SysThousandSep; + end; +end; +{$IFEND} procedure TLineBuilder.Add(_FloatValue: Extended; _IntDigits, _FracDigits: Integer); +{$IF Declared(TFormatSettings)} begin Add(Format('%*.*f', [_IntDigits, _FracDigits, _FloatValue], FFormatSettings)); end; +{$ELSE} +var + SysDecimalSep: Char; + SysThousandSep: Char; +begin + SysDecimalSep := SysUtils.DecimalSeparator; + SysThousandSep := SysUtils.ThousandSeparator; + try + Add(Format('%*.*f', [_IntDigits, _FracDigits, _FloatValue]))... [truncated message content] |