Menu
▾
▴
gexperts-checkins
|
From: <tw...@us...> - 2019-12-31 19:02:52
|
Revision: 3001
http://sourceforge.net/p/gexperts/code/3001
Author: twm
Date: 2019-12-31 19:02:51 +0000 (Tue, 31 Dec 2019)
Log Message:
-----------
* include dzlib.inc rather than dzlibjedi.inc (wich is included in dzlib.inc
* fix for compile error / warning due to inconsistent declarations of file handles in the Delphi RTL
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzFileStreams.pas
Added Paths:
-----------
trunk/ExternalSource/dzlib/dzlib.inc
Added: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc (rev 0)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2019-12-31 19:02:51 UTC (rev 3001)
@@ -0,0 +1,19 @@
+{$INCLUDE 'dzlibjedi.inc'}
+
+{$IFDEF DELPHIX_TOKYO_UP}
+{$DEFINE FILECTRL_DIRECTORYEXISTS_IS_DEPRECATED}
+{$ENDIF}
+
+// The following cond. defines address errors in various Delphi versions regarding the declaration
+// of the FHandle field of THandleStream and the corresponding Create constructor parameter:
+
+{$IFDEF DELPHI2009_UP}
+// THandleStream.FHandle is declared as THandle (before that it's an Integer)
+{$DEFINE THANDLESTREAM_HANDLE_IS_THANDLE}
+{$ENDIF}
+
+{$IFDEF DELPHIXE2_UP}
+// AHandle is declared as THandle (otherwise it's an Integer)
+{$DEFINE THANDLESTREAM_CREATE_HANDLE_IS_THANDLE}
+{$ENDIF}
+
Modified: trunk/ExternalSource/dzlib/u_dzFileStreams.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2019-12-31 19:01:04 UTC (rev 3000)
+++ trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2019-12-31 19:02:51 UTC (rev 3001)
@@ -5,7 +5,7 @@
/// and sets the properties to sensible values for temporary files. </summary>
unit u_dzFileStreams;
-{$I dzlibjedi.inc}
+{$INCLUDE 'dzlib.inc'}
interface
@@ -254,14 +254,15 @@
{$ENDIF}
type
-{$IFDEF DELPHIXE_UP}
+{$IFDEF THANDLESTREAM_CREATE_HANDLE_IS_THANDLE}
+ THandleStreamCreateHandleCast = THandle;
+{$ELSE}
+ THandleStreamCreateHandleCast = Integer;
+{$ENDIF}
+{$IFDEF THANDLESTREAM_HANDLE_IS_THANDLE}
THandleCast = THandle;
{$ELSE}
- THandleCast = Integer; // Delphi < XE wrongly declares the handle parameter
- // to THandleStream.Create as signed integer while
- // it really should be unsigned. Delphi XE corrects
- // this but in order to compile with all version we
- // need this cond. define.
+ THandleCast = Integer;
{$ENDIF}
class procedure TdzFile.CreateReadFree(const _fn: string; var _Buffer; _Size: Integer);
@@ -292,7 +293,7 @@
constructor TdzFile.Create(const _Filename: string);
begin
- inherited Create(THandleCast(INVALID_HANDLE_VALUE));
+ inherited Create(THandleStreamCreateHandleCast(INVALID_HANDLE_VALUE));
FFilename := _Filename;
FAccessMode := [faRead];
FShareMode := [fsRead];
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-01-01 08:13:32
|
Revision: 3016
http://sourceforge.net/p/gexperts/code/3016
Author: twm
Date: 2020-01-01 08:13:20 +0000 (Wed, 01 Jan 2020)
Log Message:
-----------
* {$INCLUDE 'dzlibjedi.inc'} -> {$INCLUDE 'dzlib.inc'}
* Fixed compile errors and warnings in Delphi 2006 (this THandle garbage is driving me crazy)
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzFileStreams.pas
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
trunk/ExternalSource/dzlib/u_dzOsUtils.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-01-01 08:09:57 UTC (rev 3015)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-01-01 08:13:20 UTC (rev 3016)
@@ -5,7 +5,7 @@
/// which originally was a Delphi conversion of TwmStringFunc. </summary>
unit u_dzConvertUtils;
-{$I dzlibjedi.inc}
+{$I dzlib.inc}
interface
Modified: trunk/ExternalSource/dzlib/u_dzFileStreams.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2020-01-01 08:09:57 UTC (rev 3015)
+++ trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2020-01-01 08:13:20 UTC (rev 3016)
@@ -249,7 +249,7 @@
{$ELSE}
THandleStreamHack = class(TStream)
private
- FHandle: DWORD;
+ FHandle: Integer;
end;
{$ENDIF}
@@ -265,6 +265,9 @@
THandleCast = Integer;
{$ENDIF}
+const
+ INVALID_HANDLE_VALUE = -1;
+
class procedure TdzFile.CreateReadFree(const _fn: string; var _Buffer; _Size: Integer);
var
Stream: TdzFile;
@@ -371,7 +374,7 @@
repeat
ApiHandle := Windows.CreateFile(PChar(FFilename), Access,
TheShareMode, FSecurityAttributes, Disposition, FFileAttributes or FFileFlags, 0);
- Result := (ApiHandle <> INVALID_HANDLE_VALUE);
+ Result := (ApiHandle <> THandle(INVALID_HANDLE_VALUE));
if not Result and ResetReadOnly and not TriedResetReadonly then
TFileSystem.SetReadonly(FFilename, False, ehReturnFalse);
until Result or TriedResetReadonly or not ResetReadOnly or not (faWrite in AccessMode) and ResetReadOnly;
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-01-01 08:09:57 UTC (rev 3015)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-01-01 08:13:20 UTC (rev 3016)
@@ -1,5 +1,7 @@
unit u_dzGraphicsUtils;
+{$INCLUDE 'dzlib.inc'}
+
{.$OPTIMIZATION ON}
{$IFOPT O-} // Optimization
@@ -560,6 +562,7 @@
RGN := CreateRectRgn(_Rect.Left, _Rect.Top, _Rect.Right, _Rect.Bottom);
if RGN = 0 then
raise Exception.Create(_('CreateRectRgn failed'));
+
try
Res := SelectClipRgn(_Canvas.Handle, RGN);
if Res = Error then
Modified: trunk/ExternalSource/dzlib/u_dzOsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzOsUtils.pas 2020-01-01 08:09:57 UTC (rev 3015)
+++ trunk/ExternalSource/dzlib/u_dzOsUtils.pas 2020-01-01 08:13:20 UTC (rev 3016)
@@ -1,6 +1,8 @@
///<summary> This unit contains operating system dependent functions, at least some of them. </summary>
unit u_dzOsUtils;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
@@ -1226,6 +1228,10 @@
end;
function TryGetWindowsVersionFromRegistry(out _Values: TWinCurrentRec): Boolean;
+{$IF not Defined(KEY_WOW64_64KEY)}
+const
+ KEY_WOW64_64KEY = $0100;
+{$IFEND}
var
Reg: TRegistry;
begin
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-01-01 08:09:57 UTC (rev 3015)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-01-01 08:13:20 UTC (rev 3016)
@@ -1,5 +1,7 @@
unit u_dzTypes;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
@@ -18,6 +20,9 @@
TSingleArray = array of Single;
TDoubleArray = array of Double;
TExtendedArray = array of Extended;
+{$IF not Declared(TBytes)}
+ TBytes = array of Byte;
+{$IFEND}
implementation
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-01-01 08:09:57 UTC (rev 3015)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-01-01 08:13:20 UTC (rev 3016)
@@ -2132,6 +2132,13 @@
TEditHack = class(TCustomEdit)
end;
+{$IF NOT Declared(ECM_FIRST)}
+const
+ ECM_FIRST = $1500;
+ EM_SETCUEBANNER = ECM_FIRST + 1;
+ EM_GETCUEBANNER = ECM_FIRST + 2;
+{$IFEND}
+
procedure TEdit_SetCueBanner(_ed: TCustomEdit; const _Banner: WideString);
begin
SendMessage(_ed.Handle, EM_SETCUEBANNER, wParam(True), LParam(PWChar(_Banner)));
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
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] |
|
From: <tw...@us...> - 2020-01-01 16:46:36
|
Revision: 3025
http://sourceforge.net/p/gexperts/code/3025
Author: twm
Date: 2020-01-01 16:46:34 +0000 (Wed, 01 Jan 2020)
Log Message:
-----------
* new cond. define SUPPORTS_WARN_USE_BEFORE_DEF (Delphi 6 does not support it)
* turn off platform warnings for all dzlib units
* got rid of warning in u_dzClassUtils.TStream_ReadStringLn
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzClassUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-01-01 16:37:28 UTC (rev 3024)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-01-01 16:46:34 UTC (rev 3025)
@@ -3,6 +3,8 @@
{$IFDEF DELPHI7_UP}
// TBitBtn.WordWrap was introduced in Delphi 7
{$DEFINE HAS_BITBTN_WORDWRAP}
+// So was the $WARN USE_BEFORE_DEF define
+{$DEFINE SUPPORTS_WARN_USE_BEFORE_DEF}
{$ENDIF}
{$IFDEF DELPHI2005_UP}
@@ -27,3 +29,7 @@
{$DEFINE THANDLESTREAM_CREATE_HANDLE_IS_THANDLE}
{$ENDIF}
+{$WARN SYMBOL_PLATFORM OFF}
+{$WARN UNIT_PLATFORM OFF}
+
+
Modified: trunk/ExternalSource/dzlib/u_dzClassUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2020-01-01 16:37:28 UTC (rev 3024)
+++ trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2020-01-01 16:46:34 UTC (rev 3025)
@@ -1052,7 +1052,9 @@
// Turn Warning off, because Delphi 2007 thinks that the variable might not have been initialized.
// But that is not the case.
// 2019-06-03 pp
+{$IFDEF SUPPORTS_WARN_USE_BEFORE_DEF}
{$WARN USE_BEFORE_DEF OFF}
+{$ENDIF}
function TStream_ReadStringLn(_Stream: TStream; out _s: string): Integer;
var
@@ -1089,7 +1091,9 @@
end;
_Stream.Position := NewPos;
end;
+{$IFDEF SUPPORTS_WARN_USE_BEFORE_DEF}
{$WARN USE_BEFORE_DEF DEFAULT}
+{$ENDIF}
function TStrings_TryStringByObj(_Strings: TStrings; _Obj: Pointer; out _Value: string): Boolean;
var
@@ -2042,7 +2046,7 @@
function TStringList_CreateFrom(const _sa: array of string; _Sorted: Boolean = False): TStringList;
var
- i: integer;
+ i: Integer;
begin
Result := TStringList.Create;
for i := Low(_sa) to High(_sa) do
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-01-01 17:14:24
|
Revision: 3028
http://sourceforge.net/p/gexperts/code/3028
Author: twm
Date: 2020-01-01 17:14:16 +0000 (Wed, 01 Jan 2020)
Log Message:
-----------
only inclucde dzlib.inc, it automatically includes dzlibjedi.inc
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzAssertTrace.pas
trunk/ExternalSource/dzlib/u_dzCompilerAndRtlVersions.pas
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzDateUtils.pas
trunk/ExternalSource/dzlib/u_dzErrorThread.pas
trunk/ExternalSource/dzlib/u_dzFileUtils.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_dzPackageInfo.pas
trunk/ExternalSource/dzlib/u_dzQuicksort.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_dzVersionInfo.pas
Modified: trunk/ExternalSource/dzlib/u_dzAssertTrace.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzAssertTrace.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzAssertTrace.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,5 +1,7 @@
unit u_dzAssertTrace;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
Modified: trunk/ExternalSource/dzlib/u_dzCompilerAndRtlVersions.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzCompilerAndRtlVersions.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzCompilerAndRtlVersions.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,5 +1,7 @@
unit u_dzCompilerAndRtlVersions;
+{$INCLUDE 'dzlib.inc'}
+
interface
const
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -5,7 +5,7 @@
/// which originally was a Delphi conversion of TwmStringFunc. </summary>
unit u_dzConvertUtils;
-{$I dzlib.inc}
+{$INCLUDE 'dzlib.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzDateUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzDateUtils.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzDateUtils.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -8,7 +8,7 @@
/// are also not available. </summary>
unit u_dzDateUtils;
-{$I dzlibjedi.inc}
+{$INCLUDE 'dzlib.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzErrorThread.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzErrorThread.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzErrorThread.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,6 +1,6 @@
unit u_dzErrorThread;
-{$INCLUDE 'dzlibjedi.inc'}
+{$INCLUDE 'dzlib.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -3,7 +3,7 @@
/// implements utility functions for file accesss </summary>
unit u_dzFileUtils;
-{$I dzlibjedi.inc}
+{$INCLUDE 'dzlib.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzLineBuilder.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzLineBuilder.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzLineBuilder.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,5 +1,7 @@
unit u_dzLineBuilder;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
Modified: trunk/ExternalSource/dzlib/u_dzMapFileReader.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzMapFileReader.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzMapFileReader.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,5 +1,7 @@
unit u_dzMapFileReader;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
Modified: trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -16,11 +16,8 @@
unit u_dzMiscUtils;
-{$I dzlibjedi.inc}
+{$INCLUDE 'dzlib.inc'}
-{$WARN SYMBOL_PLATFORM off}
-{$WARN UNIT_PLATFORM off}
-
interface
uses
Modified: trunk/ExternalSource/dzlib/u_dzNamedThread.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzNamedThread.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzNamedThread.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -6,7 +6,7 @@
/// your thread's execute procedure. </summary>
unit u_dzNamedThread;
-{$INCLUDE 'dzlibjedi.inc'}
+{$INCLUDE 'dzlib.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzPackageInfo.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzPackageInfo.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzPackageInfo.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,5 +1,7 @@
unit u_dzPackageInfo;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
Modified: trunk/ExternalSource/dzlib/u_dzQuicksort.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzQuicksort.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzQuicksort.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -3,9 +3,10 @@
function.
@author(Thomas Mueller http://www.dummzeuch.de)
}
-
unit u_dzQuicksort;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
Modified: trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -3,7 +3,7 @@
/// in later versions) </summary>
unit u_dzSelectDirectoryFix;
-{$INCLUDE 'dzlibjedi.inc'}
+{$INCLUDE 'dzlib.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzSortProvider.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSortProvider.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzSortProvider.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,5 +1,7 @@
unit u_dzSortProvider;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
Modified: trunk/ExternalSource/dzlib/u_dzSortUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSortUtils.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzSortUtils.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,7 +1,6 @@
unit u_dzSortUtils;
{$INCLUDE 'dzlib.inc'}
-{$INCLUDE 'dzlibjedi.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,7 +1,6 @@
unit u_dzSpeedBitBtn;
{$INCLUDE 'dzlib.inc'}
-{$INCLUDE 'dzlibjedi.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzStringUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -5,7 +5,7 @@
/// @author twm </summary>
unit u_dzStringUtils;
-{$I dzlibjedi.inc}
+{$INCLUDE 'dzlib.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzTranslator.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTranslator.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzTranslator.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,7 +1,7 @@
{.GXFormatter.config=twm}
unit u_dzTranslator;
-{$I dzlibjedi.inc}
+{$INCLUDE 'dzlib.inc'}
{$IFNDEF NO_TRANSLATION}
// for now uses gnugettext
Modified: trunk/ExternalSource/dzlib/u_dzTypesUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypesUtils.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzTypesUtils.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,5 +1,7 @@
unit u_dzTypesUtils;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
Modified: trunk/ExternalSource/dzlib/u_dzVariantUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVariantUtils.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzVariantUtils.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -2,6 +2,8 @@
/// several utility functions for Variants </summary>
unit u_dzVariantUtils;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
Modified: trunk/ExternalSource/dzlib/u_dzVersionInfo.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVersionInfo.pas 2020-01-01 17:10:03 UTC (rev 3027)
+++ trunk/ExternalSource/dzlib/u_dzVersionInfo.pas 2020-01-01 17:14:16 UTC (rev 3028)
@@ -1,6 +1,8 @@
{.GXFormatter.config=twm}
unit u_dzVersionInfo;
+{$INCLUDE 'dzlib.inc'}
+
interface
uses
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-02-02 14:59:37
|
Revision: 3045
http://sourceforge.net/p/gexperts/code/3045
Author: twm
Date: 2020-02-02 14:59:35 +0000 (Sun, 02 Feb 2020)
Log Message:
-----------
synced with current dzlib
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-02-02 14:52:44 UTC (rev 3044)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-02-02 14:59:35 UTC (rev 3045)
@@ -5,8 +5,11 @@
{$DEFINE HAS_BITBTN_WORDWRAP}
// So was the $WARN USE_BEFORE_DEF define
{$DEFINE SUPPORTS_WARN_USE_BEFORE_DEF}
+// Not sure about TBitmap.SetSize, was it introduced with Delphi 7 or later?
+{$DEFINE SUPPPORTS_BITMAP_SETSIZE}
{$ENDIF}
+
{$IFDEF DELPHI2005_UP}
// Delphi 6 and 7 understood deprecated, but not for types
{$DEFINE SUPPORTS_DEPRECATED_TYPES}
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-02-02 14:52:44 UTC (rev 3044)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-02-02 14:59:35 UTC (rev 3045)
@@ -140,6 +140,13 @@
function isNumberN(const _s: string; _Base: TBaseN): Integer;
///<summary>
+/// Reduces an Integer to a Byte value by cutting it off at 0 and 255 </summary>
+function ReduceToByte(const _Value: Integer): Byte;
+{$IFDEF SUPPORTS_INLINE}
+ inline;
+{$ENDIF}
+
+///<summary>
/// Converts a string of the form '-hh:mm:ss', 'hh:mm:ss',
/// '+hh:mm:ss', 'mm:ss' or 'ss' to a number of seconds. </summary>
function TimeStrToSeconds(const _Zeit: string): Integer;
@@ -577,6 +584,16 @@
Result := '0' + Result;
end;
+function ReduceToByte(const _Value: Integer): Byte; inline;
+begin
+ if _Value < 0 then
+ Result := 0
+ else if _Value > 255 then
+ Result := 255
+ else
+ Result := _Value;
+end;
+
function isHexDigit(_a: Char): Boolean;
begin
Result := isDigit(_a, 16);
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-02-02 14:52:44 UTC (rev 3044)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-02-02 14:59:35 UTC (rev 3045)
@@ -12,7 +12,7 @@
// If optimization is on, we turn off assertions, just in case the programmer forgot.
// The reason for this is that we have some assertions below that might significantly impact
// performance.
-{$C-} // this is the short form for $ASSERTIONS ON
+{$C-} // this is the short form for $ASSERTIONS OFF
{$ENDIF}
{.$DEFINE dzUseGraphics32}
@@ -28,6 +28,7 @@
GR32, // libs\graphics32\src
{$ENDIF}
u_dzTranslator,
+ u_dzConvertUtils,
u_dzTypesUtils;
type
@@ -53,6 +54,7 @@
end;
type
+ PdzRgbTriple = ^TdzRgbTriple;
TdzRgbTriple = packed record
// do not change the order of the fields, do not add any fields
Blue: Byte;
@@ -66,7 +68,7 @@
function GetFastLuminance: Byte; overload;
class function GetFastLuminance(_Red, _Green, _Blue: Byte): Byte; overload; static; inline;
function GetBrightness(_Channel: TRgbBrightnessChannelEnum): Byte;
- procedure SetBrightness(_Value: Byte);
+ procedure SetBrightness(_Value: Byte); deprecated; //use SetGray
procedure GetHls(out _Hls: THlsRec);
procedure SetHls(const _Hls: THlsRec);
{$ENDIF}
@@ -85,6 +87,11 @@
inline;
{$ENDIF}
+function PtrDiff(const _Ptr1, _Ptr2: Pointer): NativeInt; inline;
+{$IFDEF SUPPORTS_INLINE}
+inline;
+{$ENDIF}
+
function TdzRgbTriple_GetFastLuminance(const _Triple: TdzRgbTriple): Byte;
{$IFDEF SUPPORTS_INLINE}
inline;
@@ -104,6 +111,7 @@
PdzRgbTripleArray = ^TdzRgbTripleArray;
type
+ PdzRgbQuad = ^TdzRgbQuad;
TdzRgbQuad = packed record
// do not change the order of the fields, do not add any fields
Blue: Byte;
@@ -117,7 +125,7 @@
function GetLuminance: Word;
function GetFastLuminance: Word;
function GetBrightness(_Channel: TRgbBrightnessChannelEnum): Word;
- procedure SetBrightness(_Value: Byte);
+ procedure SetBrightness(_Value: Byte); deprecated; //use SetGray
procedure GetHls(out _Hue, _Luminance, _Saturation: Word);
procedure SetHls(_Hue, _Luminance, _Saturation: Word);
{$ENDIF}
@@ -450,7 +458,7 @@
{$ENDIF}
///<summary>
-/// calculates the average brightness of an bitmap with PixelFormat = pf8Bit
+/// Calculates the average brightness of an bitmap with PixelFormat = pf8Bit
/// @param bmp is the bitmap to process
/// @param LowCutoff is the lower brightness limit for pixels to be include in the calculation
/// @param HighCutoff is the upper brightness limit for pixels to be include in the calculation
@@ -461,7 +469,7 @@
out _Average: Byte): Boolean;
///<summary>
-/// calculates the average brightness of an bitmap with PixelFormat = pf24Bit
+/// Calculates the average brightness of an bitmap with PixelFormat = pf24Bit
/// @param bmp is the bitmap to process
/// @param LowCutoff is the lower brightness limit for pixels to be include in the calculation
/// @param HighCutoff is the upper brightness limit for pixels to be include in the calculation
@@ -473,6 +481,18 @@
_Channel: TRgbBrightnessChannelEnum;
out _Average: Byte): Boolean;
+///<summary>
+/// Calculates the average brightness of an bitmap with PixelFormat = pf24Bit thereby only
+/// using the blue channel.
+/// @param bmp is the bitmap to process
+/// @param LowCutoff is the lower brightness limit for pixels to be include in the calculation
+/// @param HighCutoff is the upper brightness limit for pixels to be include in the calculation
+/// @param Average returns the calculated average, only valid if Result = True
+/// @returns True, if at least on pixel was in the desired interval
+/// False, if not </summary>
+function TBitmap24_TryCalcAverageBlue(_bmp: TBitmap; _LowCutoff, _HighCutoff: Byte;
+ out _Average: Byte): Boolean;
+
type
// Note: The bitmap is stored upside down, so the y coordinates are reversed!
TPixel24FilterCallback = procedure(_x, _y: Integer; var _Pixel: TdzRgbTriple) of object;
@@ -484,6 +504,35 @@
procedure TBitmap8_FilterPixels(_SrcBmp, _DstBmp: TBitmap; _Callback: TPixel8FilterCallback);
type
+ TGammaCurve = array[0..255] of Byte;
+
+///</summary>
+/// Apply the given gamma curves to the respctive colors of the bitmap </summary>
+procedure TBitmap24_ApplyGamma(_SrcBmp, _DstBmp: TBitmap; const _GammaRed, _GammaGreen, _GammaBlue: TGammaCurve); overload;
+
+///</summary>
+/// Apply the given gamma curve to all colors of the bitmap </summary>
+procedure TBitmap24_ApplyGamma(_SrcBmp, _DstBmp: TBitmap; const _Gamma: TGammaCurve); overload;
+
+///</summary>
+/// Apply the given gamma curve to an 8 bit gray scale bitmap </summary>
+procedure TBitmap8_ApplyGamma(_SrcBmp, _DstBmp: TBitmap; const _Gamma: TGammaCurve); overload;
+
+///</summary>
+/// Apply the given gamma curve to a 24 bit gray scale bitmap and convert it to 8 bit
+/// in the process.
+/// @param SrcBmp is the source bitmap, must have PixelFormat pf24bit and be grayscale
+/// The algoritm only takes the blue channel for the conversion.
+/// @param DstBmp is the destinateion bitmap, it will be set to the same size as the source
+/// and to PixelFormat pf8bit and a gray scale palette.
+/// @param Gamma is an array representing the gamma curve to apply. </summary>
+procedure TBitmap24_ApplyGammaTo8(_SrcBmp, _DstBmp: TBitmap; const _Gamma: TGammaCurve); overload;
+
+///</summary>
+/// Sequentially Apply the given gamma curves to an 8 bit gray scale bitmap </summary>
+procedure TBitmap8_ApplyMultiGamma(_SrcBmp, _DstBmp: TBitmap; const _GammaArr: array of TGammaCurve); overload;
+
+type
///<summary>
/// PixelFilter for cutting off R, G and B values at the given CutOff value
/// This reduches brightness of white pixels by cutting of brightness at a given value.
@@ -503,8 +552,11 @@
private
FLowCutOff: Byte;
FHighCutOff: Byte;
- FFactor: Extended;
+ FDivisor: Integer;
procedure StretchColor(var _Color: Byte);
+{$IFDEF SUPPORTS_INLINE}
+ inline;
+{$ENDIF}
public
constructor Create(_LowCutoff, _HighCutoff: Byte);
procedure FilterCallback(_x, _y: Integer; var _Pixel: TdzRgbTriple); overload;
@@ -516,6 +568,9 @@
private
FMoveBy: Integer;
procedure MoveColor(var _Color: Byte);
+{$IFDEF SUPPORTS_INLINE}
+ inline;
+{$ENDIF}
public
constructor Create(_MoveBy: Integer);
procedure FilterCallback(_x, _y: Integer; var _Pixel: TdzRgbTriple); overload;
@@ -556,9 +611,8 @@
uses
Math,
- GraphUtil,
jpeg, // if you get a compile error here you might need to add Vcl.Imaging to the unit scope names
- u_dzConvertUtils;
+ GraphUtil;
function _(const _s: string): string;
{$IFDEF SUPPORTS_INLINE}
@@ -1205,9 +1259,16 @@
{$ENDIF}
procedure TBitmap_SetSize(_bmp: TBitmap; _Width, _Height: Integer);
+{$IFDEF SUPPORTS_INLINE}
+inline;
+{$ENDIF}
begin
+{$IFDEF SUPPPORTS_BITMAP_SETSIZE}
+ _bmp.SetSize(_Width, _Height);
+{$ELSE}
_bmp.Width := _Width;
_bmp.Height := _Height;
+{$ENDIF}
end;
{$IF Declared(TBitmap32)}
@@ -1770,13 +1831,18 @@
end;
procedure TBitmap24_FilterPixels(_SrcBmp, _DstBmp: TBitmap; _Callback: TPixel24FilterCallback);
+const
+ BytesPerPixel = 3;
var
x: Integer;
y: Integer;
w: Integer;
h: Integer;
- SrcLine: PdzRgbTripleArray;
- DstLine: PdzRgbTripleArray;
+ SrcLine: PByte;
+ DstLine: PByte;
+ SrcPixel: PByte;
+ DstPixel: PByte;
+ BytesPerLine: Integer;
begin
Assert(Assigned(_SrcBmp));
@@ -1786,28 +1852,45 @@
h := _SrcBmp.Height;
TBitmap_SetSize(_DstBmp, w, h);
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ SrcLine := _SrcBmp.ScanLine[0];
+ DstLine := _DstBmp.ScanLine[0];
for y := 0 to h - 1 do begin
- SrcLine := _SrcBmp.ScanLine[y];
- DstLine := _DstBmp.ScanLine[y];
+ Assert(SrcLine = _SrcBmp.ScanLine[y]);
+ Assert(DstLine = _DstBmp.ScanLine[y]);
+ SrcPixel := SrcLine;
+ DstPixel := DstLine;
for x := 0 to w - 1 do begin
- DstLine^[x] := SrcLine^[x];
- _Callback(x, y, DstLine^[x]);
+ PdzRgbTriple(DstPixel)^ := PdzRgbTriple(SrcPixel)^;
+ _Callback(x, y, PdzRgbTriple(DstPixel)^);
+ Inc(SrcPixel, BytesPerPixel);
+ Inc(DstPixel, BytesPerPixel);
end;
+ Dec(SrcLine, BytesPerLine);
+ Dec(DstLine, BytesPerLine);
end;
end;
procedure TBitmap8_FilterPixels(_SrcBmp, _DstBmp: TBitmap; _Callback: TPixel8FilterCallback);
+const
+ BytesPerPixel = 1;
var
x: Integer;
y: Integer;
w: Integer;
h: Integer;
- SrcLine: PByteArray;
- DstLine: PByteArray;
+ SrcLine: PByte;
+ DstLine: PByte;
+ SrcPixel: PByte;
+ DstPixel: PByte;
+ BytesPerLine: Integer;
begin
Assert(Assigned(_SrcBmp));
_SrcBmp.PixelFormat := pf8bit;
+ _DstBmp.Assign(nil);
_DstBmp.PixelFormat := pf8bit;
w := _SrcBmp.Width;
h := _SrcBmp.Height;
@@ -1814,16 +1897,264 @@
_DstBmp.Palette := MakeGrayPalette;
TBitmap_SetSize(_DstBmp, w, h);
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ SrcLine := _SrcBmp.ScanLine[0];
+ DstLine := _DstBmp.ScanLine[0];
for y := 0 to h - 1 do begin
- SrcLine := _SrcBmp.ScanLine[y];
- DstLine := _DstBmp.ScanLine[y];
+ Assert(SrcLine = _SrcBmp.ScanLine[y]);
+ Assert(DstLine = _DstBmp.ScanLine[y]);
+ SrcPixel := SrcLine;
+ DstPixel := DstLine;
for x := 0 to w - 1 do begin
- DstLine^[x] := SrcLine^[x];
- _Callback(x, y, DstLine^[x]);
+ DstPixel^ := SrcPixel^;
+ _Callback(x, y, DstPixel^);
+ Inc(SrcPixel, BytesPerPixel);
+ Inc(DstPixel, BytesPerPixel);
end;
+ Dec(SrcLine, BytesPerLine);
+ Dec(DstLine, BytesPerLine);
end;
end;
+procedure TBitmap24_ApplyGamma(_SrcBmp, _DstBmp: TBitmap; const _GammaRed, _GammaGreen, _GammaBlue: TGammaCurve);
+const
+ BytesPerPixel = 3;
+var
+ x: Integer;
+ y: Integer;
+ w: Integer;
+ h: Integer;
+ SrcLine: PByte;
+ DstLine: PByte;
+ SrcPixel: PByte;
+ DstPixel: PByte;
+ DstTriple: PdzRgbTriple;
+ SrcTriple: PdzRgbTriple;
+ BytesPerLine: Integer;
+begin
+ Assert(Assigned(_SrcBmp));
+ Assert(_SrcBmp.PixelFormat = pf24bit);
+
+ _DstBmp.PixelFormat := pf24bit;
+ w := _SrcBmp.Width;
+ h := _SrcBmp.Height;
+ TBitmap_SetSize(_DstBmp, w, h);
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ SrcLine := _SrcBmp.ScanLine[0];
+ DstLine := _DstBmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(SrcLine = _SrcBmp.ScanLine[y]);
+ Assert(DstLine = _DstBmp.ScanLine[y]);
+ SrcPixel := SrcLine;
+ DstPixel := DstLine;
+ for x := 0 to w - 1 do begin
+ SrcTriple := PdzRgbTriple(SrcPixel);
+ DstTriple := PdzRgbTriple(DstPixel);
+ DstTriple.Red := _GammaRed[SrcTriple.Red];
+ DstTriple.Green := _GammaGreen[SrcTriple.Green];
+ DstTriple.Blue := _GammaBlue[SrcTriple.Blue];
+ Inc(SrcPixel, BytesPerPixel);
+ Inc(DstPixel, BytesPerPixel);
+ end;
+ Dec(SrcLine, BytesPerLine);
+ Dec(DstLine, BytesPerLine);
+ end;
+end;
+
+procedure TBitmap24_ApplyGamma(_SrcBmp, _DstBmp: TBitmap; const _Gamma: TGammaCurve);
+const
+ BytesPerPixel = 3;
+var
+ x: Integer;
+ y: Integer;
+ w: Integer;
+ h: Integer;
+ SrcLine: PByte;
+ DstLine: PByte;
+ SrcPixel: PByte;
+ DstPixel: PByte;
+ DstTriple: PdzRgbTriple;
+ SrcTriple: PdzRgbTriple;
+ BytesPerLine: Integer;
+begin
+ Assert(Assigned(_SrcBmp));
+ Assert(_SrcBmp.PixelFormat = pf24bit);
+
+ _DstBmp.PixelFormat := pf24bit;
+ w := _SrcBmp.Width;
+ h := _SrcBmp.Height;
+ TBitmap_SetSize(_DstBmp, w, h);
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ SrcLine := _SrcBmp.ScanLine[0];
+ DstLine := _DstBmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(SrcLine = _SrcBmp.ScanLine[y]);
+ Assert(DstLine = _DstBmp.ScanLine[y]);
+ SrcPixel := SrcLine;
+ DstPixel := DstLine;
+ for x := 0 to w - 1 do begin
+ SrcTriple := PdzRgbTriple(SrcPixel);
+ DstTriple := PdzRgbTriple(DstPixel);
+ DstTriple.Red := _Gamma[SrcTriple.Red];
+ DstTriple.Green := _Gamma[SrcTriple.Green];
+ DstTriple.Blue := _Gamma[SrcTriple.Blue];
+ Inc(SrcPixel, BytesPerPixel);
+ Inc(DstPixel, BytesPerPixel);
+ end;
+ Dec(SrcLine, BytesPerLine);
+ Dec(DstLine, BytesPerLine);
+ end;
+end;
+
+procedure TBitmap24_ApplyGammaTo8(_SrcBmp, _DstBmp: TBitmap; const _Gamma: TGammaCurve); overload;
+const
+ BytesPerPixelInput = 3;
+ BytesPerPixelOutput = 1;
+var
+ x: Integer;
+ y: Integer;
+ w: Integer;
+ h: Integer;
+ SrcLine: PByte;
+ DstLine: PByte;
+ SrcPixel: PByte;
+ DstPixel: PByte;
+ BytesPerLineInput: Integer;
+ BytesPerLineOutput: Integer;
+begin
+ Assert(Assigned(_SrcBmp));
+ Assert(_SrcBmp.PixelFormat = pf24bit);
+
+ w := _SrcBmp.Width;
+ h := _SrcBmp.Height;
+ _DstBmp.Assign(nil);
+ TBitmap_MakeMono8(_DstBmp);
+ TBitmap_SetSize(_DstBmp, w, h);
+
+ BytesPerLineInput := ((w * 8 * BytesPerPixelInput + 31) and not 31) div 8;
+ Assert(BytesPerLineInput = Graphics.BytesPerScanline(w, BytesPerPixelInput * 8, 32));
+
+ BytesPerLineOutput := ((w * 8 * BytesPerPixelOutput + 31) and not 31) div 8;
+ Assert(BytesPerLineOutput = Graphics.BytesPerScanline(w, BytesPerPixelOutput * 8, 32));
+
+ SrcLine := _SrcBmp.ScanLine[0];
+ DstLine := _DstBmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(SrcLine = _SrcBmp.ScanLine[y]);
+ Assert(DstLine = _DstBmp.ScanLine[y]);
+ SrcPixel := SrcLine;
+ DstPixel := DstLine;
+ for x := 0 to w - 1 do begin
+ DstPixel^ := _Gamma[SrcPixel^];
+ Inc(SrcPixel, BytesPerPixelInput);
+ Inc(DstPixel, BytesPerPixelOutput);
+ end;
+ Dec(SrcLine, BytesPerLineInput);
+ Dec(DstLine, BytesPerLineOutput);
+ end;
+end;
+
+procedure TBitmap8_ApplyGamma(_SrcBmp, _DstBmp: TBitmap; const _Gamma: TGammaCurve);
+const
+ BytesPerPixel = 1;
+var
+ x: Integer;
+ y: Integer;
+ w: Integer;
+ h: Integer;
+ SrcLine: PByte;
+ DstLine: PByte;
+ SrcPixel: PByte;
+ DstPixel: PByte;
+ BytesPerLine: Integer;
+begin
+ Assert(Assigned(_SrcBmp));
+ Assert(_SrcBmp.PixelFormat = pf8bit);
+
+ _DstBmp.Assign(nil);
+ _DstBmp.PixelFormat := pf8bit;
+ w := _SrcBmp.Width;
+ h := _SrcBmp.Height;
+ _DstBmp.Palette := MakeGrayPalette;
+ TBitmap_SetSize(_DstBmp, w, h);
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ SrcLine := _SrcBmp.ScanLine[0];
+ DstLine := _DstBmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(SrcLine = _SrcBmp.ScanLine[y]);
+ Assert(DstLine = _DstBmp.ScanLine[y]);
+ SrcPixel := SrcLine;
+ DstPixel := DstLine;
+ for x := 0 to w - 1 do begin
+ DstPixel^ := _Gamma[SrcPixel^];
+ Inc(SrcPixel, BytesPerPixel);
+ Inc(DstPixel, BytesPerPixel);
+ end;
+ Dec(SrcLine, BytesPerLine);
+ Dec(DstLine, BytesPerLine);
+ end;
+end;
+
+procedure TBitmap8_ApplyMultiGamma(_SrcBmp, _DstBmp: TBitmap; const _GammaArr: array of TGammaCurve);
+const
+ BytesPerPixel = 1;
+var
+ x: Integer;
+ y: Integer;
+ w: Integer;
+ h: Integer;
+ SrcLine: PByte;
+ DstLine: PByte;
+ SrcPixel: PByte;
+ DstPixel: PByte;
+ BytesPerLine: Integer;
+ i: Integer;
+ Value: Byte;
+begin
+ Assert(Assigned(_SrcBmp));
+ Assert(_SrcBmp.PixelFormat = pf8bit);
+
+ _DstBmp.Assign(nil);
+ _DstBmp.PixelFormat := pf8bit;
+ w := _SrcBmp.Width;
+ h := _SrcBmp.Height;
+ _DstBmp.Palette := MakeGrayPalette;
+ TBitmap_SetSize(_DstBmp, w, h);
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ SrcLine := _SrcBmp.ScanLine[0];
+ DstLine := _DstBmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(SrcLine = _SrcBmp.ScanLine[y]);
+ Assert(DstLine = _DstBmp.ScanLine[y]);
+ SrcPixel := SrcLine;
+ DstPixel := DstLine;
+ for x := 0 to w - 1 do begin
+ Value := SrcPixel^;
+ for i := Low(_GammaArr) to High(_GammaArr) do
+ Value := _GammaArr[i][Value];
+ DstPixel^ := Value;
+ Inc(SrcPixel, BytesPerPixel);
+ Inc(DstPixel, BytesPerPixel);
+ end;
+ Dec(SrcLine, BytesPerLine);
+ Dec(DstLine, BytesPerLine);
+ end;
+end;
+
// source: https://www.swissdelphicenter.ch/en/showcode.php?id=1948
procedure TBitmap_Sharpen(_SrcBmp, _DstBmp: TBitmap; _Alpha: Single);
@@ -1880,7 +2211,7 @@
WorkAreaWidth := _SrcBmp.Width - 2;
WorkAreaHeight := _SrcBmp.Height - 2;
BytesPerLine := (((WorkAreaWidth + 2) * 8 * BytesPerPixel + 31) and not 31) div 8;
-// Assert(BytesPerLine = Graphics.BytesPerScanline(WorkAreaWidth + 2, BytesPerPixel * 8, 32));
+ Assert(BytesPerLine = Graphics.BytesPerScanline(WorkAreaWidth + 2, BytesPerPixel * 8, 32));
// Copy first row unchanged
SrcRow := _SrcBmp.ScanLine[0];
@@ -2135,6 +2466,8 @@
CenterBrightness: Integer;
AvgBrightness: Integer;
BytesPerLine: Integer;
+ AlphaEntrySize: NativeInt;
+ AlphaPtr: PSingle;
begin
// sharpening is blending of the current pixel
// with the average of the surrounding ones,
@@ -2151,8 +2484,10 @@
WorkAreaWidth := _SrcBmp.Width - 2;
WorkAreaHeight := _SrcBmp.Height - 2;
BytesPerLine := (((WorkAreaWidth + 2) * 8 * BytesPerPixel + 31) and not 31) div 8;
-// Assert(BytesPerLine = Graphics.BytesPerScanline(WorkAreaWidth + 2, BytesPerPixel * 8, 32));
+ Assert(BytesPerLine = Graphics.BytesPerScanline(WorkAreaWidth + 2, BytesPerPixel * 8, 32));
+ AlphaEntrySize := PtrDiff(@(_AlphaMap[0][1]), @(_AlphaMap[0][0]));
+
SrcRow := _SrcBmp.ScanLine[0];
DstRow := _DstBmp.ScanLine[0];
SrcPixelCenter := PPixel(SrcRow);
@@ -2192,10 +2527,12 @@
SrcPixelTop := PPixel(Integer(SrcPixelCenter) + BytesPerLine);
SrcPixelBottom := PPixel(Integer(SrcPixelCenter) - BytesPerLine);
+ AlphaPtr := @(_AlphaMap[Row][0]);
for Column := 1 to WorkAreaWidth do begin
CenterBrightness := SrcPixelCenter^;
- Alpha := _AlphaMap[Row][Column];
+ Assert(AlphaPtr = @(_AlphaMap[Row][Column]));
+ Alpha := AlphaPtr^;
Assert((Alpha >= 0) and (Alpha <= 5), Format('Alpha[%d][%d] must be >=1 and <=5', [Row, Column]));
// since 0 <= Alpha <= 5 we can be sure that 0 <= Beta <= 1
Beta := Alpha / 5;
@@ -2232,6 +2569,8 @@
Inc(SrcPixelCenter);
Inc(SrcPixelRight);
Inc(SrcPixelBottom);
+
+ AlphaPtr := AddToPtr(AlphaPtr, AlphaEntrySize);
end;
// copy Last column unchanged
@@ -2454,6 +2793,11 @@
Result := Pointer(NativeInt(_Ptr) + _Offset);
end;
+function PtrDiff(const _Ptr1, _Ptr2: Pointer): NativeInt; inline;
+begin
+ Result := NativeInt(_Ptr1) - NativeInt(_Ptr2);
+end;
+
function TBitmap8_TryCalcAverage(_bmp: TBitmap; _LowCutoff, _HighCutoff: Byte;
out _Average: Byte): Boolean;
const
@@ -2463,9 +2807,10 @@
h: Integer;
x: Integer;
y: Integer;
- ScanLine: PByteArray;
+ ScanLine: PByte;
+ Pixel: PByte;
Value: Byte;
- Sum: Extended;
+ Sum: Integer;
cnt: Integer;
BytesPerLine: Integer;
begin
@@ -2479,18 +2824,20 @@
ScanLine := _bmp.ScanLine[0];
for y := 0 to h - 1 do begin
Assert(ScanLine = _bmp.ScanLine[y]);
+ Pixel := ScanLine;
for x := 0 to w - 1 do begin
- Value := ScanLine^[x];
+ Value := Pixel^;
if (Value >= _LowCutoff) and (Value <= _HighCutoff) then begin
Sum := Sum + Value;
Inc(cnt);
end;
+ Inc(Pixel, BytesPerPixel);
end;
- ScanLine := AddToPtr(ScanLine, -BytesPerLine);
+ Dec(ScanLine, BytesPerLine);
end;
Result := (cnt > 0);
if Result then
- _Average := Round(Sum / cnt);
+ _Average := Sum div cnt;
end;
function TBitmap24_TryCalcAverage(_bmp: TBitmap; _LowCutoff, _HighCutoff: Byte;
@@ -2503,14 +2850,12 @@
h: Integer;
x: Integer;
y: Integer;
- ScanLine: PdzRgbTripleArray;
+ ScanLine: PByte;
+ Pixel: PByte;
Value: Byte;
- Sum: Extended;
+ Sum: Integer;
cnt: Integer;
BytesPerLine: Integer;
-{$IFNDEF SUPPORTS_ENHANCED_RECORDS}
- Pixel: ^TdzRgbTriple;
-{$ENDIF}
begin
w := _bmp.Width;
h := _bmp.Height;
@@ -2522,25 +2867,69 @@
ScanLine := _bmp.ScanLine[0];
for y := 0 to h - 1 do begin
Assert(ScanLine = _bmp.ScanLine[y]);
+ Pixel := ScanLine;
for x := 0 to w - 1 do begin
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
- Value := ScanLine^[x].GetBrightness(_Channel);
+ Value := PdzRgbTriple(Pixel).GetBrightness(_Channel);
{$ELSE}
- Pixel := @(ScanLine^[x]);
- Value := GetRgbBrightness(Pixel.Red, Pixel.Green, Pixel.Blue, _Channel);
+ Value := GetRgbBrightness(PdzRgbTriple(Pixel).Red, PdzRgbTriple(Pixel).Green, PdzRgbTriple(Pixel).Blue, _Channel);
{$ENDIF}
if (Value >= _LowCutoff) and (Value <= _HighCutoff) then begin
Sum := Sum + Value;
Inc(cnt);
end;
+ Inc(Pixel, BytesPerPixel);
end;
- ScanLine := AddToPtr(ScanLine, -BytesPerLine);
+ Dec(ScanLine, BytesPerLine);
end;
Result := (cnt > 0);
if Result then
- _Average := Round(Sum / cnt);
+ _Average := Sum div cnt;
end;
+function TBitmap24_TryCalcAverageBlue(_bmp: TBitmap; _LowCutoff, _HighCutoff: Byte;
+ out _Average: Byte): Boolean;
+const
+ BytesPerPixel = SizeOf(TdzRgbTriple);
+var
+ w: Integer;
+ h: Integer;
+ x: Integer;
+ y: Integer;
+ ScanLine: PByte;
+ Pixel: PByte;
+ Value: Byte;
+ Sum: Integer;
+ cnt: Integer;
+ BytesPerLine: Integer;
+begin
+ w := _bmp.Width;
+ h := _bmp.Height;
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ Sum := 0;
+ cnt := 0;
+ ScanLine := _bmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(ScanLine = _bmp.ScanLine[y]);
+ Pixel := ScanLine;
+ for x := 0 to w - 1 do begin
+ // the first byte of the triple is the blue value
+ Value := Pixel^;
+ if (Value >= _LowCutoff) and (Value <= _HighCutoff) then begin
+ Sum := Sum + Value;
+ Inc(cnt);
+ end;
+ Inc(Pixel, BytesPerPixel);
+ end;
+ Dec(ScanLine, BytesPerLine);
+ end;
+ Result := (cnt > 0);
+ if Result then
+ _Average := Sum div cnt;
+end;
+
function ColorBrightness(_Red, _Green, _Blue: Byte): Byte;
begin
Result := GetFastLuminance(_Red, _Green, _Blue);
@@ -2612,7 +3001,7 @@
inherited Create;
FLowCutOff := _LowCutoff;
FHighCutOff := _HighCutoff;
- FFactor := 256 / (_HighCutoff - _LowCutoff);
+ FDivisor := _HighCutoff - _LowCutoff;
end;
procedure TPixelFilterStretch.StretchColor(var _Color: Byte);
@@ -2621,10 +3010,8 @@
begin
Value := _Color;
if (Value > FLowCutOff) and (Value < FHighCutOff) then begin
- Value := Round((Value - FLowCutOff) * FFactor);
- if Value > 255 then
- Value := 255;
- _Color := Value;
+ Value := ((Value - FLowCutOff) * 256) div FDivisor;
+ _Color := ReduceToByte(Value);
end;
end;
@@ -2656,13 +3043,9 @@
var
Value: Integer;
begin
- Value := _Color + FMoveBy;
- if Value < 0 then
- _Color := 0
- else if Value > 255 then
- _Color := 255
- else
- _Color := Value;
+ Value := _Color;
+ Value := Value + FMoveBy;
+ _Color := ReduceToByte(Value);
end;
procedure TPixelFilterMove.FilterCallback(_x, _y: Integer; var _Pixel: TdzRgbTriple);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-02-02 15:03:39
|
Revision: 3046
http://sourceforge.net/p/gexperts/code/3046
Author: twm
Date: 2020-02-02 15:03:37 +0000 (Sun, 02 Feb 2020)
Log Message:
-----------
fixed Delphi 6 compile errors
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-02-02 14:59:35 UTC (rev 3045)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-02-02 15:03:37 UTC (rev 3046)
@@ -584,7 +584,7 @@
Result := '0' + Result;
end;
-function ReduceToByte(const _Value: Integer): Byte; inline;
+function ReduceToByte(const _Value: Integer): Byte;
begin
if _Value < 0 then
Result := 0
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-02-02 14:59:35 UTC (rev 3045)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-02-02 15:03:37 UTC (rev 3046)
@@ -87,7 +87,7 @@
inline;
{$ENDIF}
-function PtrDiff(const _Ptr1, _Ptr2: Pointer): NativeInt; inline;
+function PtrDiff(const _Ptr1, _Ptr2: Pointer): NativeInt;
{$IFDEF SUPPORTS_INLINE}
inline;
{$ENDIF}
@@ -2793,7 +2793,7 @@
Result := Pointer(NativeInt(_Ptr) + _Offset);
end;
-function PtrDiff(const _Ptr1, _Ptr2: Pointer): NativeInt; inline;
+function PtrDiff(const _Ptr1, _Ptr2: Pointer): NativeInt;
begin
Result := NativeInt(_Ptr1) - NativeInt(_Ptr2);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-02-29 18:55:06
|
Revision: 3054
http://sourceforge.net/p/gexperts/code/3054
Author: twm
Date: 2020-02-29 18:55:04 +0000 (Sat, 29 Feb 2020)
Log Message:
-----------
synced with dzlib from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzFileUtils.pas
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
trunk/ExternalSource/dzlib/u_dzNamedThread.pas
trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas
trunk/ExternalSource/dzlib/u_dzStringUtils.pas
trunk/ExternalSource/dzlib/u_dzTranslator.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-02-29 18:55:04 UTC (rev 3054)
@@ -9,12 +9,19 @@
{$DEFINE SUPPPORTS_BITMAP_SETSIZE}
{$ENDIF}
-
{$IFDEF DELPHI2005_UP}
// Delphi 6 and 7 understood deprecated, but not for types
{$DEFINE SUPPORTS_DEPRECATED_TYPES}
{$ENDIF}
+{$IFDEF DELPHI7_UP}
+{$IFNDEF DELPHI_2009_UP}
+// Between Delphi 7 and 2007 Native(U)Int is wrongly declared as a 64 bit integer even though
+// the compiler only supports 32 bits.
+{$DEFINE NATIVE_INT_IS_WRONG}
+{$ENDIF}
+{$ENDIF}
+
{$IFDEF DELPHIX_TOKYO_UP}
{$DEFINE FILECTRL_DIRECTORYEXISTS_IS_DEPRECATED}
{$ENDIF}
@@ -32,7 +39,11 @@
{$DEFINE THANDLESTREAM_CREATE_HANDLE_IS_THANDLE}
{$ENDIF}
+{$IFDEF DELPHIX_TOKYO_UP}
+// this function probably already exist in earlier versions, I just run across a compile error for 10.2 Tokyo
+{$DEFINE HAS_INTTOHEX_FUNCTION}
+{$ENDIF}
+
{$WARN SYMBOL_PLATFORM OFF}
{$WARN UNIT_PLATFORM OFF}
-
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-02-29 18:55:04 UTC (rev 3054)
@@ -306,10 +306,19 @@
HoursPerDay = 24;
MinutesPerDay = HoursPerDay * MinutesPerHour;
SecondsPerDay = MinutesPerDay * SecondsPerMinute;
- MillisecondsPerMinute = SecondsPerMinute * 1000;
- MillisecondsPerHour = SecondsPerHour * 1000;
- MillisecondsPerDay = SecondsPerDay * 1000;
+ MillisecondsPerSecond = 1000;
+ MillisecondsPerMinute = SecondsPerMinute * MillisecondsPerSecond;
+ MillisecondsPerHour = SecondsPerHour * MillisecondsPerSecond;
+ MillisecondsPerDay = SecondsPerDay * MillisecondsPerSecond;
+ MicrosecondsPerMillisecond = 1000;
+ MicrosecondsPerSecond = MillisecondsPerSecond * MicrosecondsPerMillisecond;
+ MicrosecondsPerMinute = Int64(SecondsPerMinute) * MicrosecondsPerSecond;
+ MicrosecondsPerHour = Int64(SecondsPerHour) * MicrosecondsPerSecond;
+ MicrosecondsPerDay = Int64(SecondsPerDay) * MicrosecondsPerSecond;
+const
+ OneMicrosecond = 1 / MSecsPerDay / 1000;
+
///<summary>
/// returns a human readable string of the form '5d 23h' or '25h 15m' or '20m 21s' </summary>
function SecondsToHumanReadableString(_Seconds: Int64): string; overload;
Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2020-02-29 18:55:04 UTC (rev 3054)
@@ -355,7 +355,7 @@
/// wraps the windows API function GetFullPathName </summary>
class function GetFullPathName(const _fn: string): string;
{$IFDEF SUPPORTS_STATIC}
- static;
+ static;
{$ENDIF}
/// <summary>
/// Returns a temporary filename.
@@ -862,6 +862,18 @@
/// @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;
+ /// <summary>
+ /// Moves the file to a new, unique name, appending the current date and time to the base
+ /// file name. If the move operation fails, an underscore and a number will be appended
+ /// to the filename. That number will be incremented, until the copy operation succeeds
+ /// or it reaches 999.
+ /// See also TFileGenerationHandler and GenerateBackupFilename.
+ /// @param Filename is the name of the file to move
+ /// @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 the file has been moved to.
+ /// @raises EBackupFailed if the copy operation failed even for the 1000th attempt. </summary>
+ class function MoveFileToBackup(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
@@ -871,7 +883,7 @@
/// @returns the full filename for the backup file </summary>
class function GenerateBackupFilename(const _Filename: string; _BackupDir: string = ''): string;
{$IFDEF SUPPORTS_STATIC}
- static;
+ static;
{$ENDIF}
///<summary>
@@ -890,7 +902,7 @@
/// see also AppendDate and AppendDateAndTime </summary>
class function AppendDateTime(const _Filename: string; _DateTime: TDateTime; _IncludeTime: Boolean): string; overload;
{$IFDEF SUPPORTS_STATIC}
- static;
+ static;
{$ENDIF}
///<summary>
@@ -897,7 +909,7 @@
/// Appends the current date to the filename in the format _YYYY-MM-DD </summary>
class function AppendDate(const _Filename: string): string; overload;
{$IFDEF SUPPORTS_STATIC}
- static;
+ static;
{$ENDIF}
///<summary>
@@ -904,7 +916,7 @@
/// Appends the given date to the filename in the format _YYYY-MM-DD </summary>
class function AppendDate(const _Filename: string; _Date: TDateTime): string; overload;
{$IFDEF SUPPORTS_STATIC}
- static;
+ static;
{$ENDIF}
///<summary>
@@ -911,7 +923,7 @@
/// 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;
{$IFDEF SUPPORTS_STATIC}
- static;
+ static;
{$ENDIF}
///<summary>
@@ -918,7 +930,7 @@
/// 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;
{$IFDEF SUPPORTS_STATIC}
- static;
+ static;
{$ENDIF}
/// <summary>
@@ -1070,6 +1082,12 @@
end;
type
+ // TFilename might not be this record, because there are multiple declarations of this type
+ // in the RTL and other libraries, so it depends on the units included and their order which
+ // one is used. TdzFilename will always be this record.
+ TdzFilename = TFilename;
+
+type
TSearchPath = record
private
FValue: string;
@@ -1940,6 +1958,36 @@
+ BackupFilename.Extension;
end;
end;
+
+class function TFileSystem.MoveFileToBackup(const _Filename: string; const _BackupDir: string = ''): string;
+var
+ i: Integer;
+ BackupFilename: TFilename;
+ LastError: Cardinal;
+ ErrorMessage: string;
+begin
+ BackupFilename := GenerateBackupFilename(_Filename, _BackupDir);
+ Result := BackupFilename;
+
+ ForceDir(ExtractFilePath(BackupFilename));
+
+ i := 0;
+ while not Self.MoveFileEx(_Filename, Result, [mfCopyAllowed], ehReturnFalse) do begin
+ Inc(i);
+ if i = 1000 then begin
+ LastError := GetLastError;
+ ErrorMessage := SysErrorMessage(LastError);
+ raise EBackupFailed.CreateFmt(
+ _('Failed to create a backup of "%s". Tried 1000 different file names based on "%s".')
+ + ' (%s)',
+ [_Filename, BackupFilename.Filename, ErrorMessage]);
+ end;
+ Result := BackupFilename.DirectoryBS
+ + BackupFilename.FilenameOnly + '_' + IntToStr(i)
+ + BackupFilename.Extension;
+ end;
+end;
+
{$ENDIF}
class function TFileSystem.ContainsWildcard(const _Mask: string): Boolean;
@@ -2139,7 +2187,7 @@
class function TFileSystem.CopyMatchingFiles(const _Mask, _SrcDir, _DestDir: string;
_Flags: TCopyFileFlagSet; _FilesSkipped: TStrings = nil): Integer;
var
- i: integer;
+ i: Integer;
Files: TStringList;
s: string;
SrcDirBs: string;
@@ -2151,7 +2199,7 @@
Files := TStringList.Create;
try
TSimpleDirEnumerator.Execute(SrcDirBs + _Mask, Files, [dfaHidden, dfaSysFile, dfaArchive]);
- for i := 0 to Files.Count -1 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)
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-02-29 18:55:04 UTC (rev 3054)
@@ -4,6 +4,8 @@
{$IFDEF OPTIMIZE_DZ_GRAPHIC_UTILS}
{$OPTIMIZATION ON}
+{$RANGECHECKS OFF}
+{$OVERFLOWCHECKS OFF}
{$ENDIF}
{$IFOPT O-} // Optimization
@@ -15,6 +17,14 @@
{$C-} // this is the short form for $ASSERTIONS OFF
{$ENDIF}
+{$IFOPT Q+}
+{$MESSAGE WARN 'Overflow checking is on, consider turning it off for significantly better performance'}
+{$ENDIF}
+
+{$IFOPT R+}
+{$MESSAGE WARN 'Range checking is on, consider turning it off for significantly better performance'}
+{$ENDIF}
+
{.$DEFINE dzUseGraphics32}
interface
@@ -28,6 +38,7 @@
GR32, // libs\graphics32\src
{$ENDIF}
u_dzTranslator,
+ u_dzTypes,
u_dzConvertUtils,
u_dzTypesUtils;
@@ -440,9 +451,6 @@
inline;
{$ENDIF}
-type
- TSingleMatrix = array of array of Single;
-
///<summary>
/// Sharpens a bitmap, pixelformat must be pf24bit
/// @param SrcBmp is the input
@@ -1525,10 +1533,6 @@
// original source: http://www.delphigeist.com/2009/09/blur-bitmap-algorithm.html
// but heavily modified
-type
- TByteMatrix = array of array of Byte;
- TBitMatrix = array of array of Boolean;
-
procedure BlurBuffer(const _In: TByteMatrix; out _out: TByteMatrix);
var
w: Integer;
@@ -1852,6 +1856,9 @@
h := _SrcBmp.Height;
TBitmap_SetSize(_DstBmp, w, h);
+ if h = 0 then
+ Exit; //==>
+
BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
@@ -1897,6 +1904,9 @@
_DstBmp.Palette := MakeGrayPalette;
TBitmap_SetSize(_DstBmp, w, h);
+ if h = 0 then
+ Exit; //==>
+
BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
@@ -1942,6 +1952,9 @@
h := _SrcBmp.Height;
TBitmap_SetSize(_DstBmp, w, h);
+ if h = 0 then
+ Exit; //==>
+
BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
@@ -1990,6 +2003,9 @@
h := _SrcBmp.Height;
TBitmap_SetSize(_DstBmp, w, h);
+ if h = 0 then
+ Exit; //==>
+
BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
@@ -2039,6 +2055,9 @@
TBitmap_MakeMono8(_DstBmp);
TBitmap_SetSize(_DstBmp, w, h);
+ if h = 0 then
+ Exit; //==>
+
BytesPerLineInput := ((w * 8 * BytesPerPixelInput + 31) and not 31) div 8;
Assert(BytesPerLineInput = Graphics.BytesPerScanline(w, BytesPerPixelInput * 8, 32));
@@ -2086,6 +2105,9 @@
_DstBmp.Palette := MakeGrayPalette;
TBitmap_SetSize(_DstBmp, w, h);
+ if h = 0 then
+ Exit; //==>
+
BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
@@ -2132,6 +2154,9 @@
_DstBmp.Palette := MakeGrayPalette;
TBitmap_SetSize(_DstBmp, w, h);
+ if h = 0 then
+ Exit; //==>
+
BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
@@ -2262,14 +2287,8 @@
// add center pixel weighted by alpha
AvgBrightness := (IntAlpha * CenterBrightness + $7FFF) shr 16 - AvgBrightness;
- // ensure range
- if AvgBrightness < 0 then
- AvgBrightness := 0
- else if AvgBrightness > 255 then
- AvgBrightness := 255;
+ DstPixel^ := ReduceToByte(AvgBrightness);
- DstPixel^ := AvgBrightness;
-
Inc(DstPixel);
Inc(SrcPixelTop);
@@ -2391,24 +2410,10 @@
AvgGreen := (IntAlpha * p^.rgbtGreen + $7FFF) shr 16 - AvgGreen;
AvgBlue := (IntAlpha * p^.rgbtBlue + $7FFF) shr 16 - AvgBlue;
- // ensure range (this looks stupid, but avoids function calls)
- if AvgRed < 0 then
- AvgRed := 0
- else if AvgRed > 255 then
- AvgRed := 255;
- if AvgGreen < 0 then
- AvgGreen := 0
- else if AvgGreen > 255 then
- AvgGreen := 255;
- if AvgBlue < 0 then
- AvgBlue := 0
- else if AvgBlue > 255 then
- AvgBlue := 255;
-
Inc(DstPixel);
- DstPixel^.rgbtRed := AvgRed;
- DstPixel^.rgbtGreen := AvgGreen;
- DstPixel^.rgbtBlue := AvgBlue;
+ DstPixel^.rgbtRed := ReduceToByte(AvgRed);
+ DstPixel^.rgbtGreen := ReduceToByte(AvgGreen);
+ DstPixel^.rgbtBlue := ReduceToByte(AvgBlue);
end;
Inc(DstPixel);
Inc(SrcPixels[1]);
@@ -2527,7 +2532,7 @@
SrcPixelTop := PPixel(Integer(SrcPixelCenter) + BytesPerLine);
SrcPixelBottom := PPixel(Integer(SrcPixelCenter) - BytesPerLine);
- AlphaPtr := @(_AlphaMap[Row][0]);
+ AlphaPtr := @(_AlphaMap[Row][1]);
for Column := 1 to WorkAreaWidth do begin
CenterBrightness := SrcPixelCenter^;
@@ -2553,14 +2558,8 @@
// add center pixel weighted by alpha
AvgBrightness := (IntAlpha * CenterBrightness + $7FFF) shr 16 - AvgBrightness;
- // ensure range
- if AvgBrightness < 0 then
- AvgBrightness := 0
- else if AvgBrightness > 255 then
- AvgBrightness := 255;
-
// write into the target pixel
- DstPixel^ := AvgBrightness;
+ DstPixel^ := ReduceToByte(AvgBrightness);
Inc(DstPixel);
@@ -2695,25 +2694,11 @@
AvgGreen := (IntAlpha * p^.rgbtGreen + $7FFF) shr 16 - AvgGreen;
AvgBlue := (IntAlpha * p^.rgbtBlue + $7FFF) shr 16 - AvgBlue;
- // ensure range (this looks stupid, but avoids function calls)
- if AvgRed < 0 then
- AvgRed := 0
- else if AvgRed > 255 then
- AvgRed := 255;
- if AvgGreen < 0 then
- AvgGreen := 0
- else if AvgGreen > 255 then
- AvgGreen := 255;
- if AvgBlue < 0 then
- AvgBlue := 0
- else if AvgBlue > 255 then
- AvgBlue := 255;
-
// write into the target pixel
Inc(DstPixel);
- DstPixel^.rgbtRed := AvgRed;
- DstPixel^.rgbtGreen := AvgGreen;
- DstPixel^.rgbtBlue := AvgBlue;
+ DstPixel^.rgbtRed := ReduceToByte(AvgRed);
+ DstPixel^.rgbtGreen := ReduceToByte(AvgGreen);
+ DstPixel^.rgbtBlue := ReduceToByte(AvgBlue);
end;
Inc(DstPixel);
Inc(SrcPixels[1]);
@@ -2814,8 +2799,14 @@
cnt: Integer;
BytesPerLine: Integer;
begin
+ h := _bmp.Height;
+ if h = 0 then begin
+ Result := False;
+ Exit; //==>
+ end;
+
w := _bmp.Width;
- h := _bmp.Height;
+
BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
@@ -2857,8 +2848,15 @@
cnt: Integer;
BytesPerLine: Integer;
begin
+ h := _bmp.Height;
+
+ if h = 0 then begin
+ Result := False;
+ Exit; //==>
+ end;
+
w := _bmp.Width;
- h := _bmp.Height;
+
BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
@@ -2903,8 +2901,15 @@
cnt: Integer;
BytesPerLine: Integer;
begin
+ h := _bmp.Height;
+
+ if h = 0 then begin
+ Result := False;
+ Exit; //==>
+ end;
+
w := _bmp.Width;
- h := _bmp.Height;
+
BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
Modified: trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-02-29 18:55:04 UTC (rev 3054)
@@ -17,6 +17,7 @@
unit u_dzMiscUtils;
{$INCLUDE 'dzlib.inc'}
+{.$INCLUDE 'jedi.inc'}
interface
@@ -78,11 +79,13 @@
///<summary> converts a hexdump of an extended back to an extended value </summary>
procedure HexDumpToExtended(const _s: string; var _Value: Extended);
+{$IFNDEF HAS_INTTOHEX_FUNCTION}
///<summary> converts an integer to a 8 digit hex string </summary>
function IntToHex(_Value: Integer): string; overload;
///<summary> converts an In64 to a 16 digit hex string </summary>
function IntToHex(_Value: Int64): string; overload;
+{$ENDIF HAS_INTTOHEX_FUNCTION}
///<summary> Converts an integer to a boolean.
/// @param Int is the integer to convert
@@ -514,6 +517,7 @@
end;
end;
+{$IFNDEF HAS_INTTOHEX_FUNCTION}
function IntToHex(_Value: Integer): string;
begin
Result := IntToHex(_Value, SizeOf(_Value) * 2);
@@ -523,6 +527,7 @@
begin
Result := IntToHex(_Value, SizeOf(_Value) * 2);
end;
+{$ENDIF HAS_INTTOHEX_FUNCTION}
type
PStringDescriptor = ^TStringDescriptor;
Modified: trunk/ExternalSource/dzlib/u_dzNamedThread.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzNamedThread.pas 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/u_dzNamedThread.pas 2020-02-29 18:55:04 UTC (rev 3054)
@@ -36,9 +36,12 @@
protected
FThreadName: string;
///<summary>
- /// Calls SetThreadName with FThreadName </summary>
- procedure SetName; virtual;
+ /// Calls SetName with FThreadName </summary>
+ procedure SetName; overload; virtual;
///<summary>
+ /// @note: Do *not* make this a class method! </summary>
+ procedure SetName(const _Name: string); overload; virtual;
+ ///<summary>
/// Calls SetName </summary>
procedure Execute; override;
function GetThreadName: string;
@@ -92,9 +95,14 @@
Result := FThreadName;
end;
+procedure TNamedThread.SetName(const _Name: string);
+begin
+ SetThreadName(AnsiString(_Name));
+end;
+
procedure TNamedThread.SetName;
begin
- SetThreadName(AnsiString(FThreadName));
+ SetName(FThreadName);
end;
initialization
@@ -101,4 +109,3 @@
// set the name for the main thread to 'Main'
SetThreadName('Main');
end.
-
Modified: trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas 2020-02-29 18:55:04 UTC (rev 3054)
@@ -4,6 +4,7 @@
unit u_dzSelectDirectoryFix;
{$INCLUDE 'dzlib.inc'}
+{.$INCLUDE 'jedi.inc'}
interface
@@ -11,6 +12,9 @@
Windows,
SysUtils,
FileCtrl,
+{$IFDEF HAS_UNIT_SYSTEM_UITYPES}
+ UITypes,
+{$ENDIF}
Controls;
{$IF not Declared(TSelectDirExtOpt)}
Modified: trunk/ExternalSource/dzlib/u_dzStringUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2020-02-29 18:55:04 UTC (rev 3054)
@@ -161,7 +161,9 @@
///<summary>
/// Replaces an existing extension in Name with Ext or adds Ext to Name if
/// it does not have an extension.
-/// Consider using TFileSystem.ChangeFileExtFull or .ChangeFileExtLast instead. </summary>
+/// @param Name is the (file) name to which the extension is to be added.
+/// @param Ext is the extension, Note that a dot (.) will be prefixed if there is none
+/// NOTE: Consider using TFileSystem.ChangeFileExtFull or .ChangeFileExtLast instead. </summary>
function ForceExtension(const _Name, _Ext: string): string;
///<summary>
/// Returns only the filename (incl. extension) portion of Name. </summary>
Modified: trunk/ExternalSource/dzlib/u_dzTranslator.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTranslator.pas 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/u_dzTranslator.pas 2020-02-29 18:55:04 UTC (rev 3054)
@@ -346,6 +346,10 @@
AddDomainForResourceString('delphi100');
{$ELSE}{$IFDEF DELPHIX_BERLIN}
AddDomainForResourceString('delphi101');
+{$ELSE}{$IFDEF DELPHIX_TOKYO}
+ AddDomainForResourceString('delphi102');
+{$ELSE}{$IFDEF DELPHIX_RIO}
+ AddDomainForResourceString('delphi103');
{$ELSE}
'unknown Delphi version!';
{$ENDIF}
@@ -364,6 +368,8 @@
{$ENDIF}
{$ENDIF}
{$ENDIF}
+{$ENDIF}
+{$ENDIF}
{$IFNDEF console}
// ignore these VCL properties / classes
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-02-29 18:55:04 UTC (rev 3054)
@@ -25,6 +25,13 @@
TBytes = array of Byte;
{$IFEND}
+type
+ TByteMatrix = array of array of Byte;
+ TBitMatrix = array of array of Boolean;
+
+ TSingleMatrix = array of array of Single;
+ TDoubleMatrix = array of array of Double;
+
implementation
end.
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-02-02 19:16:34 UTC (rev 3053)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-02-29 18:55:04 UTC (rev 3054)
@@ -30,8 +30,11 @@
Buttons,
Menus,
{$IFDEF HAS_UNIT_SYSTEM_ACTIONS}
- System.Actions,
+ Actions,
{$ENDIF}
+{$IFDEF HAS_UNIT_SYSTEM_UITYPES}
+ UITypes,
+{$ENDIF}
ActnList,
ComObj,
u_dzTranslator,
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-03-07 14:53:49
|
Revision: 3062
http://sourceforge.net/p/gexperts/code/3062
Author: twm
Date: 2020-03-07 14:53:47 +0000 (Sat, 07 Mar 2020)
Log Message:
-----------
* TStream.Read -> .ReadBuffer
* TStream.Write -> .WriteBuffer
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzClassUtils.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/u_dzClassUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2020-03-07 14:42:43 UTC (rev 3061)
+++ trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2020-03-07 14:53:47 UTC (rev 3062)
@@ -1029,10 +1029,10 @@
var
Len: Byte;
begin
- _Stream.Read(Len, SizeOf(Len));
+ _Stream.ReadBuffer(Len, SizeOf(Len));
Result[0] := AnsiChar(Chr(Len));
if Len > 0 then
- _Stream.Read(Result[1], Len);
+ _Stream.ReadBuffer(Result[1], Len);
end;
function TStream_WriteStringLn(_Stream: TStream; const _s: string): Integer;
@@ -1083,7 +1083,7 @@
SetLength(s, Result);
if Result <> 0 then begin
_Stream.Position := OldPos;
- _Stream.Read(s[1], Length(s));
+ _Stream.ReadBuffer(s[1], Length(s));
_s := string(s);
end;
_Stream.Position := NewPos;
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-03-07 14:42:43 UTC (rev 3061)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-03-07 14:53:47 UTC (rev 3062)
@@ -1644,7 +1644,7 @@
raise EdzVclUtils.CreateFmt(_('Glyph string contained invalid character at position %d.'), [Res]);
st := TMemoryStream.Create;
try
- st.Write(Buf[0], Size);
+ st.WriteBuffer(Buf[0], Size);
st.Position := 0;
_btn.Glyph.LoadFromStream(st);
finally
@@ -1671,7 +1671,7 @@
raise EdzVclUtils.CreateFmt(_('Bitmap string contained invalid character at position %d.'), [Res]);
st := TMemoryStream.Create;
try
- st.Write(Buf[0], Size);
+ st.WriteBuffer(Buf[0], Size);
st.Position := 0;
_bmp.LoadFromStream(st);
finally
@@ -3756,7 +3756,7 @@
begin
st := TMemoryStream.Create;
try
- st.Write(_s[1], Length(_s));
+ st.WriteBuffer(_s[1], Length(_s));
st.Position := 0;
_Re.Lines.LoadFromStream(st);
finally
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-04-04 17:44:27
|
Revision: 3073
http://sourceforge.net/p/gexperts/code/3073
Author: twm
Date: 2020-04-04 17:44:25 +0000 (Sat, 04 Apr 2020)
Log Message:
-----------
updated to latest dzlib units
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/dzlibjedi.inc
trunk/ExternalSource/dzlib/u_dzClassUtils.pas
trunk/ExternalSource/dzlib/u_dzStringUtils.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
trunk/ExternalSource/dzlib/u_dzVariantUtils.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-03-15 17:35:35 UTC (rev 3072)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-04-04 17:44:25 UTC (rev 3073)
@@ -1,5 +1,19 @@
{$INCLUDE 'dzlibjedi.inc'}
+{$IFDEF RTL210_UP}
+{$DEFINE HAS_JSON_SUPPORT}
+{$ENDIF}
+
+{$IFDEF RTL270_UP}
+{$DEFINE HAS_UNIT_SYSTEM_JSON}
+{$ENDIF}
+
+{$IFDEF DELPHIXE7_UP}
+// For now I assume the BDE is not installed for Delphi XE7 and later, but that
+// largely depends on what the user selected for installation.
+{$DEFINE BDE_IS_DEPRECATED}
+{$ENDIF}
+
{$IFDEF DELPHI7_UP}
// TBitBtn.WordWrap was introduced in Delphi 7
{$DEFINE HAS_BITBTN_WORDWRAP}
@@ -10,11 +24,14 @@
{$IFDEF DELPHI2005_UP}
// Delphi 6 and 7 understood deprecated, but not for types
{$DEFINE SUPPORTS_DEPRECATED_TYPES}
+{$DEFINE HAS_UNIT_WIDESTRINGS}
+{$DEFINE OPENDIALOG_EXCUTE_HAS_HANDLE}
{$ENDIF}
{$IFDEF DELPHI2006_UP}
-// TBitmap.SetSize was it introduced with Delphi 2006
+// TBitmap.SetSize was introduced with Delphi 2006
{$DEFINE SUPPPORTS_BITMAP_SETSIZE}
+{$DEFINE DATASET_GETFIELDS_IS_WIDESTRINGLIST}
{$ENDIF}
{$IFDEF DELPHI7_UP}
@@ -35,11 +52,13 @@
{$IFDEF DELPHI2009_UP}
// THandleStream.FHandle is declared as THandle (before that it's an Integer)
{$DEFINE THANDLESTREAM_HANDLE_IS_THANDLE}
+{$DEFINE HAS_TOBJECT_TOSTRING}
{$ENDIF}
{$IFDEF DELPHIXE2_UP}
// AHandle is declared as THandle (otherwise it's an Integer)
{$DEFINE THANDLESTREAM_CREATE_HANDLE_IS_THANDLE}
+{$DEFINE MAXLISTSIZE_IS_DEPRECATED}
{$ENDIF}
{$IFDEF DELPHIX_TOKYO_UP}
@@ -47,6 +66,9 @@
{$DEFINE HAS_INTTOHEX_FUNCTION}
{$ENDIF}
+// we currently support only Windows (and a very small subset of Win64), so we turn platform
+// warnings off
+
{$WARN SYMBOL_PLATFORM OFF}
{$WARN UNIT_PLATFORM OFF}
Modified: trunk/ExternalSource/dzlib/dzlibjedi.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlibjedi.inc 2020-03-15 17:35:35 UTC (rev 3072)
+++ trunk/ExternalSource/dzlib/dzlibjedi.inc 2020-04-04 17:44:25 UTC (rev 3073)
@@ -553,6 +553,9 @@
SUPPORTS_FINAL Compiler supports final keyword (D9.NET, D10+)
SUPPORTS_METHODINFO Compiler supports the METHODINFO directives (D10+)
SUPPORTS_GENERICS Compiler supports generic implementations (D11.NET, D12+)
+ SUPPORTS_GENERIC_TYPES Compiler supports generic implementations of types (D11.NET, D12+, FPC)
+ SUPPORTS_GENERIC_METHODS Compiler supports generic implementations of methods (D11.NET, D12+, FPC)
+ SUPPORTS_GENERIC_ROUTINES Compiler supports generic implementations of global functions/procedures (FPC)
SUPPORTS_DEPRECATED_DETAILS Compiler supports additional text for the deprecated directive (D11.NET, D12+)
ACCEPT_DEPRECATED Compiler supports or ignores the deprecated directive (D6+/BCB6+/FPC)
ACCEPT_PLATFORM Compiler supports or ignores the platform directive (D6+/BCB6+/FPC)
@@ -1544,15 +1547,26 @@
{$IFDEF VER1_0}
Please use FPC 2.0 or higher to compile this.
{$ELSE}
+ { FPC_FULLVERSION is available from 2.2.4 on }
+
{$DEFINE SUPPORTS_OUTPARAMS}
{$DEFINE SUPPORTS_WIDECHAR}
{$DEFINE SUPPORTS_WIDESTRING}
- {$IFDEF HASINTF}
+ {$IF DEFINED(VER2_0) OR DEFINED(VER2_1)}
+ {$IFDEF HASINTF}
+ {$DEFINE SUPPORTS_INTERFACE}
+ {$ENDIF}
+ {$IFDEF HASVARIANT}
+ {$DEFINE SUPPORTS_VARIANT}
+ {$ENDIF}
+ {$IFDEF HASCURRENCY}
+ {$DEFINE SUPPORTS_CURRENCY}
+ {$ENDIF}
+ {$ELSE}
{$DEFINE SUPPORTS_INTERFACE}
- {$ENDIF}
- {$IFDEF HASVARIANT}
{$DEFINE SUPPORTS_VARIANT}
- {$ENDIF}
+ {$DEFINE SUPPORTS_CURRENCY}
+ {$IFEND}
{$IFDEF FPC_HAS_TYPE_SINGLE}
{$DEFINE SUPPORTS_SINGLE}
{$ENDIF}
@@ -1562,9 +1576,6 @@
{$IFDEF FPC_HAS_TYPE_EXTENDED}
{$DEFINE SUPPORTS_EXTENDED}
{$ENDIF}
- {$IFDEF HASCURRENCY}
- {$DEFINE SUPPORTS_CURRENCY}
- {$ENDIF}
{$DEFINE SUPPORTS_THREADVAR}
{$DEFINE SUPPORTS_CONSTPARAMS}
{$DEFINE SUPPORTS_LONGWORD}
@@ -1575,15 +1586,26 @@
{$DEFINE ACCEPT_DEPRECATED} // 2.2 also gives warnings
{$DEFINE ACCEPT_PLATFORM} // 2.2 also gives warnings
{$DEFINE ACCEPT_LIBRARY}
+ {$DEFINE SUPPORTS_DEPRECATED}
+ {$DEFINE SUPPORTS_PLATFORM}
+ {$DEFINE SUPPORTS_LIBRARY}
+ {$DEFINE SUPPORTS_DEPRECATED_WARNINGS}
+ {$DEFINE SUPPORTS_PLATFORM_WARNINGS}
{$DEFINE SUPPORTS_EXTSYM}
{$DEFINE SUPPORTS_NODEFINE}
+ {$DEFINE SUPPORTS_DISPINTERFACE}
+ {$DEFINE SUPPORTS_IMPLEMENTS}
+ {$DEFINE SUPPORTS_DISPID}
+ {$DEFINE SUPPORTS_INLINE}
+ {$DEFINE SUPPORTS_STATIC}
+ {$DEFINE SUPPORTS_COMPILETIME_MESSAGES}
{$DEFINE SUPPORTS_CUSTOMVARIANTS}
{$DEFINE SUPPORTS_VARARGS}
{$DEFINE SUPPORTS_ENUMVALUE}
- {$IFDEF LINUX}
+ {$IF DEFINED(LINUX) AND DEFINED(CPU386)}
{$DEFINE HAS_UNIT_LIBC}
- {$ENDIF LINUX}
+ {$IFEND}
{$DEFINE HAS_UNIT_CONTNRS}
{$DEFINE HAS_UNIT_TYPES}
{$DEFINE HAS_UNIT_VARIANTS}
@@ -1593,19 +1615,68 @@
{$DEFINE XPLATFORM_RTL}
- {$IFDEF VER2_2}
- {$DEFINE SUPPORTS_DISPINTERFACE}
- {$DEFINE SUPPORTS_IMPLEMENTS}
- {$DEFINE SUPPORTS_DISPID}
+ {$IF DEFINED(FPC_FULLVERSION)}
+ { 2.2.4 or newer }
+
+ {$DEFINE SUPPORTS_SETPEFLAGS}
+ {$DEFINE SUPPORTS_STRICT}
+
+ {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20400)}
+ {$DEFINE SUPPORTS_UINT64}
+ {$DEFINE SUPPORTS_EXPERIMENTAL_WARNINGS}
+ {$DEFINE SUPPORTS_REGION}
+ {$DEFINE SUPPORTS_UNICODE_STRING}
+ {$IFEND}
+
+ {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20402)}
+ {$DEFINE SUPPORTS_FOR_IN}
+ {$IFEND}
+
+ {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20600)}
+ {$DEFINE SUPPORTS_LIBRARY_WARNINGS}
+ {$DEFINE SUPPORTS_DEPRECATED_DETAILS}
+ {$DEFINE SUPPORTS_NESTED_TYPES}
+ {$DEFINE SUPPORTS_NESTED_CONSTANTS}
+ {$DEFINE SUPPORTS_ENHANCED_RECORDS} // called Advanced Records in FPC
+ {$DEFINE SUPPORTS_CLASS_FIELDS}
+ {$DEFINE SUPPORTS_CLASS_HELPERS}
+ {$DEFINE SUPPORTS_CLASS_OPERATORS}
+ {$DEFINE SUPPORTS_CLASS_CTORDTORS}
+ {$DEFINE SUPPORTS_FINAL}
+ {$DEFINE SUPPORTS_CAST_INTERFACE_TO_OBJ}
+
+ {$DEFINE HAS_ENOTIMPLEMENTED}
+ {$IFEND}
+
+ {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20602)}
+ {$DEFINE SUPPORTS_INT_ALIASES}
+
+ {$DEFINE HAS_EARGUMENTEXCEPTION}
+ {$IFEND}
+
+ {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 30000)}
+ {$DEFINE SUPPORTS_GENERICS}
+ {$DEFINE SUPPORTS_GENERIC_TYPES}
+
+ {$DEFINE HAS_UNIT_CHARACTER}
+ {$IFEND}
+
+ {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 30200)}
+ {$DEFINE SUPPORTS_GENERIC_METHODS}
+ {$DEFINE SUPPORTS_GENERIC_ROUTINES}
+ {$DEFINE SUPPORTS_WEAKPACKAGEUNIT}
+
+ {$DEFINE HAS_UNIT_RTTI}
+ {$DEFINE HAS_UNIT_SYSTEM_UITYPES}
+ {$IFEND}
{$ELSE}
- {$UNDEF SUPPORTS_DISPINTERFACE}
- {$UNDEF SUPPORTS_IMPLEMENTS}
- {$endif}
- {$UNDEF SUPPORTS_UNSAFE_WARNINGS}
+ { older than 2.2.4 }
- {$IFDEF VER3}
- {$DEFINE SUPPORTS_DEPRECATED_DETAILS}
- {$endif}
+ {$IFDEF VER2_2}
+ {$SUPPORTS_SETPEFLAGS}
+ {$SUPPORTS_STRICT}
+ {$ENDIF}
+ {$IFEND}
{$ENDIF}
{$ENDIF FPC}
@@ -1706,6 +1777,8 @@
{$IFDEF COMPILER11_UP}
{$IFDEF CLR}
{$DEFINE SUPPORTS_GENERICS}
+ {$DEFINE SUPPORTS_GENERIC_TYPES}
+ {$DEFINE SUPPORTS_GENERIC_METHODS}
{$DEFINE SUPPORTS_DEPRECATED_DETAILS}
{$ENDIF CLR}
{$ENDIF COMPILER11_UP}
@@ -1712,6 +1785,8 @@
{$IFDEF COMPILER12_UP}
{$DEFINE SUPPORTS_GENERICS}
+ {$DEFINE SUPPORTS_GENERIC_TYPES}
+ {$DEFINE SUPPORTS_GENERIC_METHODS}
{$DEFINE SUPPORTS_DEPRECATED_DETAILS}
{$DEFINE SUPPORTS_INT_ALIASES}
{$IFNDEF CLR}
Modified: trunk/ExternalSource/dzlib/u_dzClassUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2020-03-15 17:35:35 UTC (rev 3072)
+++ trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2020-04-04 17:44:25 UTC (rev 3073)
@@ -17,6 +17,7 @@
IniFiles,
Registry,
u_dzTranslator,
+ u_dzTypes,
u_dzDateUtils; // we need this for the $IF Declared() directives
// NOTE: The naming convention is <extended-class>_<Methodname>
@@ -202,7 +203,7 @@
/// @param s is the string to write
/// @returns the number of bytes written.
/// </summary>
-function TStream_WriteString(_Stream: TStream; const _s: string): Integer;
+function TStream_WriteString(_Stream: TStream; const _s: RawByteString): Integer;
/// <summary>
/// Write a ShortString to the stream as binary, that is the length byte followed by len content bytes
@@ -225,7 +226,7 @@
/// @param s is the string to write
/// @returns the number of bytes written.
/// </summary>
-function TStream_WriteStringLn(_Stream: TStream; const _s: string): Integer;
+function TStream_WriteStringLn(_Stream: TStream; const _s: RawByteString): Integer;
/// <summary>
/// Read a line from a stream, that is, a string ending in CRLF
@@ -998,7 +999,7 @@
Result := _st.Values[Name];
end;
-function TStream_WriteString(_Stream: TStream; const _s: string): Integer;
+function TStream_WriteString(_Stream: TStream; const _s: RawByteString): Integer;
var
Len: Integer;
ErrCode: DWORD;
@@ -1035,7 +1036,7 @@
_Stream.ReadBuffer(Result[1], Len);
end;
-function TStream_WriteStringLn(_Stream: TStream; const _s: string): Integer;
+function TStream_WriteStringLn(_Stream: TStream; const _s: RawByteString): Integer;
begin
Result := TStream_WriteString(_Stream, _s);
Result := Result + TStream_WriteString(_Stream, #13#10);
@@ -1043,7 +1044,7 @@
function TStream_WriteFmtLn(_Stream: TStream; const _Format: string; _Args: array of const): Integer;
begin
- Result := TStream_WriteStringLn(_Stream, Format(_Format, _Args));
+ Result := TStream_WriteStringLn(_Stream, AnsiString(Format(_Format, _Args)));
end;
// Turn Warning off, because Delphi 2007 thinks that the variable might not have been initialized.
@@ -1063,6 +1064,8 @@
begin
// twm: this is not really efficient, because it reads single bytes, if it becomes a problem, optimize it ;-)
OldPos := _Stream.Position;
+ Endstring := 0;
+ NewPos := 0;
while True do begin
if _Stream.Read(c, 1) = 0 then begin // end of file
EndString := _Stream.Position;
Modified: trunk/ExternalSource/dzlib/u_dzStringUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2020-03-15 17:35:35 UTC (rev 3072)
+++ trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2020-04-04 17:44:25 UTC (rev 3073)
@@ -250,9 +250,16 @@
{$IF not Declared(StartsText)}
function StartsText(const _Start, _s: string): Boolean;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
{$DEFINE STARTSTEXT_IMPLEMENTATION_REQUIRED}
{$IFEND}
+{$IF not Declared(StartsStr)}
+function StartsStr(const _Start, _s: string): boolean;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+{$DEFINE STARTSSTR_IMPLEMENTATION_REQUIRED}
+{$IFEND}
+
{$IF not Declared(ContainsStr)}
function ContainsStr(const _Text, _SubText: string): Boolean;
{$DEFINE CONTAINSSTR_IMPLEMENTATION_REQUIRED}
@@ -409,6 +416,11 @@
function Copy(const _s: string; _Pos, _Len: Integer): string; overload;
function Copy(const _s: string; _Pos: Integer): string; overload;
{$ENDIF SUPPORTS_UNICODE}
+{$IFNDEF DELPHI2005_UP}
+// Delphi 6/7 does not have Copy without the length parameter
+function Copy(const _s: string; _Pos: Integer): string; overload;
+function Copy(const _s: string; _Pos, _Len: Integer): string; overload;
+{$ENDIF ~DELPHI2005_UP}
///<summary>
/// Converts Tab characters into SpcCount spaces </summary>
@@ -415,10 +427,15 @@
function Tab2Spaces(const _s: string; _SpcCount: Integer): string;
function StartsWith(const _Start, _s: string): Boolean;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+
function EndsWith(const _End, _s: string): Boolean;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
function UStartsWith(const _Start, _s: string): Boolean;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
function UEndsWith(const _End, _s: string): Boolean;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
function UnquoteString(const _s: string; _Quote: Char = '"'): string;
@@ -755,7 +772,6 @@
{$ENDIF}
{$IFDEF STARTSTEXT_IMPLEMENTATION_REQUIRED}
-
function StartsText(const _Start, _s: string): Boolean;
begin
Result := UStartsWith(_Start, _s);
@@ -762,8 +778,14 @@
end;
{$ENDIF}
+{$IFDEF STARTSSTR_IMPLEMENTATION_REQUIRED}
+function StartsStr(const _Start, _s: string): boolean;
+begin
+ Result := AnsiStartsStr(_Start,_s);
+end;
+{$ENDIF}
+
{$IFDEF CONTAINSSTR_IMPLEMENTATION_REQUIRED}
-
function ContainsStr(const _Text, _SubText: string): Boolean;
begin
Result := (Pos(_SubText, _Text) > 0);
@@ -1278,22 +1300,22 @@
function StartsWith(const _Start, _s: string): Boolean;
begin
- Result := AnsiSameStr(_Start, LeftStr(_s, Length(_Start)));
+ Result := AnsiStartsStr(_Start, _s)
end;
function UStartsWith(const _Start, _s: string): Boolean;
begin
- Result := AnsiSameText(_Start, LeftStr(_s, Length(_Start)));
+ Result := AnsiStartsText(_Start, LeftStr(_s, Length(_Start)));
end;
function EndsWith(const _End, _s: string): Boolean;
begin
- Result := AnsiSameStr(_End, RightStr(_s, Length(_End)));
+ Result := AnsiEndsStr(_End, RightStr(_s, Length(_End)));
end;
function UEndsWith(const _End, _s: string): Boolean;
begin
- Result := AnsiSameText(_End, RightStr(_s, Length(_End)));
+ Result := AnsiEndsText(_end, _s);
end;
function UnquoteString(const _s: string; _Quote: Char): string;
@@ -1474,6 +1496,19 @@
end;
{$ENDIF SUPPORTS_UNICODE}
+{$IFNDEF DELPHI2005_UP}
+// Delphi 6 does not have Copy without the length parameter
+function Copy(const _s: string; _Pos: Integer): string;
+begin
+ Result := Copy(_s, _Pos, Length(_s) - _Pos);
+end;
+
+function Copy(const _s: string; _Pos, _Len: Integer): string;
+begin
+ Result := System.Copy(_s, _Pos, _Len);
+end;
+{$ENDIF ~DELPHI2005_UP}
+
function MakeUniqueString(const _s: string): string;
begin
Result := _s;
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-03-15 17:35:35 UTC (rev 3072)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-04-04 17:44:25 UTC (rev 3073)
@@ -24,6 +24,9 @@
{$IF not Declared(TBytes)}
TBytes = array of Byte;
{$IFEND}
+{$IF not Declared(RawByteString)}
+ RawByteString = AnsiString;
+{$IFEND}
type
TByteMatrix = array of array of Byte;
Modified: trunk/ExternalSource/dzlib/u_dzVariantUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVariantUtils.pas 2020-03-15 17:35:35 UTC (rev 3072)
+++ trunk/ExternalSource/dzlib/u_dzVariantUtils.pas 2020-04-04 17:44:25 UTC (rev 3073)
@@ -171,7 +171,7 @@
/// @returns the extended value of v or the Default if v can not be converted </summary>
function Var2Ext(const _v: Variant; const _Default: Extended): Extended;
-{$IF Declared(Str2Date)}
+{$IF Declared(TryStrToDateTime)}
///<summary> Converts a variant to a TDateTime.
/// Raises an exception if v can not be converted.
/// @param v Variant value to convert
@@ -183,7 +183,7 @@
function Var2DateTimeEx(const _v: Variant; const _Source: string): TDateTime;
{$IFEND}
-{$IF Declared(TryStr2Date)}
+{$IF Declared(TryStr2DateTime)}
function TryVar2DateTime(const _v: Variant; out _dt: TDateTime): Boolean;
{$IFEND}
@@ -427,7 +427,7 @@
Result := _NullValue;
end;
-{$IF Declared(Str2Date)}
+{$IF Declared(TryStrToDateTime)}
function Var2DateTimeEx(const _v: Variant; const _Source: string): TDateTime;
const
EXPECTED = 'Date'; // do not translate
@@ -437,7 +437,8 @@
if VarIsEmpty(_v) then
raise EVarIsEmpty.CreateFmt(_('Variant is Empty, should be %s: %s'), [EXPECTED, _Source]);
if VarIsStr(_v) then begin
- Result := Str2Date(_v);
+ if not TryStrToDateTime(_v, Result) then
+ raise EVariantConvertError.CreateFmt(_('Variant can not be converted to %s: %s'), [EXPECTED, _Source]);
end else begin
try
Result := _v;
@@ -449,10 +450,10 @@
end;
{$IFEND}
-{$IF Declared(TryStr2Date)}
+{$IF Declared(TryStr2DateTime)}
function TryVar2DateTime(const _v: Variant; out _dt: TDateTime): Boolean;
+
// from Variants
-
function VarToDoubleCustom(const V: TVarData; out AValue: Double): Boolean;
var
LHandler: TCustomVariantType;
@@ -473,7 +474,7 @@
if Result then
_dt := VarToDateTime(_v)
else if VarIsStr(_v) then
- Result := TryStr2Date(_v, _dt)
+ Result := TryStr2DateTime(_v, _dt)
else begin
Result := VarToDoubleCustom(TVarData(_v), d);
_dt := d;
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-03-15 17:35:35 UTC (rev 3072)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-04-04 17:44:25 UTC (rev 3073)
@@ -4,7 +4,7 @@
/// @author twm </summary>
unit u_dzVclUtils;
-{$INCLUDE dzlib.inc}
+{$INCLUDE 'dzlib.inc'}
// If this conditional define is set, all messages received in the hooked
// WindowProc are written to the console window -> requires a console
@@ -505,6 +505,10 @@
procedure TLabel_MakeUrlLabel(_lbl: TLabel); overload;
procedure TLabel_MakeUrlLabel(_lbl: TLabel; const _URL: string; _SetCaption: Boolean = False); overload;
+///<summary>
+/// sets BevelOuter to bvNone for all panels in the array </summary>
+procedure TPanel_BevelNone(const _Panels: array of TPanel);
+
type
///<summary>
/// Helper class to allow displaying a hint with the current value of a TTrackBar.
@@ -1741,17 +1745,19 @@
procedure TGrid_ExportToStream(_Grid: TCustomGrid; _Stream: TStream; _IncludeFixed: Boolean = False);
var
- s: string;
+ s: AnsiString;
begin
- s := TGrid_GetText(_Grid, _IncludeFixed);
+ // todo: Should this convert to UTF8 instead?
+ s := AnsiString(TGrid_GetText(_Grid, _IncludeFixed));
TStream_WriteStringLn(_Stream, s);
end;
procedure TGrid_ExportToStream(_Grid: TCustomGrid; _Stream: TStream; _Selection: TGridRect);
var
- s: string;
+ s: AnsiString;
begin
- s := TGrid_GetText(_Grid, _Selection);
+ // todo: Should this convert to UTF8 instead?
+ s := AnsiString(TGrid_GetText(_Grid, _Selection));
TStream_WriteStringLn(_Stream, s);
end;
@@ -2115,7 +2121,7 @@
{$IF NOT Declared(ECM_FIRST)}
const
- ECM_FIRST = $1500;
+ ECM_FIRST = $1500;
EM_SETCUEBANNER = ECM_FIRST + 1;
EM_GETCUEBANNER = ECM_FIRST + 2;
{$IFEND}
@@ -2398,6 +2404,14 @@
TUrlLabelHandler.Create(_lbl, _URL);
end;
+procedure TPanel_BevelNone(const _Panels: array of TPanel);
+var
+ i: Integer;
+begin
+ for i := Low(_Panels) to High(_Panels) do
+ _Panels[i].BevelOuter := bvNone;
+end;
+
function TTreeView_GetAsText(_Tree: TTreeView; _Indentation: Integer = 2; _Marker: Char = #0): string;
var
Level: Integer;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-04-18 12:52:43
|
Revision: 3086
http://sourceforge.net/p/gexperts/code/3086
Author: twm
Date: 2020-04-18 12:52:42 +0000 (Sat, 18 Apr 2020)
Log Message:
-----------
updated to latest version from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-04-18 09:08:05 UTC (rev 3085)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-04-18 12:52:42 UTC (rev 3086)
@@ -31,8 +31,16 @@
{$IFDEF DELPHI2006_UP}
// TBitmap.SetSize was introduced with Delphi 2006
{$DEFINE SUPPPORTS_BITMAP_SETSIZE}
+{$ENDIF}
+
+{$IFDEF DELPHI2006_UP}
+{$IFNDEF DELPHI2009_UP}
+// Delphi 2006 introduced an overloaded version of TDataSet.GetFields which takes a TWideStringList
+// parameter and deprecated the version that took TStrings. Delphi 2009 removed the deprecated
+// warning again because TStrings is Unicode.
{$DEFINE DATASET_GETFIELDS_IS_WIDESTRINGLIST}
{$ENDIF}
+{$ENDIF}
{$IFDEF DELPHI7_UP}
{$IFNDEF DELPHI_2009_UP}
@@ -61,6 +69,10 @@
{$DEFINE MAXLISTSIZE_IS_DEPRECATED}
{$ENDIF}
+{$IFDEF DELPHIXE6_UP}
+{$DEFINE JSONOBJECT_HAS_COUNT}
+{$ENDIF}
+
{$IFDEF DELPHIX_TOKYO_UP}
// this function probably already exist in earlier versions, I just run across a compile error for 10.2 Tokyo
{$DEFINE HAS_INTTOHEX_FUNCTION}
Modified: trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-04-18 09:08:05 UTC (rev 3085)
+++ trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-04-18 12:52:42 UTC (rev 3086)
@@ -17,7 +17,6 @@
unit u_dzMiscUtils;
{$INCLUDE 'dzlib.inc'}
-{.$INCLUDE 'jedi.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas 2020-04-18 09:08:05 UTC (rev 3085)
+++ trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas 2020-04-18 12:52:42 UTC (rev 3086)
@@ -4,7 +4,6 @@
unit u_dzSelectDirectoryFix;
{$INCLUDE 'dzlib.inc'}
-{.$INCLUDE 'jedi.inc'}
interface
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-04-18 09:08:05 UTC (rev 3085)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-04-18 12:52:42 UTC (rev 3086)
@@ -5664,7 +5664,8 @@
sl.Add(fn);
end;
DragFinish(_Msg.wParam);
- doCallback(sl);
+ if cnt > 0 then
+ doCallback(sl);
finally
FreeAndNil(sl);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-04-25 12:53:16
|
Revision: 3089
http://sourceforge.net/p/gexperts/code/3089
Author: twm
Date: 2020-04-25 12:53:14 +0000 (Sat, 25 Apr 2020)
Log Message:
-----------
updated to latest version from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzClassUtils.pas
trunk/ExternalSource/dzlib/u_dzErrorThread.pas
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-04-18 15:36:43 UTC (rev 3088)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-04-25 12:53:14 UTC (rev 3089)
@@ -12,6 +12,7 @@
// For now I assume the BDE is not installed for Delphi XE7 and later, but that
// largely depends on what the user selected for installation.
{$DEFINE BDE_IS_DEPRECATED}
+{$DEFINE HAS_UNIT_NETENCODING}
{$ENDIF}
{$IFDEF DELPHI7_UP}
@@ -63,6 +64,10 @@
{$DEFINE HAS_TOBJECT_TOSTRING}
{$ENDIF}
+{$IFDEF DELPHIXE_UP}
+{$DEFINE HAS_UNIT_GENERICS_COLLECTION}
+{$ENDIF}
+
{$IFDEF DELPHIXE2_UP}
// AHandle is declared as THandle (otherwise it's an Integer)
{$DEFINE THANDLESTREAM_CREATE_HANDLE_IS_THANDLE}
Modified: trunk/ExternalSource/dzlib/u_dzClassUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2020-04-18 15:36:43 UTC (rev 3088)
+++ trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2020-04-25 12:53:14 UTC (rev 3089)
@@ -1064,8 +1064,10 @@
begin
// twm: this is not really efficient, because it reads single bytes, if it becomes a problem, optimize it ;-)
OldPos := _Stream.Position;
+{$IFNDEF DELPHIX_SEATTLE_UP}
Endstring := 0;
NewPos := 0;
+{$ENDIF}
while True do begin
if _Stream.Read(c, 1) = 0 then begin // end of file
EndString := _Stream.Position;
Modified: trunk/ExternalSource/dzlib/u_dzErrorThread.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzErrorThread.pas 2020-04-18 15:36:43 UTC (rev 3088)
+++ trunk/ExternalSource/dzlib/u_dzErrorThread.pas 2020-04-25 12:53:14 UTC (rev 3089)
@@ -174,7 +174,6 @@
until Result or (_TimeoutMsecs <> INFINITE);
end else begin
WaitResult := WaitForSingleObject(H, _TimeoutMsecs);
- Result := True;
if WaitResult = WAIT_FAILED then
RaiseLastOSError;
Result := (WaitResult <> WAIT_TIMEOUT);
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-04-18 15:36:43 UTC (rev 3088)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-04-25 12:53:14 UTC (rev 3089)
@@ -10,7 +10,9 @@
{$ENDIF}
{$IFOPT O-} // Optimization
-{$MESSAGE WARN 'optimization is off, consider turning it on for significantly better performance'}
+{$IFNDEF NO_OPTIMIZE_DZ_GRAPHIC_UTILS_HINT}
+{$MESSAGE HINT 'optimization is off, consider turning it on for significantly better performance'}
+{$ENDIF}
{$ELSE}
// If optimization is on, we turn off assertions, just in case the programmer forgot.
// The reason for this is that we have some assertions below that might significantly impact
@@ -668,13 +670,18 @@
wDst: Integer;
hDst: Integer;
begin
+ wDst := _DestBmp.Width;
+ hDst := _DestBmp.Height;
+ if wDst = 0 then
+ raise Exception.Create(_('Destination bitmap width must not be 0.'));
+ if hDst = 0 then
+ raise Exception.Create(_('Destination bitmap height must not be 0.'));
+
DstHandle := _DestBmp.Canvas.Handle;
OrigBltMode := GetStretchBltMode(DstHandle);
try
SetBrushOrgEx(DstHandle, 0, 0, @OrigBrushOrigin);
SetStretchBltMode(DstHandle, HALFTONE);
- wDst := _DestBmp.Width;
- hDst := _DestBmp.Height;
wSrc := _SrcBmp.Width;
hSrc := _SrcBmp.Height;
if (hSrc = 0) or (wSrc = 0) then begin
@@ -682,14 +689,19 @@
// todo: Should this clear DestBmp?
Result := False;
end else begin
- if hSrc > wSrc then begin
- x := Round((wDst * (hSrc - wSrc)) / 2 / hSrc);
+ if SameValue(wSrc / hSrc, wDst / hDst) then begin
+ x := 0;
y := 0;
- wDst := Round(wDst * wSrc / hSrc);
end else begin
- x := 0;
- y := Round((hDst * (wSrc - hSrc)) / 2 / wSrc);
- hDst := Round(hDst * hSrc / wSrc);
+ if hSrc > wSrc then begin
+ x := Round((wDst * (hSrc - wSrc)) / 2 / hSrc);
+ y := 0;
+ wDst := Round(wDst * wSrc / hSrc);
+ end else begin
+ x := 0;
+ y := Round((hDst * (wSrc - hSrc)) / 2 / wSrc);
+ hDst := Round(hDst * hSrc / wSrc);
+ end;
end;
Result := dzStretchBlt(DstHandle, Rect(x, y, x + wDst - 1, y + hDst - 1), _SrcBmp);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-05-08 14:16:09
|
Revision: 3116
http://sourceforge.net/p/gexperts/code/3116
Author: twm
Date: 2020-05-08 14:16:07 +0000 (Fri, 08 May 2020)
Log Message:
-----------
updated to latest version from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-05-07 15:37:37 UTC (rev 3115)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-05-08 14:16:07 UTC (rev 3116)
@@ -169,6 +169,10 @@
type
TDrawTextFlags = (
dtfLeft, dtfRight, dtfCenter, // horizontal alignment
+ dtfTopSingle, dtfBottomSingle, dtfVCenterSingle, // vertical alignment, only if dtfSingleLine is given
+ dtfSingleLine, // only print as single line (ignore line breaks).
+ // Note that this is is not the same as not specifying dtfWordBreak because
+ // it will also ignore existing line breaks.
dtfWordBreak, // Breaks words. Lines are automatically broken between words if a word would
// extend past the edge of the rectangle specified by the lpRect parameter.
// A carriage return-line feed sequence also breaks the line.
@@ -181,18 +185,16 @@
// If there is only one line of text, DrawText modifies the right side of the
// rectangle so that it bounds the last character in the line. In either case,
// DrawText returns the height of the formatted text but does not draw the text.
- dtfNoClip); // draw without clipping (slightly faster)
-// not implemented:
-// dtfSingleLine, // only print as single line (ignore line breaks)
-// dtfTopSingle, dtfBottomSingle, dtfVCenterSingle, // vertical alignment, only if dtfSingleLine is given
-// dtfPathEllipsis, // replace characters in the middle of the string with ellipses ('...') so that
+ dtfPathEllipsis, // replace characters in the middle of the string with ellipses ('...') so that
// the result fits in the specified rectangle. If the string contains backslash
// (\) characters, preserves as much as possible of the text after the last backslash.
-// dtfEndEllipsis, // if the end of a string does not fit in the rectangle, it is truncated and
+ dtfEndEllipsis, // if the end of a string does not fit in the rectangle, it is truncated and
// ellipses ('...') are added. If a word that is not at the end of the string
// goes beyond the limits of the rectangle, it is truncated without ellipses.
// (Unless dtfWordEllipsis is also specified.)
-// dtfWordEllipsis, // Truncates any word that does not fit in the rectangle and adds ellipses ('...').
+ dtfWordEllipsis, // Truncates any word that does not fit in the rectangle and adds ellipses ('...').
+ dtfNoClip); // draw without clipping (slightly faster)
+// not implemented:
// dtfModifyStringEllipsis, // if given, together with one of the dtfXxxEllipsis flags, the
// string is modified to matcht the output.
// dtfEditControl,
@@ -201,6 +203,11 @@
// dtfPrefixOnly, dtRtlReading, dtfTabStop,
TDrawTextFlagSet = set of TDrawTextFlags;
+ TDrawTextHorizontalAlignment = (dthaLeft, dthaRight, dthaCenter);
+ TDrawTextVerticalAlignment = (dtvaTop, dtvaBottom, dtvaCenter);
+ TDrawTextFlagsNoAlign = dtfCalcRect..dtfNoClip;
+ TDrawTextFlagSetNoAlign = set of TDrawTextFlagsNoAlign;
+
///<summary>
/// Calculates the Rect necessary for drawing the text.
/// @returns the calculated height </summary>
@@ -209,6 +216,13 @@
inline;
{$ENDIF}
+function TCanvas_DrawTextSingleLine(_Canvas: TCanvas; const _Text: string; var _Rect: TRect;
+ _HAlign: TDrawTextHorizontalAlignment; _VAlign: TDrawTextVerticalAlignment;
+ _Flags: TDrawTextFlagSetNoAlign): Integer;
+{$IFDEF SUPPORTS_INLINE}
+inline;
+{$ENDIF}
+
///<summary> calls Windows.SaveDC and returns an interface which will automatically call
/// Windows.RestoreDC when destroyed </summary>
function TCanvas_SaveDC(_Canvas: TCanvas): IInterface;
@@ -871,6 +885,8 @@
Flags: LongWord;
begin
Flags := 0;
+
+ // horizontal alignment
if dtfLeft in _Flags then
Flags := Flags or DT_LEFT;
if dtfRight in _Flags then
@@ -877,15 +893,64 @@
Flags := Flags or DT_RIGHT;
if dtfCenter in _Flags then
Flags := Flags or DT_CENTER;
+
+ // vertical alignment (for single lines only)
+ if dtfTopSingle in _Flags then
+ Flags := Flags or DT_TOP;
+ if dtfBottomSingle in _Flags then
+ Flags := Flags or DT_BOTTOM;
+ if dtfVCenterSingle in _Flags then
+ Flags := Flags or DT_VCENTER;
+
if dtfWordBreak in _Flags then
Flags := Flags or DT_WORDBREAK;
+ if dtfSingleLine in _Flags then
+ Flags := Flags or DT_SINGLELINE;
+
+ // adding ellipsis '...'
+ if dtfPathEllipsis in _Flags then
+ Flags := Flags or DT_PATH_ELLIPSIS;
+ if dtfEndEllipsis in _Flags then
+ Flags := Flags or DT_END_ELLIPSIS;
+ if dtfWordEllipsis in _Flags then
+ Flags := Flags or DT_WORD_ELLIPSIS;
+
if dtfNoClip in _Flags then
Flags := Flags or DT_NOCLIP;
+
if dtfCalcRect in _Flags then
Flags := Flags or DT_CALCRECT;
+
Result := Windows.DrawText(_Canvas.Handle, PChar(_Text), -1, _Rect, Flags);
end;
+function TCanvas_DrawTextSingleLine(_Canvas: TCanvas; const _Text: string; var _Rect: TRect;
+ _HAlign: TDrawTextHorizontalAlignment; _VAlign: TDrawTextVerticalAlignment;
+ _Flags: TDrawTextFlagSetNoAlign): Integer;
+var
+ Flags: TDrawTextFlagSet;
+begin
+ Flags := _Flags;
+
+ case _HAlign of
+ dthaRight: Include(Flags, dtfRight);
+ dthaCenter: Include(Flags, dtfCenter);
+ else // dthaLeft:
+ Include(Flags, dtfLeft);
+ end;
+
+ case _VAlign of
+ dtvaBottom: Include(Flags, dtfBottomSingle);
+ dtvaCenter: Include(Flags, dtfVCenterSingle);
+ else // dtvaTop:
+ Include(Flags, dtfTopSingle);
+ end;
+
+ Include(Flags, dtfSingleLine);
+
+ Result := TCanvas_DrawText(_Canvas, _Text, _Rect, Flags)
+end;
+
type
TCanvasSaveDC = class(TInterfacedObject)
private
Modified: trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas 2020-05-07 15:37:37 UTC (rev 3115)
+++ trunk/ExternalSource/dzlib/u_dzSpeedBitBtn.pas 2020-05-08 14:16:07 UTC (rev 3116)
@@ -6,11 +6,14 @@
uses
Windows,
+ Messages,
Classes,
SysUtils,
Types,
Buttons,
- Graphics;
+ Controls,
+ Graphics,
+ u_dzVclUtils;
type
///<summary>
@@ -22,11 +25,10 @@
/// To use it create it with TdzSpeedBitBtn.Create(BitBtn) where BitBtn is an already existing
/// TBitBtn component. TdzSpeedBitBtn will be automatically destroyed when the associated BitBtn
/// is destroyed, so don't free it yourself.
- /// Hotkeys do not work, neither to Actions.</summary>
- TdzSpeedBitBtn = class(TComponent)
+ /// Note: Actions do not work.</summary>
+ TdzSpeedBitBtn = class(TWindowProcHook)
private
FCaption: string;
- FBtn: TBitBtn;
FOrigBmp: TBitmap;
FOrigOnClick: TNotifyEvent;
FUpBmp: TBitmap;
@@ -37,11 +39,14 @@
function GetDown: Boolean;
procedure SetDown(const Value: Boolean);
procedure UpdateGlyph;
+ function GetBitBtn: TBitBtn;
+ protected
+ procedure NewWindowProc(var _Msg: TMessage); override;
public
- constructor Create(_btn: TComponent); override;
+ constructor Create(_btn: TWinControl);
destructor Destroy; override;
property Down: Boolean read GetDown write SetDown;
- property BitBtn: TBitBtn read FBtn;
+ property BitBtn: TBitBtn read GetBitBtn;
property Data: Pointer read FData write FData;
end;
@@ -61,8 +66,10 @@
public
constructor Create;
destructor Destroy; override;
- function Add(_btn: TBitBtn; _Data: Pointer = nil): TdzSpeedBitBtn;
- ///<sumamry>
+ function Add(_btn: TBitBtn): TdzSpeedBitBtn; overload;
+ function Add(_btn: TBitBtn; _Data: Pointer): TdzSpeedBitBtn; overload;
+ function Add(_btn: TBitBtn; _Data: Integer): TdzSpeedBitBtn; overload;
+ ///<summary>
/// Sets the given button's down state to False, if allowed
/// @param Idx is the index of the button to change
/// @returns True, if the button could be set to Down=False, which is only possible if
@@ -71,12 +78,13 @@
/// Down = True
/// False, otherwise </summary>
function SetUp(_Idx: Integer): Boolean; overload;
- procedure SetDown(_Idx: Integer); overload;
- procedure SetDown(_btn: TBitBtn); overload;
+ function SetUp(_btn: TBitBtn): Boolean; overload;
+ procedure SetDown(_Idx: Integer; _CallClick: Boolean = False); overload;
+ procedure SetDown(_btn: TBitBtn; _CallClick: Boolean = False); overload;
///<summary>
/// Note: This only works, if all Data values are different. Otherwise
/// all buttons matching Data will be set to down. </summary>
- procedure SetDown(_Data: Pointer); overload;
+ procedure SetDown(_Data: Pointer; _CallClick: Boolean = False); overload;
function isDown(_Idx: Integer): Boolean; overload;
function isDown(_btn: TBitBtn): Boolean; overload;
///<summary>
@@ -93,11 +101,13 @@
implementation
uses
+ Math,
+ Forms,
u_dzGraphicsUtils;
{ TdzSpeedBitBtn }
-constructor TdzSpeedBitBtn.Create(_btn: TComponent);
+constructor TdzSpeedBitBtn.Create(_btn: TWinControl);
procedure PrepareBmp(_w, _h: Integer; _Color: TColor; _Edge: UINT; out _bmp: TBitmap);
var
@@ -108,10 +118,10 @@
x: Integer;
y: Integer;
begin
- x := FBtn.Margin;
+ x := BitBtn.Margin;
y := (_h - FOrigBmp.Height) div 2;
if x = -1 then begin
- // center image the button
+ // center image in the button
x := (_w - FOrigBmp.Width) div 2;
end else begin
// left align image
@@ -121,44 +131,39 @@
procedure HandleTextOnlySingleLine;
var
- TextSize: TSize;
x: Integer;
- y: Integer;
r: TRect;
+ HorizontalAlignment: TDrawTextHorizontalAlignment;
begin
- TextSize := cnv.TextExtent(FCaption);
- x := FBtn.Margin;
- y := (_h - TextSize.cy) div 2;
+ x := BitBtn.Margin;
if x = -1 then begin
- // center
- x := (_w - TextSize.cx) div 2;
+ HorizontalAlignment := dthaCenter;
+ r := Rect(2, 0, _w - 3, _h);
end else begin
- // left align
+ HorizontalAlignment := dthaLeft;
+ r := Rect(x + 2, 0, _w - 3, _h);
end;
- r.Left := x;
- r.Top := y - 1;
- r.Right := x + TextSize.cx;
- r.Bottom := y + TextSize.cy;
- DrawText(cnv.Handle, PChar(FCaption), -1, r, DT_LEFT or DT_TOP or DT_NOCLIP or DT_SINGLELINE);
+ TCanvas_DrawTextSingleLine(cnv, FCaption, r, HorizontalAlignment, dtvaCenter, []);
end;
procedure HandleTextOnlyMultiLine;
var
- qrc: TRect;
+ x: Integer;
+ r: TRect;
TextWidth: Integer;
TextHeight: Integer;
begin
- if FBtn.Margin = -1 then begin
+ x := BitBtn.Margin;
+ if x = -1 then begin
// center
- qrc := Rect(0, 0, _w - 1, _h - 2);
- TCanvas_DrawText(cnv, FCaption, qrc, [dtfCalcRect, dtfCenter, dtfWordBreak]);
- TextWidth := qrc.Right - qrc.Left;
- TextHeight := qrc.Bottom - qrc.Top;
- qrc.Left := (_w - TextWidth) div 2;
- qrc.Top := (_h - TextHeight) div 2;
- qrc.Right := qrc.Left + TextWidth;
- qrc.Bottom := qrc.Top + TextHeight;
- TCanvas_DrawText(cnv, FCaption, qrc, [dtfCenter, dtfWordBreak]);
+ 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.
@@ -165,15 +170,15 @@
// 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.
- qrc := Rect(0, 0, _w - 1 - FBtn.Margin, _h - 2);
- TCanvas_DrawText(cnv, FCaption, qrc, [dtfCalcRect, dtfCenter, dtfWordBreak]);
- TextWidth := qrc.Right - qrc.Left;
- TextHeight := qrc.Bottom - qrc.Top;
- qrc.Left := FBtn.Margin;
- qrc.Top := (_h - TextHeight) div 2;
- qrc.Right := qrc.Left + TextWidth;
- qrc.Bottom := qrc.Top + TextHeight;
- TCanvas_DrawText(cnv, FCaption, qrc, [dtfCenter, dtfWordBreak]);
+ 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;
@@ -180,7 +185,7 @@
procedure HandleTextOnly;
begin
{$IFDEF HAS_BITBTN_WORDWRAP}
- if FBtn.WordWrap then begin
+ if BitBtn.WordWrap then begin
HandleTextOnlyMultiLine;
end else
{$ENDIF}begin
@@ -196,66 +201,66 @@
x: Integer;
begin
TextSize := cnv.TextExtent(FCaption);
- if FBtn.Margin = -1 then begin
+ if BitBtn.Margin = -1 then begin
// center image and text on the button
- RequiredWidth := FOrigBmp.Width + FBtn.Spacing + TextSize.cx;
+ RequiredWidth := FOrigBmp.Width + BitBtn.Spacing + TextSize.cx;
x := (_w - RequiredWidth) div 2;
cnv.Draw(x, (_h - FOrigBmp.Width) div 2, FOrigBmp);
- r.Left := x + FBtn.Margin + FBtn.Spacing + FOrigBmp.Width;
+ 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;
- DrawText(cnv.Handle, PChar(FCaption), -1, r, DT_LEFT or DT_TOP or DT_NOCLIP or DT_SINGLELINE);
+ TCanvas_DrawText(cnv, FCaption, r, [dtfLeft, dtfTopSingle, dtfSingleLine, dtfNoClip]);
end else begin
// left align image and text
- cnv.Draw(FBtn.Margin, (_h - FOrigBmp.Height) div 2, FOrigBmp);
- r.Left := FBtn.Margin + FBtn.Spacing + FOrigBmp.Width;
+ 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;
- DrawText(cnv.Handle, PChar(FCaption), -1, r, DT_LEFT or DT_TOP or DT_NOCLIP or DT_SINGLELINE);
+ TCanvas_DrawText(cnv, FCaption, r, [dtfLeft, dtfTopSingle, dtfSingleLine, dtfNoClip]);
end;
end;
procedure HandleBmpAndMultilineText;
var
- qrc: TRect;
+ r: TRect;
TextWidth: Integer;
TextHeight: Integer;
RequiredWidth: Integer;
x: Integer;
begin
- if FBtn.Margin = -1 then begin
+ if BitBtn.Margin = -1 then begin
// center image and text on the button
- qrc := Rect(0, 0, _w - FOrigBmp.Width - 1 - FBtn.Spacing, _h - 2);
- TCanvas_DrawText(cnv, FCaption, qrc, [dtfCalcRect, dtfCenter, dtfWordBreak]);
- TextWidth := qrc.Right - qrc.Left;
- TextHeight := qrc.Bottom - qrc.Top;
- RequiredWidth := FOrigBmp.Width + FBtn.Spacing + TextWidth;
+ 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);
- qrc.Left := x + FOrigBmp.Width + FBtn.Spacing;
- qrc.Top := (_h - TextHeight) div 2;
- qrc.Right := qrc.Left + TextWidth;
- qrc.Bottom := qrc.Top + TextHeight;
- TCanvas_DrawText(cnv, FCaption, qrc, [dtfCenter, dtfWordBreak]);
+ 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
- qrc := Rect(0, 0, _w - FBtn.Margin - FOrigBmp.Width - 1 - FBtn.Spacing, _h - 2);
- TCanvas_DrawText(cnv, FCaption, qrc, [dtfCalcRect, dtfCenter, dtfWordBreak]);
- TextWidth := qrc.Right - qrc.Left;
- TextHeight := qrc.Bottom - qrc.Top;
+ 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;
- cnv.Draw(FBtn.Margin, (_h - FOrigBmp.Width) div 2, FOrigBmp);
+ cnv.Draw(BitBtn.Margin, (_h - FOrigBmp.Width) div 2, FOrigBmp);
- qrc.Left := FBtn.Margin + FOrigBmp.Width + FBtn.Spacing;
- qrc.Top := (_h - TextWidth) div 2;
- qrc.Right := qrc.Left + TextWidth;
- qrc.Bottom := qrc.Top + TextHeight;
- TCanvas_DrawText(cnv, FCaption, qrc, [dtfCenter, dtfWordBreak]);
+ 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;
end;
@@ -264,7 +269,7 @@
// This is complicated. For now we will only support buttons with
// Layout=blGlyphLeft
{$IFDEF HAS_BITBTN_WORDWRAP}
- if FBtn.WordWrap then begin
+ if BitBtn.WordWrap then begin
HandleBmpAndMultilineText;
end else
{$ENDIF}begin
@@ -273,7 +278,7 @@
end;
var
- qrc: TRect;
+ r: TRect;
begin
_bmp := TBitmap.Create;
_bmp.Width := _w;
@@ -285,11 +290,13 @@
cnv.Brush.Color := _Color;
cnv.Brush.Style := bsSolid;
cnv.FillRect(Rect(0, 0, _w, _h));
- cnv.Font := FBtn.Font;
- qrc := Rect(0, 0, _w - 1, _h - 2);
- DrawEdge(cnv.Handle, qrc, _Edge, BF_RECT);
+ r := Rect(0, 0, _w - 1, _h - 2);
+ DrawEdge(cnv.Handle, r, _Edge, BF_RECT);
+ cnv.Brush.Style := bsClear;
+ cnv.Font := BitBtn.Font;
+
if FCaption <> '' then begin
if (FOrigBmp.Width <> 0) and (FOrigBmp.Height <> 0) then begin
HandleBmpAndText;
@@ -309,18 +316,17 @@
ColBack2: TColor;
begin
inherited Create(_btn);
- FBtn := _btn as TBitBtn;
- FOrigOnClick := FBtn.OnClick;
- FCaption := FBtn.Caption;
+ FOrigOnClick := BitBtn.OnClick;
+ FCaption := BitBtn.Caption;
FOrigBmp := TBitmap.Create;
- FOrigBmp.Assign(FBtn.Glyph);
+ FOrigBmp.Assign(BitBtn.Glyph);
FOrigBmp.Transparent := True;
- FBtn.Caption := '';
+ BitBtn.Caption := '';
- w := FBtn.Width - 1;
- h := FBtn.Height - 1;
+ w := BitBtn.ClientWidth;
+ h := BitBtn.ClientHeight;
ColBack1 := rgb(240, 240, 240); // clBtnFace;
ColBack2 := rgb(245, 245, 245); // a bit lighter than clBtnFace;
@@ -328,10 +334,10 @@
PrepareBmp(w, h, ColBack1, EDGE_RAISED, FUpBmp);
PrepareBmp(w, h, ColBack2, EDGE_SUNKEN, FDownBmp);
- FBtn.OnClick := HandleOnClick;
+ BitBtn.OnClick := HandleOnClick;
- FBtn.Margin := -1;
- FBtn.Spacing := 0;
+ BitBtn.Margin := -1;
+ BitBtn.Spacing := 0;
UpdateGlyph;
end;
@@ -339,7 +345,7 @@
destructor TdzSpeedBitBtn.Destroy;
begin
// If we get here, either the constructor failed (which automatically calls the destructor)
- // or FBtn was already destroyed, so we must not access it at all.
+ // or BitBtn was already destroyed, so we must not access it at all.
FUpBmp.Free;
FDownBmp.Free;
FOrigBmp.Free;
@@ -358,31 +364,48 @@
doOnClick(_Sender);
end;
+procedure TdzSpeedBitBtn.NewWindowProc(var _Msg: TMessage);
+begin
+ if _Msg.Msg = CM_DIALOGKEY then begin
+ if IsAccel(TCMDialogChar(_Msg).CharCode, FCaption) and BitBtn.CanFocus then begin
+ BitBtn.Click;
+ _Msg.Result := 1;
+ end else
+ inherited;
+ end else
+ inherited;
+end;
+
+function TdzSpeedBitBtn.GetBitBtn: TBitBtn;
+begin
+ Result := Self.FCtrl as TBitBtn;
+end;
+
function TdzSpeedBitBtn.GetDown: Boolean;
begin
- Result := (FBtn.Tag <> 0);
+ Result := (BitBtn.Tag <> 0);
end;
procedure TdzSpeedBitBtn.SetDown(const Value: Boolean);
begin
if Value then
- FBtn.Tag := 1
+ BitBtn.Tag := 1
else
- FBtn.Tag := 0;
+ BitBtn.Tag := 0;
UpdateGlyph;
end;
procedure TdzSpeedBitBtn.UpdateGlyph;
begin
- if FBtn.Tag <> 0 then
- FBtn.Glyph := FDownBmp
+ if BitBtn.Tag <> 0 then
+ BitBtn.Glyph := FDownBmp
else
- FBtn.Glyph := FUpBmp;
+ BitBtn.Glyph := FUpBmp;
// Setting Glyph may change the NumGlyph property (if the Width to Height ration of the bitmap
// is 4, 3 or 2 to 1). We don't want that, so we change it back. (Bloody computer trying to
// be clever :-(.)
- FBtn.NumGlyphs := 1;
+ BitBtn.NumGlyphs := 1;
end;
{ TdzSpeedBitBtnGroup }
@@ -399,7 +422,7 @@
inherited;
end;
-function TdzSpeedBitBtnGroup.Add(_btn: TBitBtn; _Data: Pointer = nil): TdzSpeedBitBtn;
+function TdzSpeedBitBtnGroup.Add(_btn: TBitBtn; _Data: Pointer): TdzSpeedBitBtn;
begin
_btn.OnClick := Self.HandleClick;
Result := TdzSpeedBitBtn.Create(_btn);
@@ -407,6 +430,16 @@
FList.Add(Result);
end;
+function TdzSpeedBitBtnGroup.Add(_btn: TBitBtn): TdzSpeedBitBtn;
+begin
+ Result := Add(_btn, nil);
+end;
+
+function TdzSpeedBitBtnGroup.Add(_btn: TBitBtn; _Data: Integer): TdzSpeedBitBtn;
+begin
+ Result := Add(_btn, Pointer(_Data));
+end;
+
procedure TdzSpeedBitBtnGroup.doOnClick;
begin
if Assigned(FOnClick) then
@@ -473,7 +506,7 @@
Result := False;
end;
-procedure TdzSpeedBitBtnGroup.SetDown(_Idx: Integer);
+procedure TdzSpeedBitBtnGroup.SetDown(_Idx: Integer; _CallClick: Boolean = False);
var
i: Integer;
sb: TdzSpeedBitBtn;
@@ -485,9 +518,11 @@
else
sb.Down := False;
end;
+ if _CallClick then
+ doOnClick;
end;
-procedure TdzSpeedBitBtnGroup.SetDown(_btn: TBitBtn);
+procedure TdzSpeedBitBtnGroup.SetDown(_btn: TBitBtn; _CallClick: Boolean = False);
var
i: Integer;
sb: TdzSpeedBitBtn;
@@ -499,9 +534,11 @@
else
sb.Down := False;
end;
+ if _CallClick then
+ doOnClick;
end;
-procedure TdzSpeedBitBtnGroup.SetDown(_Data: Pointer);
+procedure TdzSpeedBitBtnGroup.SetDown(_Data: Pointer; _CallClick: Boolean = False);
var
i: Integer;
sb: TdzSpeedBitBtn;
@@ -513,8 +550,35 @@
else
sb.Down := False;
end;
+ if _CallClick then
+ doOnClick;
end;
+function TdzSpeedBitBtnGroup.SetUp(_btn: TBitBtn): Boolean;
+var
+ i: Integer;
+ sb: TdzSpeedBitBtn;
+begin
+ if FAllowAllUp then begin
+ for i := 0 to FList.Count - 1 do begin
+ sb := TdzSpeedBitBtn(FList[i]);
+ if sb.BitBtn = _btn then
+ sb.Down := False;
+ end;
+ Result := True;
+ end else if FList.Count = 2 then begin
+ for i := 0 to FList.Count - 1 do begin
+ sb := TdzSpeedBitBtn(FList[i]);
+ if sb.BitBtn = _btn then
+ sb.Down := False
+ else
+ sb.Down := True;
+ end;
+ Result := True;
+ end else
+ Result := False;
+end;
+
function TdzSpeedBitBtnGroup.SetUp(_Idx: Integer): Boolean;
var
i: Integer;
@@ -527,19 +591,17 @@
sb.Down := False;
end;
Result := True;
- end else begin
- if FList.Count = 2 then begin
- for i := 0 to FList.Count - 1 do begin
- sb := TdzSpeedBitBtn(FList[i]);
- if i = _Idx then
- sb.Down := False
- else
- sb.Down := True;
- end;
- Result := True;
- end else
- Result := False;
- end;
+ end else if FList.Count = 2 then begin
+ for i := 0 to FList.Count - 1 do begin
+ sb := TdzSpeedBitBtn(FList[i]);
+ if i = _Idx then
+ sb.Down := False
+ else
+ sb.Down := True;
+ end;
+ Result := True;
+ end else
+ Result := False;
end;
function TdzSpeedBitBtnGroup.TryGetSelectedSb(out _Idx: Integer; out _sb: TdzSpeedBitBtn): Boolean;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-05-29 15:27:00
|
Revision: 3167
http://sourceforge.net/p/gexperts/code/3167
Author: twm
Date: 2020-05-29 15:26:58 +0000 (Fri, 29 May 2020)
Log Message:
-----------
Updated to current version from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzErrorThread.pas
trunk/ExternalSource/dzlib/u_dzLineBuilder.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/u_dzErrorThread.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzErrorThread.pas 2020-05-29 15:07:11 UTC (rev 3166)
+++ trunk/ExternalSource/dzlib/u_dzErrorThread.pas 2020-05-29 15:26:58 UTC (rev 3167)
@@ -45,6 +45,15 @@
function WaitFor(_TimeoutMsecs: DWORD; out _ReturnValue: DWORD): Boolean; overload;
function WaitFor(_TimeoutMsecs: DWORD): Boolean; overload;
///<summary>
+ /// Calls Windows.TerminateThread to kill the thread without freeing resources.
+ /// Read the documentation first!
+ /// https://docs.microsoft.com/en-us/windows/win32/api/processthreadsapi/nf-processthreadsapi-terminatethread
+ /// @ExitCode is the exit code to return to GetExitCodeThread calls.
+ /// NOTE: ExitCode must *not* be STILL_ACTIVE (259)
+ /// @returns True, if TerminateThread was called
+ /// False if not (e.g. if the thread was already finished or never started) </summary>
+ function Kill_YesIHaveReadTheTerminateThreadApiDocumentation(_ExitCode: DWORD): Boolean;
+ ///<summary>
/// Is true, when the thread has finished executing </summary>
property HasFinished: Boolean read FHasFinished;
///<summary>
@@ -101,6 +110,14 @@
end;
end;
+function TErrorThread.Kill_YesIHaveReadTheTerminateThreadApiDocumentation(_ExitCode: DWORD): Boolean;
+begin
+ Result := not FHasFinished and (Handle <> 0);
+ if Result then begin
+ Win32Check(Windows.TerminateThread(Handle, 5));
+ end;
+end;
+
function TErrorThread.WaitFor(_TimeoutMsecs: DWORD): Boolean;
var
Dummy: DWORD;
@@ -112,14 +129,14 @@
function TErrorThread.WaitFor(_TimeoutMsecs: DWORD; out _ReturnValue: DWORD): Boolean;
var
- H: array[0..1] of THandle;
+ h: array[0..1] of THandle;
WaitResult: Cardinal;
Msg: TMsg;
begin
- H[0] := Handle;
+ h[0] := Handle;
if GetCurrentThreadID = MainThreadID then begin
WaitResult := 0;
- H[1] := SyncEvent;
+ h[1] := SyncEvent;
repeat
{ This prevents a potential deadlock if the background thread
does a SendMessage to the foreground thread }
@@ -126,9 +143,9 @@
if WaitResult = WAIT_OBJECT_0 + 2 then
PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
if _TimeoutMsecs = INFINITE then begin
- WaitResult := MsgWaitForMultipleObjects(2, H, False, 1000, QS_SENDMESSAGE);
+ WaitResult := MsgWaitForMultipleObjects(2, h, False, 1000, QS_SENDMESSAGE);
end else begin
- WaitResult := MsgWaitForMultipleObjects(2, H, False, _TimeoutMsecs, QS_SENDMESSAGE);
+ WaitResult := MsgWaitForMultipleObjects(2, h, False, _TimeoutMsecs, QS_SENDMESSAGE);
end;
CheckThreadError(WaitResult <> WAIT_FAILED);
if WaitResult = WAIT_OBJECT_0 + 1 then
@@ -136,13 +153,13 @@
Result := (WaitResult = WAIT_OBJECT_0);
until Result or (_TimeoutMsecs <> INFINITE);
end else begin
- WaitResult := WaitForSingleObject(H[0], _TimeoutMsecs);
+ WaitResult := WaitForSingleObject(h[0], _TimeoutMsecs);
if WaitResult = WAIT_FAILED then
RaiseLastOSError;
Result := (WaitResult <> WAIT_TIMEOUT);
end;
if Result then
- CheckThreadError(GetExitCodeThread(H[0], _ReturnValue));
+ CheckThreadError(GetExitCodeThread(h[0], _ReturnValue));
end;
{$ELSE}
@@ -150,11 +167,11 @@
function TErrorThread.WaitFor(_TimeoutMsecs: DWORD; out _ReturnValue: DWORD): Boolean;
var
- H: THandle;
+ h: THandle;
WaitResult: Cardinal;
Msg: TMsg;
begin
- H := Handle;
+ h := Handle;
if GetCurrentThreadID = MainThreadID then begin
WaitResult := 0;
repeat
@@ -163,9 +180,9 @@
if WaitResult = WAIT_OBJECT_0 + 1 then
PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
if _TimeoutMsecs = INFINITE then begin
- WaitResult := MsgWaitForMultipleObjects(2, H, False, 1000, QS_SENDMESSAGE)
+ WaitResult := MsgWaitForMultipleObjects(2, h, False, 1000, QS_SENDMESSAGE)
end else begin
- WaitResult := MsgWaitForMultipleObjects(1, H, False, _TimeoutMsecs, QS_SENDMESSAGE);
+ WaitResult := MsgWaitForMultipleObjects(1, h, False, _TimeoutMsecs, QS_SENDMESSAGE);
end;
CheckThreadError(WaitResult <> WAIT_FAILED);
if WaitResult = WAIT_OBJECT_0 + 1 then
@@ -173,13 +190,13 @@
Result := (WaitResult = WAIT_OBJECT_0);
until Result or (_TimeoutMsecs <> INFINITE);
end else begin
- WaitResult := WaitForSingleObject(H, _TimeoutMsecs);
+ WaitResult := WaitForSingleObject(h, _TimeoutMsecs);
if WaitResult = WAIT_FAILED then
RaiseLastOSError;
Result := (WaitResult <> WAIT_TIMEOUT);
end;
if Result then
- CheckThreadError(GetExitCodeThread(H, _ReturnValue));
+ CheckThreadError(GetExitCodeThread(h, _ReturnValue));
end;
{$IFEND}
Modified: trunk/ExternalSource/dzlib/u_dzLineBuilder.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzLineBuilder.pas 2020-05-29 15:07:11 UTC (rev 3166)
+++ trunk/ExternalSource/dzlib/u_dzLineBuilder.pas 2020-05-29 15:26:58 UTC (rev 3167)
@@ -65,6 +65,8 @@
procedure Prepend(_Line: TLineBuilder);
///<summary> Extracts the first column from the line, returns false when empty </summary>
function ExtractFirst(out _Column: string): Boolean;
+ ///<summary> @returns the length of Content </summary>
+ function Length: Integer;
///<summary> allows read access to the content that has been built </summary>
property Content: string read FContent;
property ColumnCount: Integer read FColumnCount;
@@ -112,6 +114,11 @@
{$IFEND}
end;
+function TLineBuilder.Length: Integer;
+begin
+ Result := System.Length(FContent);
+end;
+
procedure TLineBuilder.SetDecimalSeparator(_Value: Char);
begin
{$IF Declared(TFormatSettings)}
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-05-29 15:07:11 UTC (rev 3166)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-05-29 15:26:58 UTC (rev 3167)
@@ -576,6 +576,11 @@
///<summary> adds a new TTabSheet with the given Caption to the PageControl and returns it </summary>
function TPageControl_AddTabSheet(_PageControl: TPageControl; const _Caption: string): TTabSheet;
+///<summary>
+/// Inserts a TTabSheet with the given caption at the given index into the page control and returns it </summary>
+function TPageControl_InsertTabSheet(_PageControl: TPageControl; _Idx: Integer;
+ const _Caption: string): TTabSheet;
+
///<summary> Draws the tab text for a TPageControl as horizontal text, useful, if you
/// want to have the tabs on the left or right but don't want vertical text.
/// Set the TPageControl's OwnerDraw property to true, the TabHeight property
@@ -2858,6 +2863,13 @@
Result.Caption := _Caption;
end;
+function TPageControl_InsertTabSheet(_PageControl: TPageControl; _Idx: Integer;
+ const _Caption: string): TTabSheet;
+begin
+ Result := TPageControl_AddTabSheet(_PageControl, _Caption);
+ Result.PageIndex := _Idx;
+end;
+
procedure DrawTab(_TabControl: TCustomTabControl; const _Caption: string;
const _Rect: TRect; _Active: Boolean);
var
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-07-06 09:25:53
|
Revision: 3210
http://sourceforge.net/p/gexperts/code/3210
Author: twm
Date: 2020-07-06 09:25:50 +0000 (Mon, 06 Jul 2020)
Log Message:
-----------
updated to latest version from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzFileUtils.pas
trunk/ExternalSource/dzlib/u_dzTranslator.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-07-05 18:25:42 UTC (rev 3209)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-07-06 09:25:50 UTC (rev 3210)
@@ -87,6 +87,10 @@
{$DEFINE HAS_INTTOHEX_FUNCTION}
{$ENDIF}
+{$IFOPT T+}
+{$DEFINE TYPEDADDRESS_IS_ON}
+{$ENDIF}
+
// we currently support only Windows (and a very small subset of Win64), so we turn platform
// warnings off
Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2020-07-05 18:25:42 UTC (rev 3209)
+++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2020-07-06 09:25:50 UTC (rev 3210)
@@ -114,8 +114,18 @@
/// @param IncludePath determines whether the List of filenames includes the full path or not </summary>
class function Execute(const _Mask: string; _List: TStrings;
_MayHaveAttr: TFileAttributeSet = ALL_FILES_ATTRIB_SET; _IncludePath: Boolean = False; _Sort: Boolean = True): Integer;
+ /// <summary>
+ /// creates a TSimpleDirEnumerator, calls its FindAll method and frees it
+ /// @param List is a string list to which the files will be appended, may be nil
+ /// @param IncludePath determines whether the List of filenames includes the full path or not </summary>
class function EnumFilesOnly(const _Mask: string; _List: TStrings;
- _IncludePath: Boolean = False; _Sort: Boolean = True): Integer;
+ _IncludePath: Boolean = False; _Sort: Boolean = True): Integer; overload;
+ class function EnumFilesOnly(const _Mask: string;
+ _IncludePath: Boolean = False; _Sort: Boolean = True): TStringArray; overload;
+ /// <summary>
+ /// creates a TSimpleDirEnumerator, calls its FindAll method and frees it
+ /// @param List is a string list to which the files will be appended, may be nil
+ /// @param IncludePath determines whether the List of filenames includes the full path or not </summary>
class function EnumDirsOnly(const _Mask: string; _List: TStrings;
_IncludePath: Boolean = False; _Sort: Boolean = True): Integer;
/// <summary>
@@ -1113,7 +1123,8 @@
procedure Init(const _s: string);
function PartCount: Integer;
function Part(_Idx: Integer): string;
- procedure GetParts(_Parts: TStrings);
+ procedure GetParts(_Parts: TStrings); overload;
+ function GetParts: TStringArray; overload;
procedure AssignParts(_Parts: TStrings);
class operator Implicit(_sl: TStrings): TSearchPath;
class operator Implicit(const _s: string): TSearchPath;
@@ -1272,6 +1283,20 @@
end;
end;
+class function TSimpleDirEnumerator.EnumFilesOnly(const _Mask: string; _IncludePath,
+ _Sort: Boolean): TStringArray;
+var
+ sl: TStringList;
+begin
+ sl := TStringList.Create;
+ try
+ EnumFilesOnly(_Mask, sl, _IncludePath, _Sort);
+ Result := TStringArray_FromStrings(sl);
+ finally
+ FreeAndNil(sl);
+ end;
+end;
+
class function TSimpleDirEnumerator.EnumFilesOnly(const _Mask: string; _List: TStrings;
_IncludePath, _Sort: Boolean): Integer;
begin
@@ -3653,6 +3678,18 @@
end;
end;
+function TSearchPath.GetParts: TStringArray;
+var
+ sl: TStringList;
+begin
+ sl := AsStringlist;
+ try
+ Result := TStringArray_FromStrings(sl);
+ finally
+ FreeAndNil(sl);
+ end;
+end;
+
procedure TSearchPath.Init(const _s: string);
begin
FValue := _s;
Modified: trunk/ExternalSource/dzlib/u_dzTranslator.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTranslator.pas 2020-07-05 18:25:42 UTC (rev 3209)
+++ trunk/ExternalSource/dzlib/u_dzTranslator.pas 2020-07-06 09:25:50 UTC (rev 3210)
@@ -387,4 +387,3 @@
{$ENDIF gnugettext}
end.
-
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-07-05 18:25:42 UTC (rev 3209)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-07-06 09:25:50 UTC (rev 3210)
@@ -6,6 +6,7 @@
uses
SysUtils,
+ Classes,
Types; // for $IF Declared(TBytes)
type
@@ -38,7 +39,18 @@
type
TMethodPointer = procedure of object;
+function TStringArray_FromStrings(_sl: TStrings): TStringArray;
+
implementation
+function TStringArray_FromStrings(_sl: TStrings): TStringArray;
+var
+ i: Integer;
+begin
+ SetLength(Result, _sl.count);
+ for i := 0 to _sl.count - 1 do
+ Result[i] := _sl[i];
+end;
+
end.
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-07-05 18:25:42 UTC (rev 3209)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-07-06 09:25:50 UTC (rev 3210)
@@ -998,12 +998,14 @@
procedure TRadioGroup_SelectWithoutClickEvent(_rg: TCustomRadioGroup; _Idx: Integer);
///<summary> Gets the object pointer of the selected RadioGroup item
-/// @param cmb is the TCustomListbox (descendant) to read from
-/// @param Idx is the listbox's ItemIndex, only valid if the function returns true
+/// @param cmb is the TCustomRadioGroup (descendant) to read from
+/// @param Idx is the radio group's ItemIndex, only valid if the function returns true
/// @param Obj is the value of the object pointer of the selected item, only valid
/// if the function returns true
/// @returns true, if the out parameters are valid </summary>
-function TRadioGroup_GetSelectedObject(_rg: TCustomRadioGroup; out _Idx: Integer; out _Obj: Pointer): Boolean;
+function TRadioGroup_GetSelectedObject(_rg: TCustomRadioGroup; out _Idx: Integer; out _Obj: Pointer): Boolean; overload;
+function TRadioGroup_GetSelectedObject(_rg: TCustomRadioGroup; out _Obj: Pointer): Boolean; overload;
+function TRadioGroup_GetSelectedObject(_rg: TCustomRadioGroup; out _ObjAsInt: Integer): Boolean; overload;
///<summary> Writes a TPicture object to a String. The Format is
/// <pictureformat>#26<picturedata> </summary>
@@ -1787,7 +1789,7 @@
AssignFile(t, _Filename);
Rewrite(t);
try
- write(t, s);
+ Write(t, s);
finally
CloseFile(t);
end;
@@ -2188,7 +2190,6 @@
end;
{$IF Declared(TryIso2Time)}
-
function TEdit_TextHHMMSSToTime(_ed: TCustomEdit; _FocusControl: Boolean = True): TDateTime;
var
s: string;
@@ -3776,6 +3777,22 @@
_Obj := Hack.Items.Objects[_Idx];
end;
+function TRadioGroup_GetSelectedObject(_rg: TCustomRadioGroup; out _Obj: Pointer): Boolean;
+var
+ Idx: Integer;
+begin
+ Result := TRadioGroup_GetSelectedObject(_rg, Idx, _Obj);
+end;
+
+function TRadioGroup_GetSelectedObject(_rg: TCustomRadioGroup; out _ObjAsInt: Integer): Boolean;
+var
+ Obj: Pointer;
+begin
+ Result := TRadioGroup_GetSelectedObject(_rg, Obj);
+ if Result then
+ _ObjAsInt := Integer(Obj);
+end;
+
function TRichEdit_WriteToString(_Re: TRichEdit): string;
var
st: TMemoryStream;
@@ -3949,7 +3966,7 @@
procedure TControl_SetHint(_Ctrl: TControl; const _Hint: string);
begin
- _Ctrl.hint := _Hint;
+ _Ctrl.Hint := _Hint;
_Ctrl.ShowHint := True;
end;
@@ -5377,12 +5394,12 @@
begin
inherited Create;
FCtrl := _Ctrl;
- SendMessage(FCtrl.Handle, WM_SETREDRAW, wParam(LongBool(False)), 0);
+ SendMessage(FCtrl.Handle, WM_SETREDRAW, WPARAM(LongBool(False)), 0);
end;
destructor TWinControlLocker.Destroy;
begin
- SendMessage(FCtrl.Handle, WM_SETREDRAW, wParam(LongBool(True)), 0);
+ SendMessage(FCtrl.Handle, WM_SETREDRAW, WPARAM(LongBool(True)), 0);
RedrawWindow(FCtrl.Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
inherited;
end;
@@ -5438,8 +5455,8 @@
procedure TdzButtonedEdit.Loaded;
begin
inherited;
- if RightButton.Visible and (RightButton.hint = '') then begin
- RightButton.hint := _('Ctrl+Return to ''click'' right button.');
+ if RightButton.Visible and (RightButton.Hint = '') then begin
+ RightButton.Hint := _('Ctrl+Return to ''click'' right button.');
ShowHint := True;
end;
end;
@@ -6443,7 +6460,7 @@
tb: TTrackBar;
begin
tb := TrackBar;
- tb.hint := IntToStr(tb.Position);
+ tb.Hint := IntToStr(tb.Position);
Application.ActivateHint(Mouse.CursorPos);
doOnChange(_Sender);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-07-18 17:05:57
|
Revision: 3231
http://sourceforge.net/p/gexperts/code/3231
Author: twm
Date: 2020-07-18 17:05:55 +0000 (Sat, 18 Jul 2020)
Log Message:
-----------
updated dzlib from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzClassUtils.pas
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzStringUtils.pas
trunk/ExternalSource/dzlib/u_dzTranslator.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-07-18 11:55:20 UTC (rev 3230)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-07-18 17:05:55 UTC (rev 3231)
@@ -8,10 +8,6 @@
{$DEFINE HAS_UNIT_SYSTEM_JSON}
{$ENDIF}
-{$IFNDEF DELPHIXE7_UP}
-{$DEFINE STARTSTEXT_IMPLEMENTATION_REQUIRED}
-{$ENDIF}
-
{$IFDEF DELPHIXE7_UP}
// For now I assume the BDE is not installed for Delphi XE7 and later, but that
// largely depends on what the user selected for installation.
@@ -48,7 +44,7 @@
{$ENDIF}
{$IFDEF DELPHI7_UP}
-{$IFNDEF DELPHI_2009_UP}
+{$IFNDEF DELPHI2009_UP}
// Between Delphi 7 and 2007 Native(U)Int is wrongly declared as a 64 bit integer even though
// the compiler only supports 32 bits.
{$DEFINE NATIVE_INT_IS_WRONG}
Modified: trunk/ExternalSource/dzlib/u_dzClassUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2020-07-18 11:55:20 UTC (rev 3230)
+++ trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2020-07-18 17:05:55 UTC (rev 3231)
@@ -203,7 +203,10 @@
/// @param s is the string to write
/// @returns the number of bytes written.
/// </summary>
-function TStream_WriteString(_Stream: TStream; const _s: RawByteString): Integer;
+function TStream_WriteString(_Stream: TStream; const _s: RawByteString): Integer; overload;
+{$IFDEF UNICODE}
+function TStream_WriteString(_Stream: TStream; const _s: string): Integer; overload;
+{$ENDIF}
/// <summary>
/// Write a ShortString to the stream as binary, that is the length byte followed by len content bytes
@@ -226,7 +229,10 @@
/// @param s is the string to write
/// @returns the number of bytes written.
/// </summary>
-function TStream_WriteStringLn(_Stream: TStream; const _s: RawByteString): Integer;
+function TStream_WriteStringLn(_Stream: TStream; const _s: RawByteString): Integer; overload;
+{$IFDEF UNICODE}
+function TStream_WriteStringLn(_Stream: TStream; const _s: string): Integer; overload;
+{$ENDIF}
/// <summary>
/// Read a line from a stream, that is, a string ending in CRLF
@@ -234,7 +240,10 @@
/// @param s returns the read string, without the CRLF
/// @returns the number of bytes read, excluding the CRLF
/// </summary>
-function TStream_ReadStringLn(_Stream: TStream; out _s: string): Integer;
+function TStream_ReadStringLn(_Stream: TStream; out _s: RawByteString): Integer; overload;
+{$IFDEF UNICODE}
+function TStream_ReadStringLn(_Stream: TStream; out _s: string): Integer; overload;
+{$ENDIF}
/// <summary>
/// Write formatted data to the stream appending CRLF
@@ -1025,6 +1034,13 @@
end;
end;
+{$IFDEF UNICODE}
+function TStream_WriteString(_Stream: TStream; const _s: string): Integer;
+begin
+ Result := TStream_WriteString(_Stream, RawByteString(_s));
+end;
+{$ENDIF}
+
function TStream_WriteShortStringBinary(_Stream: TStream; const _s: ShortString): Integer;
var
Len: Byte;
@@ -1051,24 +1067,30 @@
Result := Result + TStream_WriteString(_Stream, #13#10);
end;
+{$IFDEF UNICODE}
+function TStream_WriteStringLn(_Stream: TStream; const _s: string): Integer;
+begin
+ Result := TStream_WriteStringLn(_Stream, RawByteString(_s));
+end;
+{$ENDIF}
+
function TStream_WriteFmtLn(_Stream: TStream; const _Format: string; _Args: array of const): Integer;
begin
Result := TStream_WriteStringLn(_Stream, AnsiString(Format(_Format, _Args)));
end;
-function TStream_ReadStringLn(_Stream: TStream; out _s: string): Integer;
+function TStream_ReadStringLn(_Stream: TStream; out _s: RawByteString): Integer;
var
OldPos: Int64;
EndString: Int64;
NewPos: Int64;
c: AnsiChar;
- s: AnsiString;
begin
// twm: this is not really efficient, because it reads single bytes, if it becomes a problem, optimize it ;-)
OldPos := _Stream.Position;
{$IFNDEF DELPHIX_BERLIN_UP}
- Endstring := 0;
+ EndString := 0;
NewPos := 0;
{$ENDIF}
while True do begin
@@ -1088,15 +1110,24 @@
end;
end;
Result := EndString - OldPos;
- SetLength(s, Result);
+ SetLength(_s, Result);
if Result <> 0 then begin
_Stream.Position := OldPos;
- _Stream.ReadBuffer(s[1], Length(s));
- _s := string(s);
+ _Stream.ReadBuffer(_s[1], Length(_s));
end;
_Stream.Position := NewPos;
end;
+{$IFDEF UNICODE}
+function TStream_ReadStringLn(_Stream: TStream; out _s: string): Integer;
+var
+ s: RawByteString;
+begin
+ Result := TStream_ReadStringLn(_Stream, s);
+ _s := string(s);
+end;
+{$ENDIF}
+
function TStrings_TryStringByObj(_Strings: TStrings; _Obj: Pointer; out _Value: string): Boolean;
var
i: Integer;
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-07-18 11:55:20 UTC (rev 3230)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-07-18 17:05:55 UTC (rev 3231)
@@ -23,6 +23,10 @@
DZ_FORMAT_DECIMAL_POINT: TFormatSettings;
{$IFEND}
+{$IF Declared(FormatSettings)}
+function DecimalSeparator: Char; inline;
+{$IFEND}
+
type
///<summary>
/// Raised by the number conversion functions if a digit is invalid for the given base. </summary>
@@ -771,7 +775,6 @@
end;
{$IF Declared(FormatSettings)}
-
function DecimalSeparator: Char; inline;
begin
Result := FormatSettings.DecimalSeparator;
Modified: trunk/ExternalSource/dzlib/u_dzStringUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2020-07-18 11:55:20 UTC (rev 3230)
+++ trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2020-07-18 17:05:55 UTC (rev 3231)
@@ -68,12 +68,14 @@
///<summary>
/// @returns true, if the given string is one of the strings in the given array
/// Comparison is case sensitive </summary>
-function IsStringIn(const _s: string; const _Arr: array of string): Boolean;
+function IsStringIn(const _s: string; const _Arr: array of string; out _Idx: Integer): Boolean; overload;
+function IsStringIn(const _s: string; const _Arr: array of string): Boolean; overload;
///<summary>
/// @returns true, if the given string is one of the strings in the given array
/// Comparison is case insensitive </summary>
-function IsTextIn(const _s: string; const _Arr: array of string): Boolean;
+function IsTextIn(const _s: string; const _Arr: array of string; out _Idx: Integer): Boolean; overload;
+function IsTextIn(const _s: string; const _Arr: array of string): Boolean; overload;
///<summary>
/// Function is deprecated, use ExtractStr instead </summary>
@@ -433,6 +435,15 @@
function SplitString(_s: string; const _Delimiters: string): TStringArray; overload;
function SplitString(_s: string; const _Delimiters: array of Char): TStringArray; overload;
+function TStringArray_FromStrings(_sl: TStrings): TStringArray;
+
+///<summary>
+/// Deletes Count entries from Arr starting from Index.
+/// @Note: It is allowed for Index > Length(Arr) and also Index+Count > Length(Arr)
+/// @raises ERangeCheck if Index or Count < 0 </summary>
+procedure Delete(var _Arr: TStringArray; _Index: Integer; _Count: Integer); overload;
+function Concat(const _Arr1, _Arr2: array of string): TStringArray; overload;
+
{$IFDEF SUPPORTS_UNICODE}
function Copy(const _s: AnsiString; _Pos, _Len: Integer): AnsiString; overload;
function Copy(const _s: AnsiString; _Pos: Integer): AnsiString; overload;
@@ -486,6 +497,7 @@
implementation
uses
+ SysConst,
u_dzConvertUtils;
function _(const _s: string): string;
@@ -706,6 +718,58 @@
SetLength(Result, Idx);
end;
+function TStringArray_FromStrings(_sl: TStrings): TStringArray;
+var
+ i: Integer;
+begin
+ SetLength(Result, _sl.count);
+ for i := 0 to _sl.count - 1 do
+ Result[i] := _sl[i];
+end;
+
+procedure Delete(var _Arr: TStringArray; _Index: Integer; _Count: Integer); overload;
+var
+ Len: Integer;
+ i: Integer;
+begin
+ if _Index < 0 then
+ raise ERangeError.CreateRes(@SRangeError);
+ if _Count < 0 then
+ raise ERangeError.CreateRes(@SRangeError);
+
+ Len := Length(_Arr);
+ if _Index > Len - 1 then begin
+ // after the end of the array -> nothing to do
+ Exit; //==>
+ end;
+
+ if _Index >= Len - _Count then begin
+ // delete from the end
+ SetLength(_Arr, _Index);
+ Exit; //==>
+ end;
+
+ for i := _Index to Len - _Count - 1 do begin
+ _Arr[i] := _Arr[i + _Count];
+ end;
+ SetLength(_Arr, Len - _Count);
+end;
+
+function Concat(const _Arr1, _Arr2: array of string): TStringArray;
+var
+ Len1: Integer;
+ Len2: Integer;
+ i: Integer;
+begin
+ Len1 := Length(_Arr1);
+ Len2 := Length(_Arr2);
+ SetLength(Result, Len1 + Len2);
+ for i := 0 to Len1 - 1 do
+ Result[i] := _Arr1[i];
+ for i := 0 to Len2 - 1 do
+ Result[i + Len1] := _Arr2[i];
+end;
+
function ReplaceChars(const _s, _Search, _Replace: string): string;
var
i, j: LongInt;
@@ -761,7 +825,7 @@
Result[i] := _ReplaceChar;
Dup := True;
end else
- Delete(Result, i, 1);
+ System.Delete(Result, i, 1);
end else
Dup := False;
end;
@@ -849,12 +913,12 @@
{$IFDEF STARTSTEXT_IMPLEMENTATION_REQUIRED}
function StartsText(const _Start, _s: string): Boolean;
begin
- Result := UStartsWith(_Start, _s);
+ Result := AnsiStartsText(_Start, _s);
end;
{$ENDIF}
{$IFDEF STARTSSTR_IMPLEMENTATION_REQUIRED}
-function StartsStr(const _Start, _s: string): boolean;
+function StartsStr(const _Start, _s: string): Boolean;
begin
Result := AnsiStartsStr(_Start, _s);
end;
@@ -1518,7 +1582,7 @@
Result := string(s);
end;
-function IsStringIn(const _s: string; const _Arr: array of string): Boolean;
+function IsStringIn(const _s: string; const _Arr: array of string; out _Idx: Integer): Boolean;
var
i: Integer;
begin
@@ -1526,22 +1590,38 @@
for i := 0 to Length(_Arr) - 1 do
if _s = _Arr[i] then begin
Result := True;
+ _Idx := i;
Exit; //==>
end;
end;
-function IsTextIn(const _s: string; const _Arr: array of string): Boolean;
+function IsStringIn(const _s: string; const _Arr: array of string): Boolean;
var
+ Idx: Integer;
+begin
+ Result := IsStringIn(_s, _Arr, Idx);
+end;
+
+function IsTextIn(const _s: string; const _Arr: array of string; out _Idx: Integer): Boolean; overload;
+var
i: Integer;
begin
Result := False;
for i := 0 to Length(_Arr) - 1 do
if SameText(_s, _Arr[i]) then begin
+ _Idx := i;
Result := True;
Exit; //==>
end;
end;
+function IsTextIn(const _s: string; const _Arr: array of string): Boolean;
+var
+ Idx: Integer;
+begin
+ Result := IsTextIn(_s, _Arr, Idx);
+end;
+
function StrToLowAscii(const _s: WideString): AnsiString;
const
CodePage = 20127; //20127 = us-ascii
Modified: trunk/ExternalSource/dzlib/u_dzTranslator.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTranslator.pas 2020-07-18 11:55:20 UTC (rev 3230)
+++ trunk/ExternalSource/dzlib/u_dzTranslator.pas 2020-07-18 17:05:55 UTC (rev 3231)
@@ -27,23 +27,20 @@
DZLIB_TRANSLATION_DOMAIN = 'dzlib';
function _(const _s: string): string;
+/// we can't inline this function because we don't want to add gnugettext to units using it
function GetText(const _s: string): string;
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
+/// we can't inline this function because we don't want to add gnugettext to units using it
function dzGetText(const _s: string): string;
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
+/// we can't inline this function because we don't want to add gnugettext to units using it
function DGetText(const _s: string; const _TextDomain: string = ''): string;
+/// we can't inline this function because we don't want to add gnugettext to units using it
+
///<summary> use this if you pass variables rather than constants to avoid warnings in the dxgettext tool </summary>
-{$IFDEF SUPPORTS_INLINE}
-inline;
-{$ENDIF}
function dzDGetText(const _s: string; const _TextDomain: string = ''): string;
+/// we can't inline this function because we don't want to add gnugettext to units using it
///<summary> translate using the DZLIB_TRANSLATION_DOMAIN </summary>
function dzlibGetText(const _s: string): string;
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-07-18 11:55:20 UTC (rev 3230)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-07-18 17:05:55 UTC (rev 3231)
@@ -7,7 +7,7 @@
uses
SysUtils,
Classes,
- Types; // for $IF Declared(TBytes)
+ Types; // for $IF Declared(TBytes) and TStringDynArray
type
EdzException = class(Exception)
@@ -16,8 +16,17 @@
type
TErrorHandlingEnum = (ehReturnFalse, ehRaiseException);
+{$IF not Declared(RawByteString)}
type
- TStringArray = array of string;
+ RawByteString = AnsiString;
+{$IFEND}
+
+type
+{$IF not declared(TStringDynArray)}
+ TStringDynArray = array of string;
+{$IFEND}
+ TStringArray = TStringDynArray;
+ TRawByteStringArray = array of RawByteString;
TIntegerArray = array of Integer;
TSingleArray = array of Single;
TDoubleArray = array of Double;
@@ -25,9 +34,6 @@
{$IF not Declared(TBytes)}
TBytes = array of Byte;
{$IFEND}
-{$IF not Declared(RawByteString)}
- RawByteString = AnsiString;
-{$IFEND}
type
TByteMatrix = array of array of Byte;
@@ -39,18 +45,6 @@
type
TMethodPointer = procedure of object;
-function TStringArray_FromStrings(_sl: TStrings): TStringArray;
-
implementation
-function TStringArray_FromStrings(_sl: TStrings): TStringArray;
-var
- i: Integer;
-begin
- SetLength(Result, _sl.count);
- for i := 0 to _sl.count - 1 do
- Result[i] := _sl[i];
-end;
-
end.
-
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-07-18 11:55:20 UTC (rev 3230)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-07-18 17:05:55 UTC (rev 3231)
@@ -267,26 +267,23 @@
_Data: Integer); overload;
function TStringGrid_GetNonfixedCell(_Grid: TStringGrid; _Col, _Row: Integer): string;
-///<summary>
-/// scrolls up the lines of a string grid
-/// @param Grid is the TStringGrid to scroll
-/// @param Top is the topmost row to scroll, if passed as -1 defaults to the first non-fixed row
-/// @param Bottom is the bottommost row to scroll, if passed as -1 defaults to RowCount-1 </summary>
+///<summary> scrolls up the lines of a string grid
+/// @param Grid is the TStringGrid to scroll
+/// @param Top is the topmost row to scroll, if passed as -1 defaults to the first non-fixed row
+/// @param Bottom is the bottommost row to scroll, if passed as -1 defaults to RowCount-1 </summary>
procedure TStringGrid_ScrollUp(_Grid: TStringGrid; _Top: Integer = -1; _Bottom: Integer = -1);
-///<summary>
-/// Deletes the given row from the string grid and moves all rows below it up by one,
-/// if there is only one non-fixed row left, this row is cleared but not deleted.
-/// @param Grid is the StringGrid to change
-/// @param Row is the index of the row to delete, or -1 to delete the current row
-/// @returns true, if the row was deleted </summary>
+///<summary> deletes the given row from the string grid and moves all rows below it up by one,
+/// if there is only one non-fixed row left, this row is cleared but not deleted.
+/// @param Grid is the StringGrid to change
+/// @param Row is the index of the row to delete, or -1 to delete the current row
+/// @returns true, if the row was deleted </summary>
function TStringGrid_DeleteRow(_Grid: TStringGrid; _Row: Integer = -1): Boolean;
-///<summary>
-/// Inserts a row at the given index into the string grid and moves all rows below it down by one.
-/// @param Grid is the StringGrid to change
-/// @param Row is the index of the row to insert, or -1 to insert at the current row
-/// @returns the inserted row index or -1 if the row cannot be inserted </summary>
+///<summary> inserts a row at the given index into the string grid and moves all rows below it down by one.
+/// @param Grid is the StringGrid to change
+/// @param Row is the index of the row to insert, or -1 to insert at the current row
+/// @returns the inserted row index or -1 if the row cannot be inserted </summary>
function TStringGrid_InsertRow(_Grid: TStringGrid; _Row: Integer = -1): Integer;
///<summary>
@@ -2539,7 +2536,7 @@
for i := Low(_Arr) to High(_Arr) do begin
Result := _Arr[i] = _Element;
if Result then
- Exit;
+ Exit; //==>
end;
end;
@@ -2550,7 +2547,7 @@
begin
if TCustomGrid(_Grid) is TCustomDbGrid then
if (dgIndicator in TDbGridHack(_Grid).Options) and (_Col = 0) then
- Exit;
+ Exit; //==>
ColText := _Grid.GetEditText(_Col, _Row);
ColWidth := _Grid.Canvas.TextWidth(ColText);
if ColWidth > _MinWidth then
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-07-26 09:34:53
|
Revision: 3252
http://sourceforge.net/p/gexperts/code/3252
Author: twm
Date: 2020-07-26 09:34:50 +0000 (Sun, 26 Jul 2020)
Log Message:
-----------
synced with dzlib on OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzFileUtils.pas
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
trunk/ExternalSource/dzlib/u_dzStringUtils.pas
Added Paths:
-----------
trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-07-26 09:34:08 UTC (rev 3251)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-07-26 09:34:50 UTC (rev 3252)
@@ -59,7 +59,10 @@
function isDecDigit(_a: Char): Boolean;
///<summary>
/// Returns true if S is a valid positive decimal number </summary>
-function isDec(const _s: string): Boolean;
+function isDec(const _s: string): Boolean; overload;
+{$IFDEF unicode}
+function isDec(const _s: AnsiString): Boolean; overload;
+{$ENDIF}
///<summary>
/// Converts a decimal digit to its number equivalent
/// @Raises EDigitOutOfRange if there is an invalid digit. </summary>
@@ -146,9 +149,7 @@
///<summary>
/// Reduces an Integer to a Byte value by cutting it off at 0 and 255 </summary>
function ReduceToByte(const _Value: Integer): Byte;
-{$IFDEF SUPPORTS_INLINE}
- inline;
-{$ENDIF}
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
///<summary>
/// Converts a string of the form '-hh:mm:ss', 'hh:mm:ss',
@@ -670,6 +671,13 @@
Result := isNumber(_s, 10);
end;
+{$IFDEF unicode}
+function isDec(const _s: AnsiString): Boolean;
+begin
+ Result := IsDec(string(_s));
+end;
+{$ENDIF}
+
function DecDigit2Long(_a: Char): ULong;
begin
Result := Digit2Long(_a, 10);
Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2020-07-26 09:34:08 UTC (rev 3251)
+++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2020-07-26 09:34:50 UTC (rev 3252)
@@ -11,6 +11,7 @@
Windows,
SysUtils,
Classes,
+ Types,
u_dzTranslator,
u_dzTypes;
@@ -1208,7 +1209,8 @@
Masks,
u_dzMiscUtils,
u_dzStringUtils,
- u_dzDateUtils;
+ u_dzDateUtils,
+ u_dzStringArrayUtils;
function _(const _s: string): string;
{$IFDEF SUPPORTS_INLINE}
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-07-26 09:34:08 UTC (rev 3251)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-07-26 09:34:50 UTC (rev 3252)
@@ -1,8 +1,13 @@
unit u_dzGraphicsUtils;
{$INCLUDE 'dzlib.inc'}
-{.$INCLUDE 'dzlibjedi.inc'}
+{$IFDEF DELPHI2005}
+// the Delphi 2005 cmpiler crashes if this is compiled with typed @ operator
+// turned on
+{$TYPEDADDRESS OFF}
+{$ENDIF}
+
{$IFDEF OPTIMIZE_DZ_GRAPHIC_UTILS}
{$OPTIMIZATION ON}
{$RANGECHECKS OFF}
Added: trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas (rev 0)
+++ trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas 2020-07-26 09:34:50 UTC (rev 3252)
@@ -0,0 +1,151 @@
+unit u_dzStringArrayUtils;
+
+{$INCLUDE 'dzlib.inc'}
+
+interface
+
+uses
+ SysUtils,
+ Classes,
+ u_dzTypes;
+
+function StringArrayOf(const _arr: array of string): TStringArray;
+
+function StringArrayCombine(_arr: TStringArray; _Separator: string): string;
+procedure StringArraySort(var _arr: TStringArray);
+
+function TStringArray_Concat(const _Arr1, _Arr2: array of string): TStringArray;
+
+///<summary>
+/// Deletes Count entries from Arr starting from Index.
+/// @Note: It is allowed for Index > Length(Arr) and also Index+Count > Length(Arr)
+/// @raises ERangeCheck if Index or Count < 0 </summary>
+procedure TStringArray_Delete(var _arr: TStringArray; _Index: Integer; _Count: Integer);
+
+function TStringArray_FromStrings(_sl: TStrings): TStringArray;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+
+function TStrings_AsStringArray(_st: TStrings): TStringArray;
+procedure TStrings_AssignStringArray(_st: TStrings; _arr: TStringArray);
+procedure TStrings_AppendStringArray(_st: TStrings; _arr: TStringArray);
+
+implementation
+
+uses
+ SysConst;
+
+function StringArrayOf(const _arr: array of string): TStringArray;
+var
+ i: Integer;
+ len: Integer;
+begin
+ len := Length(_arr);
+ Setlength(Result, len);
+ for i := 0 to len - 1 do
+ Result[i] := _arr[i];
+end;
+
+function StringArrayCombine(_arr: TStringArray; _Separator: string): string;
+var
+ i: Integer;
+ len: Integer;
+begin
+ len := Length(_arr);
+ if len = 0 then begin
+ Result := '';
+ end else begin
+ Result := _arr[0];
+ for i := 1 to len - 1 do begin
+ Result := Result + _Separator + _arr[i];
+ end;
+ end;
+end;
+
+function TStrings_AsStringArray(_st: TStrings): TStringArray;
+var
+ cnt: Integer;
+ i: Integer;
+begin
+ cnt := _st.Count;
+ Setlength(Result, cnt);
+ for i := 0 to cnt - 1 do
+ Result[i] := _st[i];
+end;
+
+function TStringArray_FromStrings(_sl: TStrings): TStringArray;
+begin
+ Result := TStrings_AsStringArray(_sl);
+end;
+
+procedure TStrings_AssignStringArray(_st: TStrings; _arr: TStringArray);
+begin
+ _st.Clear;
+ TStrings_AppendStringArray(_st, _arr);
+end;
+
+procedure TStrings_AppendStringArray(_st: TStrings; _arr: TStringArray);
+var
+ i: Integer;
+begin
+ for i := 0 to Length(_arr) - 1 do
+ _st.Add(_arr[i]);
+end;
+
+procedure StringArraySort(var _arr: TStringArray);
+var
+ sl: TStringList;
+begin
+ sl := TStringList.Create;
+ try
+ TStrings_AssignStringArray(sl, _arr);
+ sl.Sort;
+ _arr := TStrings_AsStringArray(sl);
+ finally
+ FreeAndNil(sl);
+ end;
+end;
+
+procedure TStringArray_Delete(var _arr: TStringArray; _Index: Integer; _Count: Integer); overload;
+var
+ len: Integer;
+ i: Integer;
+begin
+ if _Index < 0 then
+ raise ERangeError.CreateRes(PResStringRec(@SRangeError));
+ if _Count < 0 then
+ raise ERangeError.CreateRes(PResStringRec(@SRangeError));
+
+ len := Length(_arr);
+ if _Index > len - 1 then begin
+ // after the end of the array -> nothing to do
+ Exit; //==>
+ end;
+
+ if _Index >= len - _Count then begin
+ // delete from the end
+ Setlength(_arr, _Index);
+ Exit; //==>
+ end;
+
+ for i := _Index to len - _Count - 1 do begin
+ _arr[i] := _arr[i + _Count];
+ end;
+ Setlength(_arr, len - _Count);
+end;
+
+function TStringArray_Concat(const _Arr1, _Arr2: array of string): TStringArray;
+var
+ Len1: Integer;
+ Len2: Integer;
+ i: Integer;
+begin
+ Len1 := Length(_Arr1);
+ Len2 := Length(_Arr2);
+ Setlength(Result, Len1 + Len2);
+ for i := 0 to Len1 - 1 do
+ Result[i] := _Arr1[i];
+ for i := 0 to Len2 - 1 do
+ Result[i + Len1] := _Arr2[i];
+end;
+
+end.
Modified: trunk/ExternalSource/dzlib/u_dzStringUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2020-07-26 09:34:08 UTC (rev 3251)
+++ trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2020-07-26 09:34:50 UTC (rev 3252)
@@ -52,6 +52,7 @@
{$IFNDEF SUPPORTS_UNICODE}
function CharInSet(_c: Char; const _CharSet: TSysCharSet): Boolean;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
{$ENDIF SUPPORTS_UNICODE}
///<summary>
@@ -435,15 +436,6 @@
function SplitString(_s: string; const _Delimiters: string): TStringArray; overload;
function SplitString(_s: string; const _Delimiters: array of Char): TStringArray; overload;
-function TStringArray_FromStrings(_sl: TStrings): TStringArray;
-
-///<summary>
-/// Deletes Count entries from Arr starting from Index.
-/// @Note: It is allowed for Index > Length(Arr) and also Index+Count > Length(Arr)
-/// @raises ERangeCheck if Index or Count < 0 </summary>
-procedure Delete(var _Arr: TStringArray; _Index: Integer; _Count: Integer); overload;
-function Concat(const _Arr1, _Arr2: array of string): TStringArray; overload;
-
{$IFDEF SUPPORTS_UNICODE}
function Copy(const _s: AnsiString; _Pos, _Len: Integer): AnsiString; overload;
function Copy(const _s: AnsiString; _Pos: Integer): AnsiString; overload;
@@ -718,67 +710,6 @@
SetLength(Result, Idx);
end;
-function TStringArray_FromStrings(_sl: TStrings): TStringArray;
-var
- i: Integer;
-begin
- SetLength(Result, _sl.count);
- for i := 0 to _sl.count - 1 do
- Result[i] := _sl[i];
-end;
-
-procedure Delete(var _Arr: TStringArray; _Index: Integer; _Count: Integer); overload;
-var
- Len: Integer;
- i: Integer;
-begin
- if _Index < 0 then begin
-{$T-}
- raise ERangeError.CreateRes(@SRangeError);
-{$IFDEF TYPEDADDRESS_IS_ON}
-{$T+}
-{$ENDIF}
-end;
- if _Count < 0 then begin
-{$T-}
- raise ERangeError.CreateRes(@SRangeError);
-{$IFDEF TYPEDADDRESS_IS_ON}
-{$T+}
-{$ENDIF}
-end;
- Len := Length(_Arr);
- if _Index > Len - 1 then begin
- // after the end of the array -> nothing to do
- Exit; //==>
- end;
-
- if _Index >= Len - _Count then begin
- // delete from the end
- SetLength(_Arr, _Index);
- Exit; //==>
- end;
-
- for i := _Index to Len - _Count - 1 do begin
- _Arr[i] := _Arr[i + _Count];
- end;
- SetLength(_Arr, Len - _Count);
-end;
-
-function Concat(const _Arr1, _Arr2: array of string): TStringArray;
-var
- Len1: Integer;
- Len2: Integer;
- i: Integer;
-begin
- Len1 := Length(_Arr1);
- Len2 := Length(_Arr2);
- SetLength(Result, Len1 + Len2);
- for i := 0 to Len1 - 1 do
- Result[i] := _Arr1[i];
- for i := 0 to Len2 - 1 do
- Result[i + Len1] := _Arr2[i];
-end;
-
function ReplaceChars(const _s, _Search, _Replace: string): string;
var
i, j: LongInt;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-08-01 13:50:11
|
Revision: 3268
http://sourceforge.net/p/gexperts/code/3268
Author: twm
Date: 2020-08-01 13:50:08 +0000 (Sat, 01 Aug 2020)
Log Message:
-----------
Bugfix: did not cmpile for older Delphi versions
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzCriticalSection.pas
trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-08-01 11:18:30 UTC (rev 3267)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-08-01 13:50:08 UTC (rev 3268)
@@ -81,6 +81,7 @@
{$IFDEF DELPHIX_TOKYO_UP}
// this function probably already exist in earlier versions, I just run across a compile error for 10.2 Tokyo
{$DEFINE HAS_INTTOHEX_FUNCTION}
+{$DEFINE HAS_INTTOHEX_FUNCTION_64}
{$ENDIF}
{$IFOPT T+}
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-08-01 11:18:30 UTC (rev 3267)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-08-01 13:50:08 UTC (rev 3268)
@@ -368,6 +368,11 @@
function Swap32(_Value: LongWord): LongWord;
function Swap32pas(_Value: LongWord): LongWord;
+///<summary>
+/// returns a 64 bit value in reversed byte order e.g. $123456789ABCDEF0 -> $F0DEBC9A78563412
+/// aka converts intel (little endian) to motorola (big endian) byte order format </summary>
+function Swap64(_Value: UInt64): UInt64;
+
function BitReverse32(v: LongWord): LongWord;
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
@@ -674,7 +679,7 @@
{$IFDEF unicode}
function isDec(const _s: AnsiString): Boolean;
begin
- Result := IsDec(string(_s));
+ Result := isDec(string(_s));
end;
{$ENDIF}
@@ -1075,6 +1080,14 @@
Result := ((_Value shr 24) and $FF) + (((_Value shr 16) and $FF) shl 8) + (((_Value shr 8) and $FF) shl 16) + ((_Value and $FF) shl 24);
end;
+function Swap64(_Value: UInt64): UInt64;
+asm
+ MOV EDX,_Value.Int64Rec.Lo
+ BSWAP EDX
+ MOV EAX,_Value.Int64Rec.Hi
+ BSWAP EAX
+end;
+
function BitReverse32(v: LongWord): LongWord;
// source (C code):
// https://apps.topcoder.com/forums/?module=Thread&threadID=514884&start=2
Modified: trunk/ExternalSource/dzlib/u_dzCriticalSection.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzCriticalSection.pas 2020-08-01 11:18:30 UTC (rev 3267)
+++ trunk/ExternalSource/dzlib/u_dzCriticalSection.pas 2020-08-01 13:50:08 UTC (rev 3268)
@@ -25,33 +25,8 @@
implementation
-function GetCacheLineSize: Integer;
-var
- ProcInfo: PSystemLogicalProcessorInformation;
- CurInfo: PSystemLogicalProcessorInformation;
- Len: DWORD;
-begin
- Len := 0;
- if (GetProcAddress(GetModuleHandle(kernel32), 'GetLogicalProcessorInformation') <> nil) and
- not GetLogicalProcessorInformation(nil, Len) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then begin
- GetMem(ProcInfo, Len);
- try
- GetLogicalProcessorInformation(ProcInfo, Len);
- CurInfo := ProcInfo;
- while Len > 0 do begin
- if (CurInfo.Relationship = RelationCache) and (CurInfo.Cache.Level = 1) then begin
- Result := CurInfo.Cache.LineSize;
- Exit;
- end;
- Inc(CurInfo);
- Dec(Len, SizeOf(CurInfo^));
- end;
- finally
- FreeMem(ProcInfo);
- end;
- end;
- Result := 64;
-end;
+uses
+ u_dzMiscUtils;
var
CacheLineSize: Integer;
@@ -88,6 +63,80 @@
end;
{$ENDIF debug_Crit_Sect}
+{$IF not declared(PSystemLogicalProcessorInformation)}
+{$ALIGN ON}
+{$MINENUMSIZE 4}
+
+type
+ _PROCESSOR_CACHE_TYPE = (CacheUnified { = 0}, CacheInstruction { = 1}, CacheData { = 2}, CacheTrace { = 3});
+ PROCESSOR_CACHE_TYPE = _PROCESSOR_CACHE_TYPE;
+ TProcessorCacheType = PROCESSOR_CACHE_TYPE;
+type
+ TCacheDescriptor = record
+ Level: BYTE;
+ Associativity: BYTE;
+ LineSize: WORD;
+ Size: DWORD;
+ _Type: PROCESSOR_CACHE_TYPE;
+ end;
+
+type
+ TLogicalProcessorRelationship = (RelationProcessorCore { = 0},
+ RelationNumaNode { = 1},
+ RelationCache { = 2},
+ RelationProcessorPackage { = 3},
+ RelationGroup { = 4}, RelationAll = $FFFF);
+
+type
+ TSystemLogicalProcessorInformation = record
+ ProcessorMask: ULONG_PTR;
+ Relationship: TLogicalProcessorRelationship;
+ case Integer of
+ 0: (Flags: BYTE); // ProcessorCore
+ 1: (NodeNumber: DWORD); // NumaNode
+ 2: (Cache: TCacheDescriptor); //Cache
+ 3: (Reserved: array[0..1] of ULONGLONG);
+ end;
+ PSystemLogicalProcessorInformation = ^TSystemLogicalProcessorInformation;
+
+function GetLogicalProcessorInformation(Buffer: PSystemLogicalProcessorInformation; var ReturnedLength: DWORD): BOOL; stdcall;
+ external kernel32 name 'GetLogicalProcessorInformation';
+{$IFEND}
+
+function GetCacheLineSize: Integer;
+var
+ ProcInfo: PSystemLogicalProcessorInformation;
+ CurInfo: PSystemLogicalProcessorInformation;
+ Len: DWORD;
+ Err: DWORD;
+begin
+ Result := 64;
+
+ Len := 0;
+ if not GetLogicalProcessorInformation(nil, Len) then begin
+ Err := GetLastError;
+ if Err = ERROR_INSUFFICIENT_BUFFER then begin
+ GetMem(ProcInfo, Len);
+ try
+ if GetLogicalProcessorInformation(ProcInfo, Len) then begin
+ // it should not be possible that the second call still returns, but ...
+ CurInfo := ProcInfo;
+ while Len > 0 do begin
+ if (CurInfo.Relationship = RelationCache) and (CurInfo.Cache.Level = 1) then begin
+ Result := CurInfo.Cache.LineSize;
+ Exit;
+ end;
+ Inc(CurInfo);
+ Dec(Len, SizeOf(CurInfo^));
+ end;
+ end;
+ finally
+ FreeMem(ProcInfo);
+ end;
+ end;
+ end;
+end;
+
initialization
CacheLineSize := GetCacheLineSize;
end.
Modified: trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-08-01 11:18:30 UTC (rev 3267)
+++ trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-08-01 13:50:08 UTC (rev 3268)
@@ -21,8 +21,8 @@
interface
uses
+ Windows,
SysUtils,
- Windows,
Registry,
u_dzTranslator;
@@ -86,6 +86,12 @@
function IntToHex(_Value: Int64): string; overload;
{$ENDIF HAS_INTTOHEX_FUNCTION}
+{$IFNDEF HAS_INTTOHEX_FUNCTION_64}
+function IntToHex(_Value: UInt64): string; overload;
+{$ENDIF HAS_INTTOHEX_FUNCTION_64}
+
+function PtrToHex(_Value: Pointer): string;
+
///<summary> Converts an integer to a boolean.
/// @param Int is the integer to convert
/// @returns false, if the integer is 0, true otherwise </summary>
@@ -224,6 +230,7 @@
{$ENDIF}
{$ENDIF}
StrUtils,
+ u_dzTypes,
u_dzFileUtils,
u_dzStringUtils,
u_dzConvertUtils;
@@ -528,6 +535,23 @@
end;
{$ENDIF HAS_INTTOHEX_FUNCTION}
+{$IFNDEF HAS_INTTOHEX_FUNCTION_64}
+function IntToHex(_Value: UInt64): string; overload;
+var
+ Buf: PUInt32;
+begin
+ Buf := PUInt32(NativeUInt(@_Value) + 8);
+ Result := IntToHex(Buf^, 8);
+ Buf := PUInt32(@_Value);
+ Result := Result + IntToHex(Buf^, 8);
+end;
+{$ENDIF HAS_INTTOHEX_FUNCTION_64}
+
+function PtrToHex(_Value: Pointer): string;
+begin
+ Result := IntToHex(NativeUInt(_Value));
+end;
+
type
PStringDescriptor = ^TStringDescriptor;
TStringDescriptor = record
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-08-01 11:18:30 UTC (rev 3267)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-08-01 13:50:08 UTC (rev 3268)
@@ -10,6 +10,53 @@
Types; // for $IF Declared(TBytes) and TStringDynArray
type
+ // Fixed size signed and unsigned integer types
+{$IF not declared(Int8)}
+ Int8 = Shortint;
+{$IFEND}
+{$IF not declared(UInt8)}
+ UInt8 = Byte;
+{$IFEND}
+{$IF not declared(Int16)}
+ Int16 = Smallint;
+{$IFEND}
+{$IF not declared(UInt16)}
+ UInt16 = Word;
+{$IFEND}
+{$IF not declared(Int32)}
+ Int32 = Integer;
+{$IFEND}
+{$IF not declared(UInt32)}
+ UInt32 = Cardinal;
+{$IFEND}
+ // Int64 is predefined
+ // UInt64 is predefined
+
+{$IF not declared(PInt8)}
+ PInt8 = ^Int8;
+{$IFEND}
+{$IF not declared(PUInt8)}
+ PUInt8 = ^UInt8;
+{$IFEND}
+{$IF not declared(PInt16)}
+ PInt16 = ^Int16;
+{$IFEND}
+{$IF not declared(PUInt16)}
+ PUInt16 = ^UInt16;
+{$IFEND}
+{$IF not declared(PInt32)}
+ PInt32 = ^Int32;
+{$IFEND}
+{$IF not declared(PUInt32)}
+ PUInt32 = ^UInt32;
+{$IFEND}
+{$IF not declared(PInt64)}
+ PInt64 = ^Int64;
+{$IFEND}
+{$IF not declared(PUInt64)}
+ PUInt64 = ^UInt64;
+{$IFEND}
+type
EdzException = class(Exception)
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-08-01 17:16:12
|
Revision: 3271
http://sourceforge.net/p/gexperts/code/3271
Author: twm
Date: 2020-08-01 17:16:11 +0000 (Sat, 01 Aug 2020)
Log Message:
-----------
* If UInt64 is not declared, don't implement IntToHex for it (Delphi 6)
* If NativeUInt is not declared, declare it as UInt32 (Delphi 6)
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
Modified: trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-08-01 15:51:50 UTC (rev 3270)
+++ trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2020-08-01 17:16:11 UTC (rev 3271)
@@ -87,7 +87,9 @@
{$ENDIF HAS_INTTOHEX_FUNCTION}
{$IFNDEF HAS_INTTOHEX_FUNCTION_64}
+{$IFDEF SUPPORTS_UINT64}
function IntToHex(_Value: UInt64): string; overload;
+{$ENDIF SUPPORTS_UINT64}
{$ENDIF HAS_INTTOHEX_FUNCTION_64}
function PtrToHex(_Value: Pointer): string;
@@ -536,6 +538,7 @@
{$ENDIF HAS_INTTOHEX_FUNCTION}
{$IFNDEF HAS_INTTOHEX_FUNCTION_64}
+{$IFDEF SUPPORTS_UINT64}
function IntToHex(_Value: UInt64): string; overload;
var
Buf: PUInt32;
@@ -545,6 +548,7 @@
Buf := PUInt32(@_Value);
Result := Result + IntToHex(Buf^, 8);
end;
+{$ENDIF SUPPORTS_UINT64}
{$ENDIF HAS_INTTOHEX_FUNCTION_64}
function PtrToHex(_Value: Pointer): string;
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-08-01 15:51:50 UTC (rev 3270)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-08-01 17:16:11 UTC (rev 3271)
@@ -30,6 +30,9 @@
UInt32 = Cardinal;
{$IFEND}
// Int64 is predefined
+{$IF not declared(UInt64)}
+ UInt64 = Int64;
+{$IFEND}
// UInt64 is predefined
{$IF not declared(PInt8)}
@@ -56,6 +59,11 @@
{$IF not declared(PUInt64)}
PUInt64 = ^UInt64;
{$IFEND}
+
+{$IF not declared(NativeUInt)}
+ NativeUInt = UInt32;
+{$IFEND}
+
type
EdzException = class(Exception)
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-09-05 17:29:34
|
Revision: 3286
http://sourceforge.net/p/gexperts/code/3286
Author: twm
Date: 2020-09-05 17:29:31 +0000 (Sat, 05 Sep 2020)
Log Message:
-----------
updated to latest dzlib version from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
trunk/ExternalSource/dzlib/u_dzQuicksort.pas
trunk/ExternalSource/dzlib/u_dzSortUtils.pas
trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-09-05 17:18:23 UTC (rev 3285)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-09-05 17:29:31 UTC (rev 3286)
@@ -274,6 +274,21 @@
inline;
{$ENDIF}
+///<summary> abbreviation for StretchBlt that takes TCanvas and TPoint values. </summary>
+function dzStretchBlt(_DestCnv: TCanvas; _DestTopLeft: TPoint; _DestSize: TPoint;
+ _SrcCnv: TCanvas; _SrcTopLeft: TPoint; _SrcSize: TPoint; _Rop: DWORD = SRCCOPY): BOOL; overload;
+{$IFDEF SUPPORTS_INLINE}inline; {$ENDIF}
+
+///<summary> abbreviation for StretchBlt that takes TCanvas, TBitmap and TPoint values. </summary>
+function dzStretchBlt(_DestCnv: TCanvas; _DestTopLeft: TPoint; _DestSize: TPoint;
+ _SrcBmp: TBitmap; _SrcTopLeft: TPoint; _SrcSize: TPoint; _Rop: DWORD = SRCCOPY): BOOL; overload;
+{$IFDEF SUPPORTS_INLINE}inline; {$ENDIF}
+
+///<summary> abbreviation for StretchBlt that takes two TBitmap and TPoint values. </summary>
+function dzStretchBlt(_DestBmp: TBitmap; _DestTopLeft: TPoint; _DestSize: TPoint;
+ _SrcBmp: TBitmap; _SrcTopLeft: TPoint; _SrcSize: TPoint; _Rop: DWORD = SRCCOPY): BOOL; overload;
+{$IFDEF SUPPORTS_INLINE}inline; {$ENDIF}
+
///<summary> abbreviation for StretchBlt that takes TRect </summary>
function dzStretchBlt(_DestHandle: Hdc; _DestRect: TRect;
_SrcHandle: Hdc; _SrcRect: TRect; _Rop: DWORD = SRCCOPY): LongBool; overload;
@@ -657,6 +672,31 @@
Result := dzDGetText(_s, 'dzlib');
end;
+function dzStretchBlt(_DestCnv: TCanvas; _DestTopLeft: TPoint; _DestSize: TPoint;
+ _SrcCnv: TCanvas; _SrcTopLeft: TPoint; _SrcSize: TPoint; _Rop: DWORD): BOOL;
+begin
+ Result := StretchBlt(_DestCnv.Handle,
+ _DestTopLeft.x, _DestTopLeft.y,
+ _DestSize.x, _DestSize.y,
+ _SrcCnv.Handle,
+ _SrcTopLeft.x, _SrcTopLeft.y,
+ _SrcSize.x, _SrcSize.y, _Rop);
+end;
+
+function dzStretchBlt(_DestCnv: TCanvas; _DestTopLeft: TPoint; _DestSize: TPoint;
+ _SrcBmp: TBitmap; _SrcTopLeft: TPoint; _SrcSize: TPoint; _Rop: DWORD = SRCCOPY): BOOL;
+begin
+ Result := dzStretchBlt(_DestCnv, _DestTopLeft, _DestSize,
+ _SrcBmp.Canvas, _SrcTopLeft, _SrcSize, _Rop);
+end;
+
+function dzStretchBlt(_DestBmp: TBitmap; _DestTopLeft: TPoint; _DestSize: TPoint;
+ _SrcBmp: TBitmap; _SrcTopLeft: TPoint; _SrcSize: TPoint; _Rop: DWORD = SRCCOPY): BOOL; overload;
+begin
+ Result := dzStretchBlt(_DestBmp.Canvas, _DestTopLeft, _DestSize,
+ _SrcBmp.Canvas, _SrcTopLeft, _SrcSize, _Rop);
+end;
+
function dzStretchBlt(_DestHandle: Hdc; _DestRect: TRect; _SrcHandle: Hdc; _SrcRect: TRect; _Rop: DWORD): LongBool;
begin
Result := StretchBlt(_DestHandle, _DestRect.Left, _DestRect.Top, TRect_Width(_DestRect), TRect_Height(_DestRect),
Modified: trunk/ExternalSource/dzlib/u_dzQuicksort.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzQuicksort.pas 2020-09-05 17:18:23 UTC (rev 3285)
+++ trunk/ExternalSource/dzlib/u_dzQuicksort.pas 2020-09-05 17:29:31 UTC (rev 3286)
@@ -67,11 +67,14 @@
I, J, P: Integer;
begin
if _Left >= _Right then
- exit;
+ Exit; //==>
repeat
I := _Left;
J := _Right;
- P := (_Left + _Right) shr 1;
+// P := (_Left + _Right) shr 1;
+ // Chosing the pivot element can make a big difference:
+ // In my unit tests its factor 100 for the TestPartSortedPartReverse test
+ P := GetPivot(I, J, _DataHandler);
repeat
while _DataHandler.Compare(I, P) < 0 do
Inc(I);
@@ -100,11 +103,14 @@
I, J, P: Integer;
begin
if _Left >= _Right then
- exit;
+ Exit; //==>
repeat
I := _Left;
J := _Right;
- P := (_Left + _Right) shr 1;
+// P := (_Left + _Right) shr 1;
+ // Chosing the pivot element can make a big difference:
+ // In my unit tests its factor 100 for the TestPartSortedPartReverse test
+ P := GetPivot(I, J, _CompareMeth);
repeat
while _CompareMeth(I, P) < 0 do
Inc(I);
Modified: trunk/ExternalSource/dzlib/u_dzSortUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSortUtils.pas 2020-09-05 17:18:23 UTC (rev 3285)
+++ trunk/ExternalSource/dzlib/u_dzSortUtils.pas 2020-09-05 17:29:31 UTC (rev 3286)
@@ -42,6 +42,59 @@
{$ENDIF}
;
+///<summary>
+/// Try to optimize the pivot by chosing the median of Left, Right and ((Left + Right) shr 1) </summary>
+function GetPivot(_Left, _Right: Integer; _CompareMeth: TCompareItemsMeth): Integer; inline; overload;
+///<summary>
+/// Try to optimize the pivot by chosing the median of Left, Right and ((Left + Right) shr 1) </summary>
+function GetPivot(_Left, _Right: Integer; _DataHandler: ISortDataHandler): Integer; inline; overload;
+
implementation
+function GetPivot(_Left, _Right: Integer; _CompareMeth: TCompareItemsMeth): Integer;
+begin
+ Result := (_Left + _Right) shr 1;
+ // try to optimize the pivot by chosing the
+ // median of Left, Right and Result:
+ if _CompareMeth(_Left, Result) > 0 then begin
+ if _CompareMeth(Result, _Right) > 0 then begin
+ // Result is already the median
+ end else if _CompareMeth(_Right, _Left) > 0 then begin
+ Result := _Left;
+ end else
+ Result := _Right;
+ end else begin
+ if _CompareMeth(_Right, Result) > 0 then begin
+ // Result is already the median
+ end else if _CompareMeth(_Left, _Right) > 0 then begin
+ Result := _Left;
+ end else begin
+ Result := _Right;
+ end;
+ end;
+end;
+
+function GetPivot(_Left, _Right: Integer; _DataHandler: ISortDataHandler): Integer;
+begin
+ Result := (_Left + _Right) shr 1;
+ // try to optimize the pivot by chosing the
+ // median of Left, Right and Result:
+ if _DataHandler.Compare(_Left, Result) > 0 then begin
+ if _DataHandler.Compare(Result, _Right) > 0 then begin
+ // Result is already the median
+ end else if _DataHandler.Compare(_Right, _Left) > 0 then begin
+ Result := _Left;
+ end else
+ Result := _Right;
+ end else begin
+ if _DataHandler.Compare(_Right, Result) > 0 then begin
+ // Result is already the median
+ end else if _DataHandler.Compare(_Left, _Right) > 0 then begin
+ Result := _Left;
+ end else begin
+ Result := _Right;
+ end;
+ end;
+end;
+
end.
Modified: trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas 2020-09-05 17:18:23 UTC (rev 3285)
+++ trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas 2020-09-05 17:29:31 UTC (rev 3286)
@@ -22,6 +22,9 @@
/// @raises ERangeCheck if Index or Count < 0 </summary>
procedure TStringArray_Delete(var _arr: TStringArray; _Index: Integer; _Count: Integer);
+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_FromStrings(_sl: TStrings): TStringArray;
{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
@@ -133,6 +136,26 @@
Setlength(_arr, len - _Count);
end;
+function TStringArray_Contains(const _arr: TStringArray; const _s: string; out _Idx: Integer): Boolean;
+var
+ i: Integer;
+begin
+ for i := Low(_arr) to High(_arr) do begin
+ if _arr[i] = _s then begin
+ Result := True;
+ Exit; //==>
+ end;
+ end;
+ Result := False;
+end;
+
+function TStringArray_Contains(const _arr: TStringArray; const _s: string): Boolean;
+var
+ Idx: Integer;
+begin
+ Result := TStringArray_Contains(_arr, _s, Idx);
+end;
+
function TStringArray_Concat(const _Arr1, _Arr2: array of string): TStringArray;
var
Len1: Integer;
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-09-05 17:18:23 UTC (rev 3285)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-09-05 17:29:31 UTC (rev 3286)
@@ -46,7 +46,7 @@
type
///<summary> Ancestor to all exceptions raised in this unit. </summary>
- EdzVclUtils = class(Exception);
+ EdzVclUtils = class(EdzException);
///<summary> raised if the Combobox passed to SetOwnerDrawComboItemCount is not owner drawn. </summary>
EdzComboBoxNotOwnerDraw = class(EdzVclUtils);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-10-23 15:06:16
|
Revision: 3361
http://sourceforge.net/p/gexperts/code/3361
Author: twm
Date: 2020-10-23 15:06:13 +0000 (Fri, 23 Oct 2020)
Log Message:
-----------
synced with current dzlib
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
trunk/ExternalSource/dzlib/u_dzOsUtils.pas
trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-10-23 15:06:13 UTC (rev 3361)
@@ -62,6 +62,8 @@
// THandleStream.FHandle is declared as THandle (before that it's an Integer)
{$DEFINE THANDLESTREAM_HANDLE_IS_THANDLE}
{$DEFINE HAS_TOBJECT_TOSTRING}
+// TMonitor.PixelsPerInch probably didn't exist in Delphi 2009, it does exist in Delphi 10.2 adjust as necessary
+{$DEFINE HAS_TMONITOR_PIXELSPERINCH}
{$ENDIF}
{$IFDEF DELPHIXE_UP}
@@ -79,7 +81,7 @@
{$ENDIF}
{$IFDEF DELPHIX_TOKYO_UP}
-// this function probably already exist in earlier versions, I just run across a compile error for 10.2 Tokyo
+// this function probably already existed in earlier versions, I just run across a compile error for 10.2 Tokyo
{$DEFINE HAS_INTTOHEX_FUNCTION}
{$DEFINE HAS_INTTOHEX_FUNCTION_64}
{$ENDIF}
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-10-23 15:06:13 UTC (rev 3361)
@@ -78,6 +78,11 @@
end;
type
+ TValueIdxTriple = (vitBlue, vitGreen, vitRed);
+
+type
+ PdzRgbTripleValues = ^TdzRgbTripleValues;
+ TdzRgbTripleValues = packed array[TValueIdxTriple] of Byte;
PdzRgbTriple = ^TdzRgbTriple;
TdzRgbTriple = packed record
// do not change the order of the fields, do not add any fields
@@ -85,6 +90,8 @@
Green: Byte;
Red: Byte;
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+ function GetValues(_Idx: TValueIdxTriple): Byte; inline;
+ procedure SetValues(_Idx: TValueIdxTriple; _Value: Byte); inline;
function GetColor: TColor;
procedure SetColor(_Color: TColor);
procedure SetGray(_Value: Byte);
@@ -95,6 +102,7 @@
procedure SetBrightness(_Value: Byte); deprecated; //use SetGray
procedure GetHls(out _Hls: THlsRec);
procedure SetHls(const _Hls: THlsRec);
+ property Values[_Idx: TValueIdxTriple]: Byte read GetValues write SetValues;
{$ENDIF}
end;
@@ -510,8 +518,8 @@
///<summary>
/// Calculates the average brightness of an bitmap with PixelFormat = pf8Bit
/// @param bmp is the bitmap to process
-/// @param LowCutoff is the lower brightness limit for pixels to be include in the calculation
-/// @param HighCutoff is the upper brightness limit for pixels to be include in the calculation
+/// @param LowCutoff is the lower brightness limit for pixels to be included in the calculation
+/// @param HighCutoff is the upper brightness limit for pixels to be included in the calculation
/// @param Average returns the calculated average, only valid if Result = True
/// @returns True, if at least on pixel was in the desired interval
/// False, if not </summary>
@@ -521,8 +529,8 @@
///<summary>
/// Calculates the average brightness of an bitmap with PixelFormat = pf24Bit
/// @param bmp is the bitmap to process
-/// @param LowCutoff is the lower brightness limit for pixels to be include in the calculation
-/// @param HighCutoff is the upper brightness limit for pixels to be include in the calculation
+/// @param LowCutoff is the lower brightness limit for pixels to be included in the calculation
+/// @param HighCutoff is the upper brightness limit for pixels to be included in the calculation
/// @param Channel determines how to calculate the brightness
/// @param Average returns the calculated average, only valid if Result = True
/// @returns True, if at least on pixel was in the desired interval
@@ -535,8 +543,8 @@
/// Calculates the average brightness of an bitmap with PixelFormat = pf24Bit thereby only
/// using the blue channel.
/// @param bmp is the bitmap to process
-/// @param LowCutoff is the lower brightness limit for pixels to be include in the calculation
-/// @param HighCutoff is the upper brightness limit for pixels to be include in the calculation
+/// @param LowCutoff is the lower brightness limit for pixels to be included in the calculation
+/// @param HighCutoff is the upper brightness limit for pixels to be included in the calculation
/// @param Average returns the calculated average, only valid if Result = True
/// @returns True, if at least on pixel was in the desired interval
/// False, if not </summary>
@@ -544,6 +552,34 @@
out _Average: Byte): Boolean;
type
+ TUInt32Array256 = array[0..255] of UInt32;
+ TUInt64Array256 = array[0..255] of UInt64;
+
+///<summary>
+/// Calculate the histogram for a bitmap with PixelFormat = pf24 for the given channel
+/// @param bmp is the bitmap to process
+/// @param Channel determines how to calculate the brightness
+/// @returns a TUInt32Array256 containing the histogram </summary>
+function TBitmap24_GetHistogram(_bmp: TBitmap; _Channel: TRgbBrightnessChannelEnum): TUInt64Array256;
+///<summary>
+/// Calculate the histograms for red, green and blue for a bitmap with PixelFormat = pf24
+/// @param bmp is the bitmap to process
+/// @param Red returns the histogram for the red channel
+/// @param Green returns the histogram for the green channel
+/// @param Blue returns the histogram for the blue channel </summary>
+procedure TBitmap24_GetHistograms(_bmp: TBitmap; out _Red, _Green, _Blue: TUInt64Array256); overload;
+///<summary>
+/// Calculate the histograms for red, green, blue and brightness for a bitmap with PixelFormat = pf24
+/// @param bmp is the bitmap to process
+/// @param Channel determines how to calculate the brightness
+/// @param Red returns the histogram for the red channel
+/// @param Green returns the histogram for the green channel
+/// @param Blue returns the histogram for the blue channel
+/// @param Blue returns the histogram for the selected brightness channel </summary>
+procedure TBitmap24_GetHistograms(_bmp: TBitmap; _BrightnessChannel: TRgbBrightnessChannelEnum;
+ out _Red, _Green, _Blue, _Brightness: TUInt64Array256); overload;
+
+type
// Note: The bitmap is stored upside down, so the y coordinates are reversed!
TPixel24FilterCallback = procedure(_x, _y: Integer; var _Pixel: TdzRgbTriple) of object;
TPixel8FilterCallback = procedure(_x, _y: Integer; var _Pixel: Byte) of object;
@@ -1166,6 +1202,16 @@
Blue := GetBValue(_Color);
end;
+function TdzRgbTriple.GetValues(_Idx: TValueIdxTriple): Byte;
+begin
+ Result := TdzRgbTripleValues(Self)[_Idx];
+end;
+
+procedure TdzRgbTriple.SetValues(_Idx: TValueIdxTriple; _Value: Byte);
+begin
+ TdzRgbTripleValues(Self)[_Idx] := _Value;
+end;
+
procedure TdzRgbTriple.SetBrightness(_Value: Byte);
begin
Red := _Value;
@@ -3218,4 +3264,136 @@
Result := RainbowColor((_Hue - _MinHue) / (_MaxHue - _MinHue + 1));
end;
+function TBitmap24_GetHistogram(_bmp: TBitmap; _Channel: TRgbBrightnessChannelEnum): TUInt64Array256; overload;
+const
+ BytesPerPixel = SizeOf(TdzRgbTriple);
+var
+ w: Integer;
+ h: Integer;
+ x: Integer;
+ y: Integer;
+ ScanLine: PByte;
+ Pixel: PByte;
+ BytesPerLine: Integer;
+begin
+ for x := Low(Result) to High(Result) do
+ Result[x] := 0;
+
+ h := _bmp.Height;
+ if h = 0 then begin
+ Exit; //==>
+ end;
+
+ w := _bmp.Width;
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ ScanLine := _bmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(ScanLine = _bmp.ScanLine[y]);
+ Pixel := ScanLine;
+ for x := 0 to w - 1 do begin
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+ Inc(Result[PdzRgbTriple(Pixel).GetBrightness(_Channel)]);
+{$ELSE}
+ Inc(Result[GetRgbBrightness(PdzRgbTriple(Pixel).Red, PdzRgbTriple(Pixel).Green, PdzRgbTriple(Pixel).Blue, _Channel)]);
+{$ENDIF}
+ Inc(Pixel, BytesPerPixel);
+ end;
+ Dec(ScanLine, BytesPerLine);
+ end;
+end;
+
+procedure TBitmap24_GetHistograms(_bmp: TBitmap; out _Red, _Green, _Blue: TUInt64Array256); overload;
+const
+ BytesPerPixel = SizeOf(TdzRgbTriple);
+var
+ w: Integer;
+ h: Integer;
+ x: Integer;
+ y: Integer;
+ ScanLine: PByte;
+ Pixel: PByte;
+ BytesPerLine: Integer;
+begin
+ for x := Low(_Red) to High(_Red) do begin
+ _Red[x] := 0;
+ _Green[x] := 0;
+ _Blue[x] := 0;
+ end;
+
+ h := _bmp.Height;
+ if h = 0 then begin
+ Exit; //==>
+ end;
+
+ w := _bmp.Width;
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ ScanLine := _bmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(ScanLine = _bmp.ScanLine[y]);
+ Pixel := ScanLine;
+ for x := 0 to w - 1 do begin
+ Inc(_Red[PdzRgbTriple(Pixel).Red]);
+ Inc(_Green[PdzRgbTriple(Pixel).Green]);
+ Inc(_Blue[PdzRgbTriple(Pixel).Blue]);
+ Inc(Pixel, BytesPerPixel);
+ end;
+ Dec(ScanLine, BytesPerLine);
+ end;
+end;
+
+procedure TBitmap24_GetHistograms(_bmp: TBitmap; _BrightnessChannel: TRgbBrightnessChannelEnum;
+ out _Red, _Green, _Blue, _Brightness: TUInt64Array256); overload;
+const
+ BytesPerPixel = SizeOf(TdzRgbTriple);
+var
+ w: Integer;
+ h: Integer;
+ x: Integer;
+ y: Integer;
+ ScanLine: PByte;
+ Pixel: PByte;
+ BytesPerLine: Integer;
+begin
+ for x := Low(_Red) to High(_Red) do begin
+ _Red[x] := 0;
+ _Green[x] := 0;
+ _Blue[x] := 0;
+ _Brightness[x] := 0;
+ end;
+
+ h := _bmp.Height;
+ if h = 0 then begin
+ Exit; //==>
+ end;
+
+ w := _bmp.Width;
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ ScanLine := _bmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(ScanLine = _bmp.ScanLine[y]);
+ Pixel := ScanLine;
+ for x := 0 to w - 1 do begin
+ Inc(_Red[PdzRgbTriple(Pixel).Red]);
+ Inc(_Green[PdzRgbTriple(Pixel).Green]);
+ Inc(_Blue[PdzRgbTriple(Pixel).Blue]);
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+ Inc(_Brightness[PdzRgbTriple(Pixel).GetBrightness(_BrightnessChannel)]);
+{$ELSE}
+ Inc(_Brightness[GetRgbBrightness(PdzRgbTriple(Pixel).Red, PdzRgbTriple(Pixel).Green, PdzRgbTriple(Pixel).Blue, _BrightnessChannel)]);
+{$ENDIF}
+ Inc(Pixel, BytesPerPixel);
+ end;
+ Dec(ScanLine, BytesPerLine);
+ end;
+end;
+
end.
Modified: trunk/ExternalSource/dzlib/u_dzOsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzOsUtils.pas 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/u_dzOsUtils.pas 2020-10-23 15:06:13 UTC (rev 3361)
@@ -204,7 +204,21 @@
/// is enabled. (according to http://stackoverflow.com/a/1675793/49925)
procedure JiggleMouse;
+type
+ TPowerRequestType = (
+ PowerRequestDisplayRequired = 0,
+ PowerRequestSystemRequired = 1,
+ PowerRequestAwayModeRequired = 2,
+ PowerRequestExecutionRequired = 3);
+
///<summary>
+/// simple interface for the Windows API PowerCreateRequest / PowerSetRequest / PowerClearRequest
+/// Avaiable in Windows 7 and later.
+/// @returns an interface which, when released, calls PowerClearRequest
+/// See also BlockScreenSaver </summary>
+function SetPowerRequest(const _Reason: WideString; _RequestType: TPowerRequestType): IInterface;
+
+///<summary>
/// Uses the Windows API PowerCreateRequest and PowerSetRequest (Windows 7 and later) to
/// prevent the screen saver from starting.
/// @param Reason is the reason why the screen saver is blocked
@@ -880,12 +894,6 @@
end;
);
end;
-type
- TPowerRequestType = (
- PowerRequestDisplayRequired = 0,
- PowerRequestSystemRequired = 1,
- PowerRequestAwayModeRequired = 2,
- PowerRequestExecutionRequired = 3);
type
TPowerCreateRequest = function(_Context: PReasonContext): THandle; stdcall;
@@ -893,7 +901,7 @@
TPowerClearRequest = function(_Handle: THandle; _RequestType: TPowerRequestType): LongBool; stdcall;
type
- TScreenSaverBlocker = class(TInterfacedObject, IInterface)
+ TPowerRequest = class(TInterfacedObject, IInterface)
private
FDllHandle: HMODULE;
FRequestHandle: THandle;
@@ -903,11 +911,11 @@
FContext: TReasonContext;
FReason: array[0..255] of WideChar;
public
- constructor Create(const _Reason: WideString);
+ constructor Create(const _Reason: WideString; _RequestType: TPowerRequestType);
destructor Destroy; override;
end;
-constructor TScreenSaverBlocker.Create(const _Reason: WideString);
+constructor TPowerRequest.Create(const _Reason: WideString; _RequestType: TPowerRequestType);
begin
inherited Create;
FDllHandle := SafeLoadLibrary(kernel32);
@@ -926,10 +934,10 @@
FRequestHandle := PowerCreateRequest(@FContext);
if FRequestHandle = INVALID_HANDLE_VALUE then
RaiseLastOSError;
- Win32Check(PowerSetRequest(FRequestHandle, PowerRequestDisplayRequired));
+ Win32Check(PowerSetRequest(FRequestHandle, _RequestType));
end;
-destructor TScreenSaverBlocker.Destroy;
+destructor TPowerRequest.Destroy;
begin
if FRequestHandle <> INVALID_HANDLE_VALUE then
CloseHandle(FRequestHandle);
@@ -940,9 +948,14 @@
function BlockScreenSaver(const _Reason: WideString): IInterface;
begin
- Result := TScreenSaverBlocker.Create(_Reason);
+ Result := SetPowerRequest(_Reason, PowerRequestDisplayRequired);
end;
+function SetPowerRequest(const _Reason: WideString; _RequestType: TPowerRequestType): IInterface;
+begin
+ Result := TPowerRequest.Create(_Reason, _RequestType);
+end;
+
function CharToOem(const _s: string): AnsiString;
begin
SetLength(Result, Length(_s));
Modified: trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas 2020-10-23 15:06:13 UTC (rev 3361)
@@ -16,6 +16,8 @@
function TStringArray_Concat(const _Arr1, _Arr2: array of string): TStringArray;
+procedure TStringArray_Append(var _arr: TStringArray; const _Value: string);
+
///<summary>
/// Deletes Count entries from Arr starting from Index.
/// @Note: It is allowed for Index > Length(Arr) and also Index+Count > Length(Arr)
@@ -171,4 +173,13 @@
Result[i + Len1] := _Arr2[i];
end;
+procedure TStringArray_Append(var _arr: TStringArray; const _Value: string);
+var
+ len: Integer;
+begin
+ len := Length(_arr);
+ Setlength(_arr, len + 1);
+ _arr[len] := _Value;
+end;
+
end.
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-10-23 15:06:13 UTC (rev 3361)
@@ -89,6 +89,7 @@
{$IF not Declared(TBytes)}
TBytes = array of Byte;
{$IFEND}
+ TUInt16Array = array of UInt16;
type
TByteMatrix = array of array of Byte;
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-10-23 15:06:13 UTC (rev 3361)
@@ -29,6 +29,7 @@
DBGrids,
Buttons,
Menus,
+ MultiMon, // this unit doesn't exist in older Delphi versions, use a unit alias like Multimon=Windows in that case
{$IFDEF HAS_UNIT_SYSTEM_ACTIONS}
Actions,
{$ENDIF}
@@ -59,7 +60,32 @@
EdzStatusBarNoMatchingPanel = class(EdzVclUtils);
+{$IF not declared(WM_DPICHANGED)}
+const
+ WM_DPICHANGED = $02E0;
+{$IFEND}
+
+{$IF not declared(TWMDpi)}
type
+ TDWordFiller = record
+{$IFDEF CPUX64}
+ Filler: array[1..4] of Byte; // Pad DWORD to make it 8 bytes (4+4) [x64 only]
+{$ENDIF}
+ end;
+
+type
+ TWMDpi = record
+ Msg: Cardinal;
+ MsgFiller: TDWordFiller;
+ YDpi: Word;
+ XDpi: Word;
+ WParamFiller: TDWordFiller;
+ ScaledRect: PRECT;
+ Result: LRESULT;
+ end;
+{$IFEND}
+
+type
///<summary> This is a copy of the TFileFormatsList class from Graphics which
/// is unfortunately only declaread in the implementation section </summary>
TFileFormatsList = class(TList)
@@ -1086,6 +1112,9 @@
function TActionlist_Append(_al: TActionList; const _Caption: string; _ShortCut: TShortCut): TAction; overload;
function TActionlist_Append(_al: TActionList; const _Caption: string; _OnExecute: TNotifyEvent): TAction; overload;
function TActionlist_Append(_al: TActionList; const _Caption: string; _OnExecute: TNotifyEvent; _ShortCut: TShortCut): TAction; overload;
+function TActionlist_Append(_al: TActionList; _ShortCut: TShortCut): TAction; overload;
+function TActionlist_Append(_al: TActionList; _OnExecute: TNotifyEvent): TAction; overload;
+function TActionlist_Append(_al: TActionList; _OnExecute: TNotifyEvent; _ShortCut: TShortCut): TAction; overload;
///<summary>
/// @returns the width of the checkbox in the given TCustomCheckbox
@@ -1215,6 +1244,18 @@
function TForm_ReadPlacement(_frm: TForm; _Which: TFormPlacementEnum;
_HKEY: HKEY = HKEY_CURRENT_USER): Boolean; overload;
+///<summary>
+/// similar to TForm_ReadPlacement but also adds a hidden component to the form which automatically
+/// calls TForm_StorePlacement when it is being destroyed, so we don't need explicitly call
+/// that in the form's destructor.
+/// @param frm is the form whose placement is to be read
+/// @param Which determines whether the Position and/or the size is to be read
+/// @param HKEY is the root key, defaults to HKEY_CURRENT_USER
+/// @returns false, if anything goes wrong, including any exceptions that might occur,
+/// true if it worked. </summary>
+function TForm_EnableStorePlacement(_frm: TForm; _Which: TFormPlacementEnum;
+ _HKEY: HKEY = HKEY_CURRENT_USER): Boolean;
+
///<summary> Generates the registry path for storing a form's placement as used in
/// TForm_Read/StorePlacement. </summary>
function TForm_GetPlacementRegistryPath(_frm: TForm): string; overload; deprecated; // use TForm_GetPlacementRegistryEntry
@@ -1536,6 +1577,8 @@
/// Gets and sets the bottom left coordinates keeping the size </summary>
property BottomLeft: TPoint read GetBottomLeft write SetBottomLeft;
function GetCenter: TPoint;
+ function Right: Integer;
+ function Bottom: Integer;
class operator Implicit(_a: TRect): TRectLTWH;
class operator Implicit(_a: TRectLTWH): TRect;
class function FromLTWH(_Left, _Top, _Width, _Height: Integer): TRectLTWH; static;
@@ -1606,6 +1649,36 @@
procedure TScreen_MakeFullyVisible(var _Rect: TRect); overload;
procedure TScreen_MakeFullyVisible(var _Rect: TRectLTWH); overload;
+
+// this does not compile with Delphi 2007 (it does with Delphi 10.2)
+// todo: find the first verstion that compiles this
+{$IFDEF DELPHI2009_UP}
+{$DEFINE COMPILER_SUPPORTS_TDZSCREEN}
+{$ENDIF}
+
+{$IFDEF COMPILER_SUPPORTS_TDZSCREEN}
+type
+ PdzScreen = ^TdzScreen;
+ TdzScreen = record
+ public
+ type
+ PdzMonitor = ^TdzMonitor;
+ TdzMonitor = record
+ public
+ Handle: HMONITOR;
+ MonitorNum: Integer;
+ BoundsRect: TRectLTWH;
+ WorkArea: TRectLTWH;
+ Name: string;
+ IsPrimary: Boolean;
+ end;
+ type
+ TMonitorArr = array of TdzMonitor;
+ public
+ Monitors: TMonitorArr;
+ class function Create: TdzScreen; static;
+ end;
+{$ENDIF}
///<summary>
/// Sets the given column of the StringList to the given string list,
/// adjusting the RowCount if necessary.
@@ -4478,6 +4551,42 @@
Result := TForm_ReadPlacement(_frm, _Which, TForm_GetPlacementRegistryEntry(_frm), _HKEY);
end;
+type
+ TFormStorePlacementEnabler = class(TComponent)
+ private
+ FForm: TForm;
+ FWhich: TFormPlacementEnum;
+ FHKEY: HKEY;
+ public
+ constructor Create(_frm: TForm; _Which: TFormPlacementEnum;
+ _HKEY: HKEY = HKEY_CURRENT_USER); reintroduce;
+ destructor Destroy; override;
+ end;
+
+{ TFormStorePlacementEnabler }
+
+constructor TFormStorePlacementEnabler.Create(_frm: TForm; _Which: TFormPlacementEnum; _HKEY: HKEY);
+begin
+ inherited Create(_frm);
+ Name := '';
+ FForm := _frm;
+ FWhich := _Which;
+ FHKEY := _HKEY;
+end;
+
+destructor TFormStorePlacementEnabler.Destroy;
+begin
+ TForm_StorePlacement(FForm, FWhich, FHKEY);
+ inherited;
+end;
+
+function TForm_EnableStorePlacement(_frm: TForm; _Which: TFormPlacementEnum;
+ _HKEY: HKEY = HKEY_CURRENT_USER): Boolean;
+begin
+ Result := TForm_ReadPlacement(_frm, _Which, _HKEY);
+ TFormStorePlacementEnabler.Create(_frm, _Which, _HKEY);
+end;
+
procedure TForm_SetMinConstraints(_frm: TForm);
begin
TControl_SetMinConstraints(_frm);
@@ -5952,6 +6061,21 @@
Result.OnExecute := _OnExecute;
end;
+function TActionlist_Append(_al: TActionList; _ShortCut: TShortCut): TAction;
+begin
+ Result := TActionlist_Append(_al, '', _ShortCut);
+end;
+
+function TActionlist_Append(_al: TActionList; _OnExecute: TNotifyEvent): TAction;
+begin
+ Result := TActionlist_Append(_al, '', _OnExecute);
+end;
+
+function TActionlist_Append(_al: TActionList; _OnExecute: TNotifyEvent; _ShortCut: TShortCut): TAction;
+begin
+ Result := TActionlist_Append(_al, '', _OnExecute, _ShortCut);
+end;
+
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
{ TActionListShortcutHelper }
@@ -6239,6 +6363,16 @@
Result.Assign(_Left, _Top, _Width, _Height);
end;
+function TRectLTWH.Right: Integer;
+begin
+ Result := Left + Width;
+end;
+
+function TRectLTWH.Bottom: Integer;
+begin
+ Result := Top + Height;
+end;
+
function TRectLTWH.GetBottomLeft: TPoint;
begin
Result := Point(Left, Top + Height);
@@ -6659,6 +6793,43 @@
Result.ValueName := _ValueName;
end;
+{$IFDEF COMPILER_SUPPORTS_TDZSCREEN}
+
+{ TdzScreen }
+
+function EnumMonitorsProc(hm: HMONITOR; dc: HDC; r: PRECT; Data: Pointer): Boolean; stdcall;
+var
+ Info: TMonitorInfoEx;
+ M: TdzScreen.PdzMonitor;
+ Screen: PdzScreen;
+ Idx: Integer;
+begin
+ Screen := PdzScreen(Data);
+ Idx := Length(Screen.Monitors);
+ SetLength(Screen.Monitors, Idx + 1);
+ M := @(Screen.Monitors[Idx]);
+ M.Handle := hm;
+ M.MonitorNum := Idx;
+
+ ZeroMemory(@Info, SizeOf(Info));
+ Info.cbSize := SizeOf(Info);
+ // we need to typecast this because we pass a pointer ot TMonitorInfoEx rather than TMonitorInfo
+ if not GetMonitorInfo(hm, PMonitorInfo(@Info)) then
+ RaiseLastOSError;
+
+ M.BoundsRect := Info.rcMonitor;
+ M.WorkArea := Info.rcWork;
+ M.Name := PChar(@Info.szDevice[0]);
+
+ Result := True;
+end;
+
+class function TdzScreen.Create: TdzScreen;
+begin
+ EnumDisplayMonitors(0, nil, TMonitorEnumProc(@EnumMonitorsProc), Windows.LParam(@Result));
+end;
+{$ENDIF}
+
initialization
InitializeCustomMessages;
finalization
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-11-14 16:58:23
|
Revision: 3377
http://sourceforge.net/p/gexperts/code/3377
Author: twm
Date: 2020-11-14 16:58:21 +0000 (Sat, 14 Nov 2020)
Log Message:
-----------
updated to latest version from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzFileStreams.pas
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
trunk/ExternalSource/dzlib/u_dzOsUtils.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-11-14 14:37:55 UTC (rev 3376)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2020-11-14 16:58:21 UTC (rev 3377)
@@ -921,7 +921,6 @@
end;
{$IFNDEF Win64}
-
function TryStr2Float(const _s: string; out _flt: Extended; _DecSeparator: Char = '.'): Boolean;
var
{$IF Declared(TFormatSettings)}
Modified: trunk/ExternalSource/dzlib/u_dzFileStreams.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2020-11-14 14:37:55 UTC (rev 3376)
+++ trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2020-11-14 16:58:21 UTC (rev 3377)
@@ -132,7 +132,10 @@
/// exception message.
/// NOTE: TStream.WriteBuffer is *not* virtual, so you must declare the object as
/// TdzFile rather TStream for this method to be called. </summary.
- procedure WriteBuffer(const _Buffer; _Count: LongInt);
+ procedure WriteBuffer(const _Buffer; _Count: NativeInt); overload;
+{$IF SizeOf(LongInt) <> SizeOf(NativeInt)}
+ procedure WriteBuffer(const _Buffer; _Count: LongInt); overload;
+{$IFEND}
///<summary> Closes the file and sets the handle to INVALID_HANDLE_VALUE </summary>
procedure Close;
///<summary> returns true if Position = Size </summary>
@@ -291,7 +294,7 @@
Stream := TdzFile.Create(_fn);
try
Stream.OpenCreateWriteNoSharing;
- Stream.WriteBuffer(_Buffer, _Size);
+ Stream.WriteBuffer(_Buffer, NativeInt(_Size));
finally
FreeAndNil(Stream);
end;
@@ -417,7 +420,7 @@
FFileFlags := _FileFlags;
end;
-procedure TdzFile.WriteBuffer(const _Buffer; _Count: Integer);
+procedure TdzFile.WriteBuffer(const _Buffer; _Count: NativeInt);
var
Written: Integer;
LastError: LongWord;
@@ -436,6 +439,14 @@
end;
end;
+{$IF SizeOf(LongInt) <> SizeOf(NativeInt)}
+
+procedure TdzFile.WriteBuffer(const _Buffer; _Count: LongInt);
+begin
+ WriteBuffer(_Buffer, NativeInt(_Count));
+end;
+{$IFEND}
+
function TdzFile.Eof: Boolean;
begin
Result := Position = Size;
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-11-14 14:37:55 UTC (rev 3376)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-11-14 16:58:21 UTC (rev 3377)
@@ -559,7 +559,7 @@
/// Calculate the histogram for a bitmap with PixelFormat = pf24 for the given channel
/// @param bmp is the bitmap to process
/// @param Channel determines how to calculate the brightness
-/// @returns a TUInt32Array256 containing the histogram </summary>
+/// @returns a TUInt64Array256 containing the histogram </summary>
function TBitmap24_GetHistogram(_bmp: TBitmap; _Channel: TRgbBrightnessChannelEnum): TUInt64Array256;
///<summary>
/// Calculate the histograms for red, green and blue for a bitmap with PixelFormat = pf24
@@ -579,6 +579,8 @@
procedure TBitmap24_GetHistograms(_bmp: TBitmap; _BrightnessChannel: TRgbBrightnessChannelEnum;
out _Red, _Green, _Blue, _Brightness: TUInt64Array256); overload;
+function TBitmap8_GetHistogram(_bmp: TBitmap): TUInt64Array256; overload;
+
type
// Note: The bitmap is stored upside down, so the y coordinates are reversed!
TPixel24FilterCallback = procedure(_x, _y: Integer; var _Pixel: TdzRgbTriple) of object;
@@ -3264,6 +3266,43 @@
Result := RainbowColor((_Hue - _MinHue) / (_MaxHue - _MinHue + 1));
end;
+function TBitmap8_GetHistogram(_bmp: TBitmap): TUInt64Array256; overload;
+const
+ BytesPerPixel = 1;
+var
+ w: Integer;
+ h: Integer;
+ x: Integer;
+ y: Integer;
+ ScanLine: PByte;
+ Pixel: PByte;
+ BytesPerLine: Integer;
+begin
+ for x := Low(Result) to High(Result) do
+ Result[x] := 0;
+
+ h := _bmp.Height;
+ if h = 0 then begin
+ Exit; //==>
+ end;
+
+ w := _bmp.Width;
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ ScanLine := _bmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(ScanLine = _bmp.ScanLine[y]);
+ Pixel := ScanLine;
+ for x := 0 to w - 1 do begin
+ Inc(Result[Pixel^]);
+ Inc(Pixel, BytesPerPixel);
+ end;
+ Dec(ScanLine, BytesPerLine);
+ end;
+end;
+
function TBitmap24_GetHistogram(_bmp: TBitmap; _Channel: TRgbBrightnessChannelEnum): TUInt64Array256; overload;
const
BytesPerPixel = SizeOf(TdzRgbTriple);
Modified: trunk/ExternalSource/dzlib/u_dzOsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzOsUtils.pas 2020-11-14 14:37:55 UTC (rev 3376)
+++ trunk/ExternalSource/dzlib/u_dzOsUtils.pas 2020-11-14 16:58:21 UTC (rev 3377)
@@ -9,11 +9,15 @@
Windows,
SysUtils,
Classes,
- u_dzTranslator;
+ u_dzTranslator,
+ u_dzTypes;
type
- EOsFunc = class(Exception);
+ EOsFunc = class(EdzException);
EOFNoFileinfo = class(EOsFunc);
+ EPowerRequestFailed = class(EOsFunc)
+ ErrorCode: Word;
+ end;
///<summary>
/// Determines the computername
@@ -217,6 +221,7 @@
/// @returns an interface which, when released, calls PowerClearRequest
/// See also BlockScreenSaver </summary>
function SetPowerRequest(const _Reason: WideString; _RequestType: TPowerRequestType): IInterface;
+function TrySetPowerRequest(const _Reason: WideString; _RequestType: TPowerRequestType; out _Request: IInterface): Boolean;
///<summary>
/// Uses the Windows API PowerCreateRequest and PowerSetRequest (Windows 7 and later) to
@@ -916,6 +921,9 @@
end;
constructor TPowerRequest.Create(const _Reason: WideString; _RequestType: TPowerRequestType);
+var
+ LastError: DWORD;
+ Error: EPowerRequestFailed;
begin
inherited Create;
FDllHandle := SafeLoadLibrary(kernel32);
@@ -931,10 +939,31 @@
FContext.Version := POWER_REQUEST_CONTEXT_VERSION;
FContext.Flags := POWER_REQUEST_CONTEXT_SIMPLE_STRING;
FContext.SimpleReasonString := @FReason[0];
+
FRequestHandle := PowerCreateRequest(@FContext);
- if FRequestHandle = INVALID_HANDLE_VALUE then
- RaiseLastOSError;
- Win32Check(PowerSetRequest(FRequestHandle, _RequestType));
+ if FRequestHandle = INVALID_HANDLE_VALUE then begin
+ LastError := GetLastError;
+ if LastError <> 0 then
+ Error := EPowerRequestFailed.CreateFmt(_('PowerCreateRequest failed with error code %d. (%s)'),
+ [LastError, SysErrorMessage(LastError)])
+ else
+ Error := EPowerRequestFailed.CreateFmt(_('PowerCreateRequest failed with error code %d. (unknown error)'),
+ [LastError]);
+ Error.ErrorCode := LastError;
+ raise Error;
+ end;
+
+ if not PowerSetRequest(FRequestHandle, _RequestType) then begin
+ LastError := GetLastError;
+ if LastError <> 0 then
+ Error := EPowerRequestFailed.CreateFmt(_('PowerCreateRequest failed with error code %d. (%s)'),
+ [LastError, SysErrorMessage(LastError)])
+ else
+ Error := EPowerRequestFailed.CreateFmt(_('PowerCreateRequest failed with error code %d. (unknown error)'),
+ [LastError]);
+ Error.ErrorCode := LastError;
+ raise Error;
+ end;
end;
destructor TPowerRequest.Destroy;
@@ -956,6 +985,17 @@
Result := TPowerRequest.Create(_Reason, _RequestType);
end;
+function TrySetPowerRequest(const _Reason: WideString; _RequestType: TPowerRequestType; out _Request: IInterface): Boolean;
+begin
+ try
+ _Request := SetPowerRequest(_Reason, _RequestType);
+ Result := True;
+ except
+ Result := False;
+ _Request := nil;
+ end;
+end;
+
function CharToOem(const _s: string): AnsiString;
begin
SetLength(Result, Length(_s));
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-11-14 14:37:55 UTC (rev 3376)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-11-14 16:58:21 UTC (rev 3377)
@@ -63,6 +63,13 @@
{$IF not declared(NativeUInt)}
NativeUInt = UInt32;
{$IFEND}
+{$IF not declared(UIntPtr)}
+{$IF sizeOf(Pointer)=4}
+ UIntPtr = UInt32;
+{$ELSE}
+ UIntPtr = UInt64;
+{$IFEND}
+{$IFEND}
type
EdzException = class(Exception)
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-11-14 14:37:55 UTC (rev 3376)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-11-14 16:58:21 UTC (rev 3377)
@@ -6811,7 +6811,7 @@
ZeroMemory(@Info, SizeOf(Info));
Info.cbSize := SizeOf(Info);
- // we need to typecast this because we pass a pointer ot TMonitorInfoEx rather than TMonitorInfo
+ // we need to typecast this because we pass a pointer to TMonitorInfoEx rather than TMonitorInfo
if not GetMonitorInfo(hm, PMonitorInfo(@Info)) then
RaiseLastOSError;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2021-02-20 16:47:16
|
Revision: 3436
http://sourceforge.net/p/gexperts/code/3436
Author: twm
Date: 2021-02-20 16:47:13 +0000 (Sat, 20 Feb 2021)
Log Message:
-----------
synced with latest dzlib version from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzClassUtils.pas
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzFileStreams.pas
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
trunk/ExternalSource/dzlib/u_dzVersionInfo.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2021-02-20 11:51:37 UTC (rev 3435)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2021-02-20 16:47:13 UTC (rev 3436)
@@ -51,8 +51,8 @@
{$ENDIF}
{$ENDIF}
-{$IFDEF DELPHIX_TOKYO_UP}
-{$DEFINE FILECTRL_DIRECTORYEXISTS_IS_DEPRECATED}
+{$IFDEF DELPHI2007_UP}
+{$DEFINE HAS_INTTOHEX_FUNCTION}
{$ENDIF}
// The following cond. defines address errors in various Delphi versions regarding the declaration
@@ -62,8 +62,6 @@
// THandleStream.FHandle is declared as THandle (before that it's an Integer)
{$DEFINE THANDLESTREAM_HANDLE_IS_THANDLE}
{$DEFINE HAS_TOBJECT_TOSTRING}
-// TMonitor.PixelsPerInch probably didn't exist in Delphi 2009, it does exist in Delphi 10.2 adjust as necessary
-{$DEFINE HAS_TMONITOR_PIXELSPERINCH}
{$ENDIF}
{$IFDEF DELPHIXE_UP}
@@ -76,14 +74,22 @@
{$DEFINE MAXLISTSIZE_IS_DEPRECATED}
{$ENDIF}
+{$IFDEF DELPHIXE3_UP}
+// TMonitor.PixelsPerInch probably didn't exist in Delphi XE3, it does exist in Delphi 10.2 adjust as necessary
+{$DEFINE HAS_TMONITOR_PIXELSPERINCH}
+{$ENDIF}
+
{$IFDEF DELPHIXE6_UP}
{$DEFINE JSONOBJECT_HAS_COUNT}
{$ENDIF}
{$IFDEF DELPHIX_TOKYO_UP}
+{$DEFINE FILECTRL_DIRECTORYEXISTS_IS_DEPRECATED}
+{$ENDIF}
+
+{$IFDEF DELPHIX_TOKYO_UP}
// this function probably already existed in earlier versions, I just run across a compile error for 10.2 Tokyo
-{$DEFINE HAS_INTTOHEX_FUNCTION}
-{$DEFINE HAS_INTTOHEX_FUNCTION_64}
+{$DEFINE HAS_INTTOHEX_FUNCTION_UINT64}
{$ENDIF}
{$IFOPT T+}
Modified: trunk/ExternalSource/dzlib/u_dzClassUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2021-02-20 11:51:37 UTC (rev 3435)
+++ trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2021-02-20 16:47:13 UTC (rev 3436)
@@ -2208,4 +2208,3 @@
end;
end.
-
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2021-02-20 11:51:37 UTC (rev 3435)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2021-02-20 16:47:13 UTC (rev 3436)
@@ -150,6 +150,18 @@
/// Reduces an Integer to a Byte value by cutting it off at 0 and 255 </summary>
function ReduceToByte(const _Value: Integer): Byte;
{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+function ReduceToInt8(const _Value: Integer): Int8;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+function ReduceToUInt8(const _Value: Integer): UInt8;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+function ReduceToInt16(const _Value: Integer): Int16;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+function ReduceToUInt16(const _Value: Integer): UInt16;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+function ReduceToInt32(const _Value: Int64): Int32;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
+function ReduceToUInt32(const _Value: Int64): UInt32;
+{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
///<summary>
/// Converts a string of the form '-hh:mm:ss', 'hh:mm:ss',
@@ -605,14 +617,69 @@
function ReduceToByte(const _Value: Integer): Byte;
begin
+ Result := ReduceToUInt8(_Value);
+end;
+
+function ReduceToUInt8(const _Value: Integer): UInt8;
+begin
if _Value < 0 then
Result := 0
- else if _Value > 255 then
- Result := 255
+ else if _Value > MaxUInt8 then
+ Result := MaxUInt8
else
Result := _Value;
end;
+function ReduceToInt8(const _Value: Integer): Int8;
+begin
+ if _Value < MinInt8 then
+ Result := MinInt8
+ else if _Value > MaxInt8 then
+ Result := MaxInt8
+ else
+ Result := _Value;
+end;
+
+function ReduceToUInt16(const _Value: Integer): UInt16;
+begin
+ if _Value < 0 then
+ Result := 0
+ else if _Value > MaxUInt16 then
+ Result := MaxUInt16
+ else
+ Result := _Value;
+end;
+
+function ReduceToInt16(const _Value: Integer): Int16;
+begin
+ if _Value < MinInt16 then
+ Result := MinInt16
+ else if _Value > MaxInt16 then
+ Result := MaxInt16
+ else
+ Result := _Value;
+end;
+
+function ReduceToUInt32(const _Value: Int64): UInt32;
+begin
+ if _Value < 0 then
+ Result := 0
+ else if _Value > MaxUInt32 then
+ Result := MaxUInt32
+ else
+ Result := _Value;
+end;
+
+function ReduceToInt32(const _Value: Int64): Int32;
+begin
+ if _Value < MinInt32 then
+ Result := MinInt32
+ else if _Value > MaxInt32 then
+ Result := MaxInt32
+ else
+ Result := _Value;
+end;
+
function isHexDigit(_a: Char): Boolean;
begin
Result := isDigit(_a, 16);
Modified: trunk/ExternalSource/dzlib/u_dzFileStreams.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2021-02-20 11:51:37 UTC (rev 3435)
+++ trunk/ExternalSource/dzlib/u_dzFileStreams.pas 2021-02-20 16:47:13 UTC (rev 3436)
@@ -13,6 +13,7 @@
Classes,
SysUtils,
Windows,
+ u_dzTypes, // necessary for correcting NativeInt
u_dzTranslator;
type
@@ -226,7 +227,6 @@
implementation
uses
- u_dzTypes,
u_dzFileUtils,
u_dzMiscUtils;
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2021-02-20 11:51:37 UTC (rev 3435)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2021-02-20 16:47:13 UTC (rev 3436)
@@ -2,11 +2,11 @@
{$INCLUDE 'dzlib.inc'}
-{$IFDEF DELPHI2005}
+{.$IFDEF DELPHI2005}
// the Delphi 2005 cmpiler crashes if this is compiled with typed @ operator
// turned on
{$TYPEDADDRESS OFF}
-{$ENDIF}
+{.$ENDIF}
{$IFDEF OPTIMIZE_DZ_GRAPHIC_UTILS}
{$OPTIMIZATION ON}
Modified: trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2021-02-20 11:51:37 UTC (rev 3435)
+++ trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2021-02-20 16:47:13 UTC (rev 3436)
@@ -24,7 +24,8 @@
Windows,
SysUtils,
Registry,
- u_dzTranslator;
+ u_dzTranslator,
+ u_dzTypes;
type
///<summary> raised by Max([array of const]) and Min([array of const]) if the passed
@@ -86,11 +87,11 @@
function IntToHex(_Value: Int64): string; overload;
{$ENDIF HAS_INTTOHEX_FUNCTION}
-{$IFNDEF HAS_INTTOHEX_FUNCTION_64}
{$IFDEF SUPPORTS_UINT64}
+{$IFNDEF HAS_INTTOHEX_FUNCTION_UINT64}
function IntToHex(_Value: UInt64): string; overload;
+{$ENDIF HAS_INTTOHEX_FUNCTION_64}
{$ENDIF SUPPORTS_UINT64}
-{$ENDIF HAS_INTTOHEX_FUNCTION_64}
function PtrToHex(_Value: Pointer): string;
@@ -232,7 +233,6 @@
{$ENDIF}
{$ENDIF}
StrUtils,
- u_dzTypes,
u_dzFileUtils,
u_dzStringUtils,
u_dzConvertUtils;
@@ -537,8 +537,8 @@
end;
{$ENDIF HAS_INTTOHEX_FUNCTION}
-{$IFNDEF HAS_INTTOHEX_FUNCTION_64}
{$IFDEF SUPPORTS_UINT64}
+{$IFNDEF HAS_INTTOHEX_FUNCTION_UINT64}
function IntToHex(_Value: UInt64): string; overload;
var
Buf: PUInt32;
@@ -548,8 +548,8 @@
Buf := PUInt32(@_Value);
Result := Result + IntToHex(Buf^, 8);
end;
+{$ENDIF HAS_INTTOHEX_FUNCTION_UINT64}
{$ENDIF SUPPORTS_UINT64}
-{$ENDIF HAS_INTTOHEX_FUNCTION_64}
function PtrToHex(_Value: Pointer): string;
begin
Modified: trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas 2021-02-20 11:51:37 UTC (rev 3435)
+++ trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas 2021-02-20 16:47:13 UTC (rev 3436)
@@ -53,6 +53,7 @@
Forms,
Messages,
Classes,
+ u_dzTypes,
u_dzVclUtils;
type
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2021-02-20 11:51:37 UTC (rev 3435)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2021-02-20 16:47:13 UTC (rev 3436)
@@ -59,12 +59,17 @@
{$IF not declared(PUInt64)}
PUInt64 = ^UInt64;
{$IFEND}
-
-{$IF not declared(NativeUInt)}
+{$IF SizeOf(Pointer) <> SizeOf(NativeInt)}
+// In Delphi 2007 and older, the NativeInt declaration is wrong. It should always have the same size
+// as a pointer.
+type
+ NativeInt = Int32;
+{$IFEND}
+{$IF not declared(NativeUInt) or (SizeOf(Pointer) <> SizeOf(NativeUInt))}
NativeUInt = UInt32;
{$IFEND}
{$IF not declared(UIntPtr)}
-{$IF sizeOf(Pointer)=4}
+{$IF SizeOf(Pointer)=4}
UIntPtr = UInt32;
{$ELSE}
UIntPtr = UInt64;
@@ -71,6 +76,51 @@
{$IFEND}
{$IFEND}
+{$IF not declared(MaxUInt32)}
+const
+ MaxUInt32 = $FFFFFFFF;
+{$IFEND}
+
+{$IF not declared(MaxInt32)}
+const
+ MaxInt32 = $7FFFFFFF;
+{$IFEND}
+
+{$IF not declared(MinInt32)}
+const
+ MinInt32 = -$80000000;
+{$IFEND}
+
+{$IF not declared(MaxUInt16)}
+const
+ MaxUInt16 = $FFFF;
+{$IFEND}
+
+{$IF not declared(MaxInt16)}
+const
+ MaxInt16 = $7FFF;
+{$IFEND}
+
+{$IF not declared(MinInt16)}
+const
+ MinInt16 = -$8000;
+{$IFEND}
+
+{$IF not declared(MaxUInt8)}
+const
+ MaxUInt8 = $FF;
+{$IFEND}
+
+{$IF not declared(MaxInt8)}
+const
+ MaxInt8 = $7F;
+{$IFEND}
+
+{$IF not declared(MinInt8)}
+const
+ MinInt8 = -$80;
+{$IFEND}
+
type
EdzException = class(Exception)
end;
@@ -108,6 +158,136 @@
type
TMethodPointer = procedure of object;
+type
+ TRectLTWH = record
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+ private
+ function GetTopLeft: TPoint;
+ procedure SetTopLeft(_TopLeft: TPoint);
+ function GetBottomLeft: TPoint;
+ procedure SetBottomLeft(const _BottomLeft: TPoint);
+ public
+{$ENDIF}
+ Left: Integer;
+ Top: Integer;
+ Width: Integer;
+ Height: Integer;
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+ procedure Assign(_Left, _Top, _Width, _Height: Integer); overload;
+ procedure Assign(_a: TRect); overload;
+ procedure AssignTLRB(_Left, _Top, _Right, _Bottom: Integer);
+ ///<summary>
+ /// Gets and sets the top left coordinates keeping the size </summary>
+ property TopLeft: TPoint read GetTopLeft write SetTopLeft;
+ ///<summary>
+ /// Gets and sets the bottom left coordinates keeping the size </summary>
+ property BottomLeft: TPoint read GetBottomLeft write SetBottomLeft;
+ function GetCenter: TPoint;
+ function Right: Integer;
+ function Bottom: Integer;
+ class operator Implicit(_a: TRect): TRectLTWH;
+ class operator Implicit(_a: TRectLTWH): TRect;
+ class function FromLTWH(_Left, _Top, _Width, _Height: Integer): TRectLTWH; static;
+{$ENDIF}
+ end;
+
+procedure TRectLTWH_Assign(var _LTWH: TRectLTWH; _Left, _Top, _Width, _Height: Integer); overload;
+procedure TRectLTWH_Assign(var _LTWH: TRectLTWH; _a: TRect); overload;
+procedure TRectLTWH_AssignTLRB(var _LTWH: TRectLTWH; _Left, _Top, _Right, _Bottom: Integer);
+
implementation
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+{ TRectLTWH }
+
+procedure TRectLTWH.Assign(_Left, _Top, _Width, _Height: Integer);
+begin
+ Left := _Left;
+ Top := _Top;
+ Width := _Width;
+ Height := _Height;
+end;
+
+procedure TRectLTWH.Assign(_a: TRect);
+begin
+ AssignTLRB(_a.Left, _a.Top, _a.Right, _a.Bottom);
+end;
+
+procedure TRectLTWH.AssignTLRB(_Left, _Top, _Right, _Bottom: Integer);
+begin
+ Assign(_Left, _Top, _Right - _Left, _Bottom - _Top);
+end;
+
+class function TRectLTWH.FromLTWH(_Left, _Top, _Width, _Height: Integer): TRectLTWH;
+begin
+ Result.Assign(_Left, _Top, _Width, _Height);
+end;
+
+function TRectLTWH.Right: Integer;
+begin
+ Result := Left + Width;
+end;
+
+function TRectLTWH.Bottom: Integer;
+begin
+ Result := Top + Height;
+end;
+
+function TRectLTWH.GetBottomLeft: TPoint;
+begin
+ Result := Point(Left, Top + Height);
+end;
+
+function TRectLTWH.GetCenter: TPoint;
+begin
+ Result := Point(Left + Width div 2, Top + Height div 2);
+end;
+
+procedure TRectLTWH.SetBottomLeft(const _BottomLeft: TPoint);
+begin
+ Left := _BottomLeft.X;
+ Top := _BottomLeft.Y - Height;
+end;
+
+function TRectLTWH.GetTopLeft: TPoint;
+begin
+ Result.X := Left;
+ Result.Y := Top;
+end;
+
+procedure TRectLTWH.SetTopLeft(_TopLeft: TPoint);
+begin
+ Left := _TopLeft.X;
+ Top := _TopLeft.Y;
+end;
+
+class operator TRectLTWH.Implicit(_a: TRectLTWH): TRect;
+begin
+ Result := Rect(_a.Left, _a.Top, _a.Left + _a.Width, _a.Top + _a.Height);
+end;
+
+class operator TRectLTWH.Implicit(_a: TRect): TRectLTWH;
+begin
+ Result.Assign(_a);
+end;
+{$ENDIF}
+
+procedure TRectLTWH_Assign(var _LTWH: TRectLTWH; _Left, _Top, _Width, _Height: Integer);
+begin
+ _LTWH.Left := _Left;
+ _LTWH.Top := _Top;
+ _LTWH.Width := _Width;
+ _LTWH.Height := _Height;
+end;
+
+procedure TRectLTWH_Assign(var _LTWH: TRectLTWH; _a: TRect);
+begin
+ TRectLTWH_AssignTLRB(_LTWH, _a.Left, _a.Top, _a.Right, _a.Bottom);
+end;
+
+procedure TRectLTWH_AssignTLRB(var _LTWH: TRectLTWH; _Left, _Top, _Right, _Bottom: Integer);
+begin
+ TRectLTWH_Assign(_LTWH, _Left, _Top, _Right - _Left, _Bottom - _Top);
+end;
+
end.
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2021-02-20 11:51:37 UTC (rev 3435)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2021-02-20 16:47:13 UTC (rev 3436)
@@ -85,7 +85,20 @@
end;
{$IFEND}
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
type
+ TDpiScaler = record
+ private
+ FDesignDpi: Integer;
+ FCurrentDpi: Integer;
+ public
+ procedure Init(_frm: TCustomForm); inline;
+ procedure SetCurrentDpi(_frm: TCustomForm); inline;
+ function Calc(_Value: Integer): Integer; inline;
+ end;
+{$ENDIF SUPPORTS_ENHANCED_RECORDS}
+
+type
///<summary> This is a copy of the TFileFormatsList class from Graphics which
/// is unfortunately only declaread in the implementation section </summary>
TFileFormatsList = class(TList)
@@ -1152,6 +1165,8 @@
/// Warning: The result might be nil if the form is outside the visible area. </summary>
function TForm_GetMonitor(_frm: TForm): TMonitor;
+function TForm_GetDesignDPI(_frm: TForm): Integer;
+
///<summary> centers a form on the given point, but makes sure the form is fully visible </summary>
procedure TForm_CenterOn(_frm: TForm; _Center: TPoint); overload;
///<summary> centers a form on the given component, but makes sure the form is fully visible </summary>
@@ -1496,6 +1511,13 @@
function TMenuItem_FindSelectedRadioItem(_mi: TMenuItem; _GroupIndex: Integer; out _miFound: TMenuItem): Boolean;
///<summary>
+/// Assigns an OnAdvancedDrawItem event for all menu items that forces drawing the accelerator char
+/// @returns a TCompnent which contains the event's implementation. It is added to the menu, so
+/// it will automatically be freed with the menu. It is safe to simply ignore this
+/// result as it is only returned for debugging purposes. </summary>
+function TMainMenu_ForceAcceleratorChar(_mnu: TMainMenu): TComponent;
+
+///<summary>
/// Sets Screen.Cursor to NewCursor and restores it automatically when the returned interface
/// goes out of scope </summary>
function TCursor_TemporaryChange(_NewCursor: TCursor = crHourGlass): IInterface;
@@ -1552,43 +1574,6 @@
end;
{$ENDIF}
-type
- TRectLTWH = record
-{$IFDEF SUPPORTS_ENHANCED_RECORDS}
- private
- function GetTopLeft: TPoint;
- procedure SetTopLeft(_TopLeft: TPoint);
- function GetBottomLeft: TPoint;
- procedure SetBottomLeft(const _BottomLeft: TPoint);
- public
-{$ENDIF}
- Left: Integer;
- Top: Integer;
- Width: Integer;
- Height: Integer;
-{$IFDEF SUPPORTS_ENHANCED_RECORDS}
- procedure Assign(_Left, _Top, _Width, _Height: Integer); overload;
- procedure Assign(_a: TRect); overload;
- procedure AssignTLRB(_Left, _Top, _Right, _Bottom: Integer);
- ///<summary>
- /// Gets and sets the top left coordinates keeping the size </summary>
- property TopLeft: TPoint read GetTopLeft write SetTopLeft;
- ///<summary>
- /// Gets and sets the bottom left coordinates keeping the size </summary>
- property BottomLeft: TPoint read GetBottomLeft write SetBottomLeft;
- function GetCenter: TPoint;
- function Right: Integer;
- function Bottom: Integer;
- class operator Implicit(_a: TRect): TRectLTWH;
- class operator Implicit(_a: TRectLTWH): TRect;
- class function FromLTWH(_Left, _Top, _Width, _Height: Integer): TRectLTWH; static;
-{$ENDIF}
- end;
-
-procedure TRectLTWH_Assign(var _LTWH: TRectLTWH; _Left, _Top, _Width, _Height: Integer); overload;
-procedure TRectLTWH_Assign(var _LTWH: TRectLTWH; _a: TRect); overload;
-procedure TRectLTWH_AssignTLRB(var _LTWH: TRectLTWH; _Left, _Top, _Right, _Bottom: Integer);
-
///<summary>
/// deprecated version of TForm_StorePlacement
/// @param Bounds is a TRectLTWH whose placement is to be stored
@@ -1637,13 +1622,50 @@
procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; var _Rect: TRectLTWH); overload;
procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; _frm: TForm); overload;
+///<summary>
+/// Tries to get the primary monitor.
+/// @param Monitor returns the primary monitor, only valid if Result = True
+/// @returns True, if the primary monitor could be determined
+/// False, if not
+/// @NOTE: It is possible for this function to return False. I have observed this when switching
+/// between Remote Destkop access and local monitors on Windows XP. </summary>
function TScreen_TryGetPrimaryMonitor(out _Monitor: TMonitor): Boolean;
+///<summary>
+/// Gge the primary monitor.
+/// @returns the primary monitor if there is one
+/// NIL if not
+/// @NOTE: It is possible for this function to return NIL. I have observed this when switching
+/// between Remote Destkop access and local monitors on Windows XP. </summary>
function TScreen_GetPrimaryMonitor: TMonitor;
+///<summary>
+/// Trys to determine the monitor for the given point or the primary monitor if the point is
+/// outside the visible area of any attached monitor
+/// @param pnt is the point to check
+/// @param Monitor returns the monitor for the given point or the primary monitor
+/// only valid if Result = True
+/// @returns True, Monitor is valid
+/// False, if not
+/// @NOTE: It is possible for this function to return False. I have observed this when switching
+/// between Remote Destkop access and local monitors on Windows XP. </summary>
function TScreen_TryGetMonitorFromPointOrPrimary(_pnt: TPoint; out _Monitor: TMonitor): Boolean;
+///<summary>
+/// Trys to determine the monitor for the given point
+/// @param pnt is the point to check
+/// @param Monitor returns the monitor for the given point, only valid if Result = True
+/// @returns True, if the monitor could be determined
+/// False, if not (e.g. the point is outside the visible area of any monitor </summary>
function TScreen_TryGetMonitorFromPoint(_pnt: TPoint; out _Monitor: TMonitor): Boolean;
+///<summary>
+/// Gets the monitor for the given point
+/// @param pnt is the point to check
+/// @param Monitor returns the monitor for the given point, only valid if Result = True
+/// @returns the monitor for the given point or NIL if it could not be determined </summary>
function TScreen_MonitorFromPoint(_pnt: TPoint): TMonitor;
+function TScreen_GetDpiForPoint(_pnt: TPoint): Integer;
+function TScreen_GetDpiForForm(_frm: TCustomForm): Integer;
+
procedure TScreen_MakeFullyVisible(_frm: TForm); overload;
procedure TScreen_MakeFullyVisible(var _Left, _Top, _Width, _Height: Integer); overload;
procedure TScreen_MakeFullyVisible(var _Rect: TRect); overload;
@@ -4170,6 +4192,49 @@
Result := nil;
end;
+function TScreen_GetDpiForPoint(_pnt: TPoint): Integer;
+{$IFDEF HAS_TMONITOR_PIXELSPERINCH}
+var
+ Monitor: TMonitor;
+{$ENDIF}
+begin
+{$IFDEF HAS_TMONITOR_PIXELSPERINCH}
+ if TScreen_TryGetMonitorFromPoint(_pnt, Monitor) then
+ Result := Monitor.PixelsPerInch
+ else
+{$ENDIF}
+ Result := Screen.PixelsPerInch;
+end;
+
+function TScreen_GetDpiForForm(_frm: TCustomForm): Integer;
+{$IFDEF HAS_TMONITOR_PIXELSPERINCH}
+var
+ Monitor: TMonitor;
+{$ENDIF}
+begin
+ Result := Screen.PixelsPerInch;
+{$IFDEF HAS_TMONITOR_PIXELSPERINCH}
+ if _frm is TForm then begin
+ Monitor := TForm_GetMonitor(TForm(_frm));
+ if Assigned(Monitor) then
+ Result := Monitor.PixelsPerInch
+ end;
+{$ENDIF}
+end;
+
+type
+ TFormHack = class(TForm)
+ end;
+
+function TForm_GetDesignDPI(_frm: TForm): Integer;
+begin
+{$IFDEF HAS_TMONITOR_PIXELSPERINCH}
+ Result := TFormHack(_frm).GetDesignDpi;
+{$ELSE}
+ Result := 96;
+{$ENDIF}
+end;
+
function TForm_GetMonitor(_frm: TForm): TMonitor;
var
Center: TPoint;
@@ -5127,6 +5192,80 @@
Result := False;
end;
+type
+ TMenuItemHack = class(TMenuItem)
+ // to get access to the protected TMenuItem.AdvancedDrawItem method
+ end;
+
+type
+ TForceAcceleratorCharHandlerComponent = class(TComponent)
+ private
+ procedure HandleAdvancedDrawItem(_Sender: TObject; _Canvas: TCanvas; _Rect: TRect;
+ _State: TOwnerDrawState);
+ procedure HandleMeasureItem(_Sender: TObject; _Canvas: TCanvas; var _Width, _Height: Integer);
+ end;
+
+procedure TForceAcceleratorCharHandlerComponent.HandleAdvancedDrawItem(_Sender: TObject;
+ _Canvas: TCanvas; _Rect: TRect; _State: TOwnerDrawState);
+var
+ TopLevel: Boolean;
+begin
+ // force accelerator char to be underlined
+ _State := _State - [odnoAccel];
+ TMenuItem(_Sender).OnAdvancedDrawItem := nil;
+ TopLevel := TMenuItem(_Sender).GetParentComponent is TMainMenu;
+ TMenuItemHack(_Sender).AdvancedDrawItem(_Canvas, _Rect, _State, TopLevel);
+ TMenuItem(_Sender).OnAdvancedDrawItem := HandleAdvancedDrawItem;
+end;
+
+procedure TForceAcceleratorCharHandlerComponent.HandleMeasureItem(_Sender: TObject; _Canvas: TCanvas;
+ var _Width, _Height: Integer);
+begin
+ // the size of the main menu items doesn't really seem right in per Monitor high DPI mode
+ // todo: Fix it here
+end;
+
+function TMainMenu_ForceAcceleratorChar(_mnu: TMainMenu): TComponent;
+
+ function TryFindHandlerCoponent(_Owner: TComponent; out _HandlerCmp: TForceAcceleratorCharHandlerComponent): Boolean;
+ var
+ cmp: TComponent;
+ i: Integer;
+ begin
+ for i := 0 to _Owner.ComponentCount - 1 do begin
+ cmp := _Owner.Components[i];
+ if cmp is TForceAcceleratorCharHandlerComponent then begin
+ _HandlerCmp := TForceAcceleratorCharHandlerComponent(cmp);
+ Result := True;
+ Exit; //==>
+ end;
+ end;
+ Result := False;
+ end;
+
+ procedure AssignDrawingHandler(_mi: TMenuItem; _HandlerCmp: TForceAcceleratorCharHandlerComponent);
+ var
+ i: Integer;
+ begin
+ _mi.OnAdvancedDrawItem := _HandlerCmp.HandleAdvancedDrawItem;
+ _mi.OnMeasureItem := _HandlerCmp.HandleMeasureItem;
+ for i := 0 to _mi.Count - 1 do
+ AssignDrawingHandler(_mi[i], _HandlerCmp);
+ end;
+
+var
+ HandlerCmp: TForceAcceleratorCharHandlerComponent;
+ i: Integer;
+begin
+ if not TryFindHandlerCoponent(_mnu, HandlerCmp) then begin
+ HandlerCmp := TForceAcceleratorCharHandlerComponent.Create(_mnu);
+ HandlerCmp.Name := '';
+ end;
+ for i := 0 to _mnu.Items.Count - 1 do
+ AssignDrawingHandler(_mnu.Items[i], HandlerCmp);
+ Result := HandlerCmp;
+end;
+
function TPopupMenu_FindSelectedRadioItem(_pm: TPopupMenu; _GroupIndex: Integer; out _miFound: TMenuItem): Boolean;
begin
Result := TMenuItem_FindSelectedRadioItem(_pm.Items, _GroupIndex, _miFound);
@@ -5839,7 +5978,7 @@
fn: string;
i: Integer;
sl: TStringList;
- cnt: Cardinal;
+ cnt: Integer;
begin
sl := TStringList.Create;
try
@@ -6353,99 +6492,6 @@
TMonitor_MakeFullyVisible(Monitor, _Rect);
end;
-{$IFDEF SUPPORTS_ENHANCED_RECORDS}
-{ TRectLTWH }
-
-procedure TRectLTWH.Assign(_Left, _Top, _Width, _Height: Integer);
-begin
- Left := _Left;
- Top := _Top;
- Width := _Width;
- Height := _Height;
-end;
-
-procedure TRectLTWH.Assign(_a: TRect);
-begin
- AssignTLRB(_a.Left, _a.Top, _a.Right, _a.Bottom);
-end;
-
-procedure TRectLTWH.AssignTLRB(_Left, _Top, _Right, _Bottom: Integer);
-begin
- Assign(_Left, _Top, _Right - _Left, _Bottom - _Top);
-end;
-
-class function TRectLTWH.FromLTWH(_Left, _Top, _Width, _Height: Integer): TRectLTWH;
-begin
- Result.Assign(_Left, _Top, _Width, _Height);
-end;
-
-function TRectLTWH.Right: Integer;
-begin
- Result := Left + Width;
-end;
-
-function TRectLTWH.Bottom: Integer;
-begin
- Result := Top + Height;
-end;
-
-function TRectLTWH.GetBottomLeft: TPoint;
-begin
- Result := Point(Left, Top + Height);
-end;
-
-function TRectLTWH.GetCenter: TPoint;
-begin
- Result := Point(Left + Width div 2, Top + Height div 2);
-end;
-
-procedure TRectLTWH.SetBottomLeft(const _BottomLeft: TPoint);
-begin
- Left := _BottomLeft.X;
- Top := _BottomLeft.Y - Height;
-end;
-
-function TRectLTWH.GetTopLeft: TPoint;
-begin
- Result.X := Left;
- Result.Y := Top;
-end;
-
-procedure TRectLTWH.SetTopLeft(_TopLeft: TPoint);
-begin
- Left := _TopLeft.X;
- Top := _TopLeft.Y;
-end;
-
-class operator TRectLTWH.Implicit(_a: TRectLTWH): TRect;
-begin
- Result := Rect(_a.Left, _a.Top, _a.Left + _a.Width, _a.Top + _a.Height);
-end;
-
-class operator TRectLTWH.Implicit(_a: TRect): TRectLTWH;
-begin
- Result.Assign(_a);
-end;
-{$ENDIF}
-
-procedure TRectLTWH_Assign(var _LTWH: TRectLTWH; _Left, _Top, _Width, _Height: Integer);
-begin
- _LTWH.Left := _Left;
- _LTWH.Top := _Top;
- _LTWH.Width := _Width;
- _LTWH.Height := _Height;
-end;
-
-procedure TRectLTWH_Assign(var _LTWH: TRectLTWH; _a: TRect);
-begin
- TRectLTWH_AssignTLRB(_LTWH, _a.Left, _a.Top, _a.Right, _a.Bottom);
-end;
-
-procedure TRectLTWH_AssignTLRB(var _LTWH: TRectLTWH; _Left, _Top, _Right, _Bottom: Integer);
-begin
- TRectLTWH_Assign(_LTWH, _Left, _Top, _Right - _Left, _Bottom - _Top);
-end;
-
procedure TForm_MoveTo(_frm: TCustomForm; _Position: TdzWindowPositions);
procedure ToTop(var _Re: TRect; _MinHeight, _MaxHeight: Integer);
@@ -6846,6 +6892,46 @@
end;
{$ENDIF}
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+{ TDpiScaler }
+
+function TDpiScaler.Calc(_Value: Integer): Integer;
+begin
+ Result := MulDiv(_Value, FCurrentDpi, FDesignDpi);
+end;
+
+procedure TDpiScaler.Init(_frm: TCustomForm);
+begin
+ if not Assigned(_frm) then begin
+ FDesignDpi := 96;
+ FCurrentDpi := 96;
+ end else begin
+// todo: adjust as needed
+{$IFDEF DELPHIX_TOKYO_UP}
+ FDesignDpi := TForm_GetDesignDPI(TForm(_frm));
+ FCurrentDpi := TScreen_GetDpiForForm(_frm);
+{$ELSE ~DELPHIX_TOKYO_UP}
+ FDesignDpi := TForm(_frm).PixelsPerInch;
+ FCurrentDpi := TForm(_frm).PixelsPerInch;
+{$ENDIF DELPHIX_TOKYO_UP}
+ end;
+end;
+
+procedure TDpiScaler.SetCurrentDpi(_frm: TCustomForm);
+begin
+ if not Assigned(_frm) then begin
+ FCurrentDpi := 96;
+ end else begin
+// todo: adjust as needed
+{$IFDEF DELPHIX_TOKYO_UP}
+ FCurrentDpi := TScreen_GetDpiForForm(_frm)
+{$ELSE ~DELPHIX_TOKYO_UP}
+ FCurrentDpi := TForm(_frm).PixelsPerInch;
+{$ENDIF DELPHIX_TOKYO_UP}
+ end;
+end;
+{$ENDIF SUPPORTS_ENHANCED_RECORDS}
+
initialization
InitializeCustomMessages;
finalization
Modified: trunk/ExternalSource/dzlib/u_dzVersionInfo.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVersionInfo.pas 2021-02-20 11:51:37 UTC (rev 3435)
+++ trunk/ExternalSource/dzlib/u_dzVersionInfo.pas 2021-02-20 16:47:13 UTC (rev 3436)
@@ -419,7 +419,7 @@
szOffset := SizeOf(UInt16) * 3;
Move(_Buffer[_Offset], _StringTable, szOffset);
if _StringTable.wValueLength <> 0 then
- raise EdzException.CreateFmt(_('StringTable.wValueLength must bei 0 but is %d'), [_StringTable.wValueLength]);
+ raise EdzException.CreateFmt(_('StringTable.wValueLength must be 0 but is %d'), [_StringTable.wValueLength]);
_StringTable.szKey := ReadNullTerminatedWideString(_Buffer, _Offset + szOffset);
// _StringTable.szKey is the language code
@@ -446,11 +446,11 @@
szOffset := SizeOf(UInt16) * 3;
Move(_Buffer[_Offset], _StringFileInfo, szOffset);
if _StringFileInfo.wValueLength <> 0 then
- raise EdzException.CreateFmt(_('StringFileInfo.wValueLength must bei 0 but is %d'), [_StringFileInfo.wValueLength]);
+ raise EdzException.CreateFmt(_('StringFileInfo.wValueLength must be 0 but is %d'), [_StringFileInfo.wValueLength]);
_StringFileInfo.szKey := ReadNullTerminatedWideString(_Buffer, _Offset + szOffset);
if _StringFileInfo.szKey <> 'StringFileInfo' then
- raise EdzException.CreateFmt(_('StringFileInfo.szKey "StringFileInfo" but is "%s"'), [_StringFileInfo.szKey]);
+ raise EdzException.CreateFmt(_('StringFileInfo.szKey must be "StringFileInfo" but is "%s"'), [_StringFileInfo.szKey]);
SetLength(_StringFileInfo.Children, 0);
Offset := (_Offset + szOffset + (Length(_StringFileInfo.szKey) + 1) * SizeOf(WideChar) + 3) and (not 3);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2021-03-22 07:54:31
|
Revision: 3459
http://sourceforge.net/p/gexperts/code/3459
Author: twm
Date: 2021-03-22 07:54:25 +0000 (Mon, 22 Mar 2021)
Log Message:
-----------
Updated to latest dzlib units
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzCriticalSection.pas
trunk/ExternalSource/dzlib/u_dzFileUtils.pas
trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
trunk/ExternalSource/dzlib/u_dzVersionInfo.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2021-03-22 07:53:58 UTC (rev 3458)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2021-03-22 07:54:25 UTC (rev 3459)
@@ -74,13 +74,13 @@
{$DEFINE MAXLISTSIZE_IS_DEPRECATED}
{$ENDIF}
-{$IFDEF DELPHIX_SEATTLE}
+{$IFDEF DELPHIX_SEATTLE_UP}
// TMonitor.PixelsPerInch was introduced in Delphi 10.0 Seattle
{$DEFINE HAS_TMONITOR_PIXELSPERINCH}
{$ENDIF}
-{$IFDEF DELPHIX_BERLIN}
-// TMonitor.PixelsPerInch was introduced in Delphi 10.0 Seattle
+{$IFDEF DELPHIX_BERLIN_UP}
+// TMform.GetDesignDpi was introduced in Delphi 10.0 Seattle
{$DEFINE HAS_TFORM_GETDESIGNDPI}
{$ENDIF}
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2021-03-22 07:53:58 UTC (rev 3458)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2021-03-22 07:54:25 UTC (rev 3459)
@@ -43,8 +43,6 @@
TBaseN = 2..36;
const
- MinInt64 = Int64($8000000000000000);
- MaxInt64 = Int64($7FFFFFFFFFFFFFFF);
MaxLongWord = $FFFFFFFF;
const
Modified: trunk/ExternalSource/dzlib/u_dzCriticalSection.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzCriticalSection.pas 2021-03-22 07:53:58 UTC (rev 3458)
+++ trunk/ExternalSource/dzlib/u_dzCriticalSection.pas 2021-03-22 07:54:25 UTC (rev 3459)
@@ -1,32 +1,121 @@
unit u_dzCriticalSection;
-{.$DEFINE debug_Crit_Sect}
+{$INCLUDE 'dzlib.inc'}
+{.$DEFINE DEBUG_CRIT_SECT}
+
+{$IFNDEF DEBUG}
+{$UNDEF DEBUG_CRIT_SECT}
+{$ENDIF}
+
interface
uses
Windows,
- SyncObjs;
+ SyncObjs,
+ u_dzTranslator;
type
TdzCriticalSection = class(TCriticalSection)
private
-{$IFDEF debug_Crit_Sect}
+{$IFDEF DEBUG_CRIT_SECT}
FLockCount: Integer;
FOwner: Integer;
-{$ENDIF debug_Crit_Sect}
+{$ENDIF DEBUG_CRIT_SECT}
public
class function NewInstance: TObject; override;
-{$IFDEF debug_Crit_Sect}
+{$IFDEF DEBUG_CRIT_SECT}
procedure Acquire; override;
procedure Release; override;
-{$ENDIF debug_Crit_Sect}
+{$ENDIF DEBUG_CRIT_SECT}
end;
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+type
+{$ALIGN ON}
+ PdzRTLCriticalSection = ^TdzRTLCriticalSection;
+ TdzRTLCriticalSection = record
+ private
+ DebugInfo: PRTLCriticalSectionDebug;
+ LockCount: Longint;
+ RecursionCount: Longint;
+ OwningThread: THandle;
+ LockSemaphore: THandle;
+ // Apparently the following field contains the SpinCount value (passed or dynamically generated)
+ // ORed with one of the RTL_CRITICAL_SECTION_FLAG_xxxx flags (see below).
+ // Note that there is no official documentation on it.
+ Reserved: DWORD;
+ public
+ ///<summary>
+ /// Allocates a TdzRtlCriticalSection on the heap and initializes it
+ /// @param SpinCount gives the maximum number of spin loops before the thread waits.
+ /// default is 0 which uses the system default (which apparently is 2000)
+ /// @param WithDebugInfo determines whether a critical section is created with
+ /// debug info. Default is True which is also the system default </summary>
+ class function AllocAndInit(_SpinCount: DWORD; _WithDebugInfo: Boolean): PdzRTLCriticalSection; overload; static;
+ class function AllocAndInit(_SpinCount: DWORD = 0): PdzRTLCriticalSection; overload; static;
+ ///<summary>
+ /// DeInits a cricital section that has been allocated on the using AllocAndInit
+ /// and frees the memory. </summary>
+ procedure DeInitAndFree;
+ ///<summary>
+ /// calls InitializeCriticalSection or InitializeCriticalSectionEx for this TdzRTLCriticalSection
+ /// @param SpinCount gives the maximum number of spin loops before the thread waits.
+ /// default is 0 which uses the system default.
+ /// @param WithDebugInfo determines whether a critical section is created with
+ /// debug info. If not given, the system default is used, which apparently
+ /// is True for Windows 7 and False for Windows 10 (don't know about
+ /// Windows 8) </summary>
+ procedure Init(_SpinCount: DWORD; _WithDebugInfo: Boolean); overload;
+ procedure Init(_SpinCount: DWORD = 0); overload;
+ ///<summary>
+ /// calls FreeCriticalSection for this TdzRTLCriticalSection </summary>
+ procedure DeInit;
+ ///<summary>
+ /// calls SetCriticalSectionSpinCount for this TdzRTLCriticalSection
+ /// @param SpinCount is the new spin count
+ /// @returns the previous SpinCount of this TdzRTLCriticalSection
+ /// NOTE: Even though there is no official way to read the spin count, it is possible to get
+ /// it by calling this method twice:
+ /// 1. set the SpinCount to an arbitrary value
+ /// 2. call it again to set it back to the old value returned by the first call </summary>
+ function SetSpinCount(_SpinCount: DWORD): DWORD;
+ ///<summary>
+ /// calls TryEnterCriticalSection for this TdzRTLCriticalSection </summary>
+ function TryEnter: Boolean;
+ ///<summary>
+ /// calls EnterCriticalSection for this TdzRTLCriticalSection </summary>
+ procedure Enter;
+ ///<summary>
+ /// calls LeaveCriticalSection for this TdzRTLCriticalSection </summary>
+ procedure Leave;
+{$IFDEF DEBUG_CRIT_SECT}
+ type
+ TCritSectFlags = (csfNoDebugInfo, csfDynamicSpin, csfStaticInit, csfResourceType, csfForceDebugInfo);
+ TCritSectFlagSet = set of TCritSectFlags;
+ function GetSpinCountFromReserved: DWORD;
+ function GetFlagsFromReserved: TCritSectFlagSet;
+{$ENDIF}
+ end;
+{$ENDIF SUPPORTS_ENHANCED_RECORDS}
+
+const
+{$IF not declared(CRITICAL_SECTION_NO_DEBUG_INFO)}
+ CRITICAL_SECTION_NO_DEBUG_INFO = $01000000;
+{$IFEND}
+ // These flags are not documented but defined in winnt.h and can be passed to InitializeCriticalSectionEx.
+ // Also, apparently Windows 10 was changed to default to CRITICAL_SECTION_NO_DEBUG_INFO
+ // source: https://stackoverflow.com/a/53089288/49925
+ RTL_CRITICAL_SECTION_FLAG_DYNAMIC_SPIN = $02000000;
+ RTL_CRITICAL_SECTION_FLAG_STATIC_INIT = $04000000;
+ RTL_CRITICAL_SECTION_FLAG_RESOURCE_TPE = $08000000;
+ RTL_CRITICAL_SECTION_FLAG_FORCE_DEBUG_INFO = $10000000;
+
implementation
uses
- u_dzMiscUtils;
+ u_dzMiscUtils,
+ u_dzTypes;
var
CacheLineSize: Integer;
@@ -37,6 +126,9 @@
// see
// http://delphitools.info/2011/11/30/fixing-tcriticalsection/
// for an explanation why this could speed up execution on multi core systems
+// NOTE: I can't see see any positive effect in my tests (see tests\SpinLockTest).
+// On the contrary there seems to be a negative effect on some CPUs.
+// It's probably not worth it.
var
InstSize: Integer;
begin
@@ -46,7 +138,7 @@
Result := InitInstance(GetMemory(InstSize));
end;
-{$IFDEF debug_Crit_Sect}
+{$IFDEF DEBUG_CRIT_SECT}
procedure TdzCriticalSection.Acquire;
begin
@@ -61,7 +153,7 @@
if InterlockedDecrement(FLockCount) < 0 then
Assert(FLockCount < 10);
end;
-{$ENDIF debug_Crit_Sect}
+{$ENDIF DEBUG_CRIT_SECT}
{$IF not declared(PSystemLogicalProcessorInformation)}
{$ALIGN ON}
@@ -84,7 +176,7 @@
TCacheDescriptor = record
Level: BYTE;
Associativity: BYTE;
- LineSize: WORD;
+ LineSize: Word;
Size: DWORD;
_Type: PROCESSOR_CACHE_TYPE;
end;
@@ -109,7 +201,7 @@
PSystemLogicalProcessorInformation = ^TSystemLogicalProcessorInformation;
function GetLogicalProcessorInformation(Buffer: PSystemLogicalProcessorInformation; var ReturnedLength: DWORD): BOOL; stdcall;
- external kernel32 name 'GetLogicalProcessorInformation';
+ external kernel32 Name 'GetLogicalProcessorInformation';
{$IFEND}
function GetCacheLineSize: Integer;
@@ -146,7 +238,206 @@
end;
end;
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+{ TdzRTLCriticalSection }
+
+type
+ TInitializeCriticalSectionEx = function(lpCriticalSection: PRTLCriticalSection; _SpinCount: DWORD;
+ _Flags: DWORD): BOOL; stdcall;
+
+var
+ InitializeCriticalSectionEx: TInitializeCriticalSectionEx = nil;
+
+procedure TdzRTLCriticalSection.Init(_SpinCount: DWORD; _WithDebugInfo: Boolean);
+var
+ Flags: DWORD;
+begin
+ if _WithDebugInfo or (_SpinCount <> 0) then begin
+ if _WithDebugInfo then
+ Flags := RTL_CRITICAL_SECTION_FLAG_FORCE_DEBUG_INFO
+ else
+ Flags := CRITICAL_SECTION_NO_DEBUG_INFO;
+ if Assigned(InitializeCriticalSectionEx) then
+ InitializeCriticalSectionEx(PRTLCriticalSection(@Self), _SpinCount, Flags)
+ else
+ InitializeCriticalSectionAndSpinCount(TRTLCriticalSection(Self), _SpinCount)
+ end else
+ InitializeCriticalSection(TRTLCriticalSection(Self));
+end;
+
+procedure TdzRTLCriticalSection.Init(_SpinCount: DWORD);
+begin
+ InitializeCriticalSectionAndSpinCount(TRTLCriticalSection(Self), _SpinCount)
+end;
+
+class function TdzRTLCriticalSection.AllocAndInit(_SpinCount: DWORD;
+ _WithDebugInfo: Boolean): PdzRTLCriticalSection;
+begin
+ GetMem(Result, SizeOf(TdzCriticalSection));
+ Result.Init(_SpinCount, _WithDebugInfo);
+end;
+
+class function TdzRTLCriticalSection.AllocAndInit(_SpinCount: DWORD): PdzRTLCriticalSection;
+begin
+ GetMem(Result, SizeOf(TdzCriticalSection));
+ Result.Init(_SpinCount);
+end;
+
+procedure TdzRTLCriticalSection.DeInitAndFree;
+var
+ SelfPtr: PdzRTLCriticalSection;
+begin
+ DeInit;
+ SelfPtr := @Self;
+ FreeMem(SelfPtr);
+end;
+
+procedure TdzRTLCriticalSection.DeInit;
+begin
+ DeleteCriticalSection(TRTLCriticalSection(Self));
+end;
+
+procedure TdzRTLCriticalSection.Enter;
+begin
+ EnterCriticalSection(TRTLCriticalSection(Self));
+end;
+
+procedure TdzRTLCriticalSection.Leave;
+begin
+ LeaveCriticalSection(TRTLCriticalSection(Self));
+end;
+
+function TdzRTLCriticalSection.SetSpinCount(_SpinCount: DWORD): DWORD;
+begin
+ Result := SetCriticalSectionSpinCount(TRTLCriticalSection(Self), _SpinCount);
+end;
+
+function TdzRTLCriticalSection.TryEnter: Boolean;
+begin
+ Result := TryEnterCriticalSection(TRTLCriticalSection(Self));
+end;
+
+procedure TryInitInitializeCriticalSectionEx;
+var
+ HKernel32: HModule;
+begin
+ HKernel32 := GetModuleHandle(kernel32);
+ InitializeCriticalSectionEx := GetProcAddress(HKernel32, 'InitializeCriticalSectionEx');
+end;
+
+{$IFDEF DEBUG_CRIT_SECT}
+function TdzRTLCriticalSection.GetFlagsFromReserved: TCritSectFlagSet;
+begin
+ Result := [];
+ if (Reserved and CRITICAL_SECTION_NO_DEBUG_INFO) <> 0 then
+ Include(Result, csfNoDebugInfo);
+ if (Reserved and RTL_CRITICAL_SECTION_FLAG_DYNAMIC_SPIN) <> 0 then
+ Include(Result, csfDynamicSpin);
+ if (Reserved and RTL_CRITICAL_SECTION_FLAG_STATIC_INIT) <> 0 then
+ Include(Result, csfStaticInit);
+ if (Reserved and RTL_CRITICAL_SECTION_FLAG_RESOURCE_TPE) <> 0 then
+ Include(Result, csfResourceType);
+ if (Reserved and RTL_CRITICAL_SECTION_FLAG_FORCE_DEBUG_INFO) <> 0 then
+ Include(Result, csfForceDebugInfo);
+end;
+
+function TdzRTLCriticalSection.GetSpinCountFromReserved: DWORD;
+begin
+ Result := Reserved and $00FFFFFF;
+end;
+
+procedure TestTdzRtlCriticalSection;
+var
+ cs: TdzRTLCriticalSection;
+ Flags: TdzRTLCriticalSection.TCritSectFlagSet;
+ Spin: DWORD;
+begin
+ cs.Init(5);
+ try
+ Assert(cs.GetSpinCountFromReserved = 5);
+ Flags := cs.GetFlagsFromReserved;
+ Assert(Flags = []);
+
+ // This seems to disable spinning
+ Spin := cs.SetSpinCount(0);
+ Assert(Spin = 5);
+ Assert(cs.GetSpinCountFromReserved = 0);
+ Flags := cs.GetFlagsFromReserved;
+ Assert(Flags = []);
+ finally
+ cs.DeInit;
+ end;
+
+// this does not work under Windows XP
+// cs.Init;
+// try
+// Assert(cs.GetSpinCountFromReserved = 2000);
+// Flags := cs.GetFlagsFromReserved;
+// Assert(Flags = [csfDynamicSpin]);
+
+ // Apparently setting the spin count does not clear the csfDynamicSpin flag,
+ // so it's questionable whether it is possible whether setting the spin count
+ // actually has any effect at all.
+// Spin := cs.SetSpinCount(5);
+// Assert(Spin = 2000);
+// Assert(cs.GetSpinCountFromReserved = 5);
+// Flags := cs.GetFlagsFromReserved;
+// Assert(Flags = [csfDynamicSpin]);
+//
+// Spin := cs.SetSpinCount(0);
+// Assert(Spin = 5);
+// Assert(cs.GetSpinCountFromReserved = 0);
+// Flags := cs.GetFlagsFromReserved;
+// Assert(Flags = [csfDynamicSpin]);
+// finally
+// cs.DeInit;
+// end;
+
+ cs.Init(5, True);
+ try
+ Assert(cs.GetSpinCountFromReserved = 5);
+ Assert(Uintptr(cs.DebugInfo) <> $FFFFFFFF);
+ Flags := cs.GetFlagsFromReserved;
+ Assert(Flags = []);
+ finally
+ cs.DeInit;
+ end;
+
+// this does not work under Windows XP
+// cs.Init(0, True);
+// try
+// Assert(cs.GetSpinCountFromReserved = 2000);
+// Assert(Uintptr(cs.DebugInfo) <> $FFFFFFFF);
+// Flags := cs.GetFlagsFromReserved;
+// Assert(Flags = [csfDynamicSpin]);
+// finally
+// cs.DeInit;
+// end;
+end;
+{$ENDIF}
+
+// This procedure only exists to prevent compiler warnings for the private fields.
+// It should be eliminated automatically by the linker.
+procedure DummyAccessToCsFields;
+var
+ cs: TdzRTLCriticalSection;
+begin
+ cs.DebugInfo := nil;
+ cs.LockCount := 0;
+ cs.RecursionCount := 0;
+ cs.OwningThread := 0;
+ cs.LockSemaphore := 0;
+ cs.Reserved := 0;
+end;
+{$ENDIF SUPPORTS_ENHANCED_RECORDS}
+
initialization
CacheLineSize := GetCacheLineSize;
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+ Assert(SizeOf(TdzRTLCriticalSection) = SizeOf(TRTLCriticalSection));
+ TryInitInitializeCriticalSectionEx;
+{$IFDEF DEBUG_CRIT_SECT}
+ TestTdzRtlCriticalSection;
+{$ENDIF}
+{$ENDIF SUPPORTS_ENHANCED_RECORDS}
end.
-
Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2021-03-22 07:53:58 UTC (rev 3458)
+++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2021-03-22 07:54:25 UTC (rev 3459)
@@ -1001,6 +1001,14 @@
///<summary>
/// Short for ChangeFileExtLast(_Filename, '') </summary>
class function RemoveFileExtLast(const _Filename: string): string;
+ ///<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,
+ /// Defaults to NIL which uses the current system time.
+ /// @raises EFileNotFound if the file does not exist
+ /// @raises EOsError if there calling the Windows API fails </summary>
+ class procedure TouchFileTimes(const _Filename: string; lpSystemTime: PSystemTime = nil);
end;
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
@@ -1693,6 +1701,29 @@
end;
end;
+function _TouchFileTimes(FileHandle: THandle; lpSystemTime: PSystemTime):
+ BOOL; stdcall; external 'IMAGEHLP.DLL' Name 'TouchFileTimes';
+
+class procedure TFileSystem.TouchFileTimes(const _Filename: string; lpSystemTime: PSystemTime);
+var
+ Handle: THandle;
+ Res: BOOL;
+ LastError: DWORD;
+begin
+ Handle := CreateFile(PChar(_Filename), GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
+ if Handle = INVALID_HANDLE_VALUE then
+ raise EFileNotFound.CreateFmt(_('File not found: "%s"'), [_Filename]);
+ try
+ Res := _TouchFileTimes(Handle, lpSystemTime);
+ if not Res then begin
+ LastError := GetLastError;
+ RaiseLastOSErrorEx(LastError, Format(_('Error %%1:s (%%0:d) while trying to change the date and time of "%s"'), [_Filename]));
+ end;
+ finally
+ CloseHandle(Handle);
+ end;
+end;
+
class function TFileSystem.TryGetFileInfo(const _Filename: string;
out _Info: TFileInfoRec): Boolean;
var
Modified: trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas 2021-03-22 07:53:58 UTC (rev 3458)
+++ trunk/ExternalSource/dzlib/u_dzSelectDirectoryFix.pas 2021-03-22 07:54:25 UTC (rev 3459)
@@ -56,6 +56,38 @@
u_dzTypes,
u_dzVclUtils;
+{$IF Declared(TFileOpenDialog)}
+function dzSelectDirectoryVistaAndUp(const Caption: string; const Root: string; var Directory: string;
+ Options: TSelectDirExtOpts; Parent: TWinControl): Boolean;
+var
+ DlgOptions: TFileDialogOptions;
+ Dlg: TFileOpenDialog;
+begin
+ // _Options will be ignored since there is no equivalent in TFileDialogOptions
+ DlgOptions := [fdoPickFolders, fdoForceFileSystem];
+
+ Dlg := TFileOpenDialog.Create(Parent);
+ try
+ Dlg.Options := DlgOptions;
+ if Caption <> '' then
+ Dlg.Title := Caption;
+ if Directory <> '' then
+ Dlg.DefaultFolder := Directory;
+
+ if Assigned(Parent) then
+ Result := Dlg.Execute(Parent.Handle)
+ else
+ Result := Dlg.Execute;
+
+ if Result then begin
+ Directory := Dlg.FileName;
+ end;
+ finally
+ Dlg.Free;
+ end;
+end;
+{$IFEND}
+
type
TSelectDirCallback = class(TObject)
private
@@ -212,7 +244,7 @@
// This is copied from FileCtrl, mostly unchanged. I removed the WITH statement though.
-function dzSelectDirectory(const Caption: string; const Root: WideString;
+function dzSelectDirectoryXP(const Caption: string; const Root: WideString;
var Directory: string; Options: TSelectDirExtOpts = [sdNewUI]; Parent: TWinControl = nil): Boolean;
{$IF not Declared(BIF_NEWDIALOGSTYLE)}
const
@@ -313,4 +345,18 @@
end;
end;
+function dzSelectDirectory(const Caption: string; const Root: WideString;
+ var Directory: string; Options: TSelectDirExtOpts = [sdNewUI]; Parent: TWinControl = nil): Boolean;
+begin
+{$IF Declared(TFileOpenDialog)}
+ if Win32MajorVersion < 6 then begin
+{$IFEND}
+ Result := dzSelectDirectoryXP(Caption, Root, Directory, Options, Parent);
+{$IF Declared(TFileOpenDialog)}
+ end else begin
+ Result := dzSelectDirectoryVistaAndUp(Caption, Root, Directory, Options, Parent);
+ end;
+{$IFEND}
+end;
+
end.
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2021-03-22 07:53:58 UTC (rev 3458)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2021-03-22 07:54:25 UTC (rev 3459)
@@ -86,6 +86,21 @@
MaxInt32 = $7FFFFFFF;
{$IFEND}
+{$IF not declared(MinInt64)}
+const
+{$IFDEF DELPHI2005_UP}
+ MinInt64 = -$8000000000000000;
+{$ELSE}
+ // for Delphi 6 and 7 we need to increment it by one:
+ MinInt64 = -$7FFFFFFFFFFFFFFF;
+{$ENDIF}
+{$IFEND}
+
+{$IF not declared(MaxInt64)}
+const
+ MaxInt64 = $7FFFFFFFFFFFFFFF;
+{$IFEND}
+
{$IF not declared(MinInt32)}
const
{$IFDEF DELPHI2005_UP}
Modified: trunk/ExternalSource/dzlib/u_dzVersionInfo.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVersionInfo.pas 2021-03-22 07:53:58 UTC (rev 3458)
+++ trunk/ExternalSource/dzlib/u_dzVersionInfo.pas 2021-03-22 07:54:25 UTC (rev 3459)
@@ -182,7 +182,6 @@
uses
Windows,
- Forms,
u_dzTranslator,
u_dzOsUtils;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2021-06-20 13:39:41
|
Revision: 3552
http://sourceforge.net/p/gexperts/code/3552
Author: twm
Date: 2021-06-20 13:39:40 +0000 (Sun, 20 Jun 2021)
Log Message:
-----------
synced with dzlib from OSDN
Modified Paths:
--------------
trunk/ExternalSource/dzlib/u_dzDateUtils.pas
trunk/ExternalSource/dzlib/u_dzFileUtils.pas
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
Modified: trunk/ExternalSource/dzlib/u_dzDateUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzDateUtils.pas 2021-06-20 13:11:41 UTC (rev 3551)
+++ trunk/ExternalSource/dzlib/u_dzDateUtils.pas 2021-06-20 13:39:40 UTC (rev 3552)
@@ -126,6 +126,7 @@
/// (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;
+function Str2DateTime(const _s: string): TDateTime;
{$IFEND}
{$IF Declared(TFormatSettings)}
@@ -448,6 +449,12 @@
Result := False;
end;
end;
+
+function Str2DateTime(const _s: string): TDateTime;
+begin
+ if not TryStr2DateTime(_s, Result) then
+ raise EdzDateUtilsException.CreateFmt(_('Cannot interpret "%s" as a date and time value'), [_s]);
+end;
{$IFEND}
{$IF Declared(TFormatSettings)}
Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2021-06-20 13:11:41 UTC (rev 3551)
+++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2021-06-20 13:39:40 UTC (rev 3552)
@@ -90,6 +90,9 @@
/// number of matching files found
FMatchCount: Integer;
public
+ type
+ TOnEnumCallback = procedure(_Sender: TObject; const _Filename: string) of object;
+ public
/// <summary>
/// Creates a TSimpleDirEnumerator, sets the Mask, MayHaveAttr and MustHaveAttr
/// properties.
@@ -123,6 +126,10 @@
_IncludePath: Boolean = False; _Sort: Boolean = True): Integer; overload;
class function EnumFilesOnly(const _Mask: string;
_IncludePath: Boolean = False; _Sort: Boolean = True): TStringArray; overload;
+ ///<summary>
+ /// Calls the given callback for all files matching the mask. To Abort, raise EAbort. </summary>
+ class procedure EnumFilesOnly(const _Mask: string; _Callback: TOnEnumCallback;
+ _IncludePath: Boolean = False; _Sort: Boolean = True); overload;
/// <summary>
/// creates a TSimpleDirEnumerator, calls its FindAll method and frees it
/// @param List is a string list to which the files will be appended, may be nil
@@ -1060,10 +1067,20 @@
///<summary>
/// Replaces filename, but not extension(s) with the given filename </summary>
procedure ReplaceFilenameOnly(const _FilenameOnly: string);
+ ///<summary>
+ /// Replaces the full extension with the given one.
+ /// @param Extension is the new extension including the leading dot e.g. '.txt' </summary>
procedure ReplaceExtension(const _Extension: string);
///<summary>
- /// Replaces the whole extension with the given array of textensions </summary>
+ /// Replaces the whole extension with the given array of extensions
+ /// Example: ['.bla', '.blub', '.tmp'] will change the extension to '.bla.blub.tmp' </summary>
procedure ReplaceExtensions(const _Extensions: TStringArray);
+ ///<summary>
+ /// Replaces the last extension of the filename with the given one
+ /// @param Extension is the new extension including the leading dot e.g. '.txt'
+ /// Example:
+ /// Given the file name 'c:\bla\file.bla.txt'
+ /// ReplaceLastExtension('.doc') will change the file name to 'c:\bla\file.bla.doc' </summary>
procedure ReplaceLastExtension(const _Extension: string);
///<summary>
/// @returns true, if the filename contains either a drive letter or is a UNC, false otherwise
@@ -1081,7 +1098,7 @@
/// Parts(-2) = 'c:'
/// Parts(<=-3) = ''
/// Note that every call will parse the filename again, so you should buffer this
- /// value if you need it multpile times. If you need all parts, consider using GetParts </summary>
+ /// value if you need it multiple times. If you need all parts, consider using Split </summary>
function Parts(_Depth: Integer): string;
///<summary>
/// Returns the number of parts separated by PathDelim characters.
@@ -1103,6 +1120,8 @@
///<summary>
/// Same as Full </summary>
class operator Implicit(_a: TFilename): string;
+ class operator Add(const _a: TFilename; const _b: string): string;
+ class operator Add(const _a: string; const _b: TFilename): string;
end;
type
@@ -1293,6 +1312,30 @@
end;
end;
+class procedure TSimpleDirEnumerator.EnumFilesOnly(const _Mask: string; _Callback: TOnEnumCallback;
+ _IncludePath: Boolean = False; _Sort: Boolean = True);
+var
+ enum: TSimpleDirEnumerator;
+ List: TStringList;
+ i: Integer;
+begin
+ enum := TSimpleDirEnumerator.CreateForFilesOnly(_Mask);
+ try
+ List := TStringList.Create;
+ try
+ enum.FindAll(List, _IncludePath);
+ if _Sort then
+ List.Sort;
+ for i := 0 to List.Count - 1 do
+ _Callback(enum, List[i]);
+ finally
+ FreeAndNil(List);
+ end;
+ finally
+ FreeAndNil(enum);
+ end;
+end;
+
class function TSimpleDirEnumerator.EnumFilesOnly(const _Mask: string; _IncludePath,
_Sort: Boolean): TStringArray;
var
@@ -1521,6 +1564,7 @@
// I can't be bothered to add lots of ifdefs, so I turn this warning off for the rest of the unit.
{$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}
+
class function TFileSystem.CreateDir(const _DirectoryName: string; _RaiseException: Boolean): Boolean;
begin
Result := Self.CreateDir(_DirectoryName, re2ehe(_RaiseException));
@@ -3252,6 +3296,16 @@
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
{ TFilename }
+class operator TFilename.Add(const _a: TFilename; const _b: string): string;
+begin
+ Result := _a.Full + _b;
+end;
+
+class operator TFilename.Add(const _a: string; const _b: TFilename): string;
+begin
+ Result := _a + _b.Full;
+end;
+
class operator TFilename.Implicit(const _s: string): TFilename;
begin
Result.Init(_s);
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2021-06-20 13:11:41 UTC (rev 3551)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2021-06-20 13:39:40 UTC (rev 3552)
@@ -1516,10 +1516,15 @@
end;
procedure TBitmap_AssignBgr8(_Buffer: PByte; _bmp: TBitmap; _YIsReversed: Boolean);
+const
+ BytesPerPixel = 3;
var
y: Integer;
ScanLine: PdzRgbTripleArray;
- BytesPerLine: Integer;
+ BufferBytesPerLine: Integer;
+ BitmapBytesPerLine: Integer;
+ h: Integer;
+ w: Integer;
// ms: TMemoryStream;
// bfh: TBitmapFileHeader;
// bih: TBitmapInfoHeader;
@@ -1526,8 +1531,14 @@
begin
Assert(_bmp.PixelFormat = pf24bit, 'unexpected PixelFormat (expected pf24bit)');
- BytesPerLine := 3 * _bmp.Width;
+ h := _bmp.Height;
+ w := _bmp.Width;
+ BufferBytesPerLine := BytesPerPixel * w;
+
+ BitmapBytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BitmapBytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
// bfh.bfType := $4D42; // 'BM'
// bfh.bfSize := BytesPerLine * _Bmp.Height;
// bfh.bfReserved1 := 0;
@@ -1554,14 +1565,15 @@
// So we can only copy the whole picture in one go, if the buffer is also upside down
// (many cameras have this feature). If not, we have to copy it one line at a time.
if _YIsReversed then begin
- ScanLine := _bmp.ScanLine[_bmp.Height - 1];
- Move(_Buffer^, ScanLine^, _bmp.Height * BytesPerLine);
+ ScanLine := _bmp.ScanLine[h - 1];
+ Move(_Buffer^, ScanLine^, h * BufferBytesPerLine);
end else begin
// At least with GBR8 the bytes have the right order so we can copy the whole line in one go
- for y := 0 to _bmp.Height - 1 do begin
- ScanLine := _bmp.ScanLine[y];
- Move(_Buffer^, ScanLine^, BytesPerLine);
- Inc(_Buffer, BytesPerLine);
+ ScanLine := _bmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Move(_Buffer^, ScanLine^, BufferBytesPerLine);
+ Inc(_Buffer, BufferBytesPerLine);
+ Dec(PByte(ScanLine), BitmapBytesPerLine);
end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
Thanks for helping keep SourceForge clean.
X