Menu
▾
▴
[GExperts-Checkins] SF.net SVN: gexperts:[4046] trunk/ExternalSource/dzlib
|
From: <tw...@us...> - 2023-08-03 12:58:48
|
Revision: 4046
http://sourceforge.net/p/gexperts/code/4046
Author: twm
Date: 2023-08-03 12:58:46 +0000 (Thu, 03 Aug 2023)
Log Message:
-----------
updated to latest version from dzlib
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzClassUtils.pas
trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
trunk/ExternalSource/dzlib/u_dzFileUtils.pas
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
trunk/ExternalSource/dzlib/u_dzStringUtils.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2023-07-17 14:35:43 UTC (rev 4045)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2023-08-03 12:58:46 UTC (rev 4046)
@@ -75,6 +75,7 @@
// AHandle is declared as THandle (otherwise it's an Integer)
{$DEFINE THANDLESTREAM_CREATE_HANDLE_IS_THANDLE}
{$DEFINE MAXLISTSIZE_IS_DEPRECATED}
+{$DEFINE TTHREAD_HAS_START}
{$ENDIF}
{$IFDEF DELPHIX_SEATTLE_UP}
Modified: trunk/ExternalSource/dzlib/u_dzClassUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2023-07-17 14:35:43 UTC (rev 4045)
+++ trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2023-08-03 12:58:46 UTC (rev 4046)
@@ -333,6 +333,9 @@
///<summary>
/// Reads a string from the ini-file, raises an exception if the value is empty </summary>
function TIniFile_ReadString(_Ini: TCustomIniFile; const _Section, _Ident: string): string; overload;
+///<summary>
+/// Reads a string from the ini-file, raises an exception if the value is empty </summary>
+function TIniFile_ReadString(const _Filename: string; const _Section, _Ident: string): string; overload;
///<summary>
/// Writes a string to the ini-file. </summary>
@@ -1275,6 +1278,18 @@
end;
end;
+function TIniFile_ReadString(const _Filename: string; const _Section, _Ident: string): string;
+var
+ Ini: TMemIniFile;
+begin
+ Ini := TMemIniFile.Create(_Filename);
+ try
+ Result := TIniFile_ReadString(Ini, _Section, _Ident);
+ finally
+ FreeAndNil(Ini);
+ end;
+end;
+
procedure TIniFile_WriteString(const _Filename: string; const _Section, _Ident, _Value: string);
var
Ini: TMemIniFile;
Modified: trunk/ExternalSource/dzlib/u_dzConvertUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2023-07-17 14:35:43 UTC (rev 4045)
+++ trunk/ExternalSource/dzlib/u_dzConvertUtils.pas 2023-08-03 12:58:46 UTC (rev 4046)
@@ -37,7 +37,11 @@
EStringConvertError = class(EdzConvert);
type
- ULong = LongWord;
+{$IFDEF DELPHI2005_UP}
+ ULong = LongWord deprecated; // use UInt32
+{$ELSE}
+ ULong = LongWord; // use UInt32
+{$ENDIF}
type
TBaseN = 2..36;
@@ -68,36 +72,36 @@
///<summary>
/// Converts a decimal digit to its number equivalent
/// @Raises EDigitOutOfRange if there is an invalid digit. </summary>
-function DecDigit2Long(_a: Char): ULong; overload;
+function DecDigit2Long(_a: Char): UInt32; overload;
{$IFDEF unicode}
-function DecDigit2Long(_a: AnsiChar): ULong; overload;
+function DecDigit2Long(_a: AnsiChar): UInt32; overload;
{$ENDIF}
///<summary>
/// Converts a string representing a positive decimal number to a number
/// @Raises EDigitOutOfRange if there is an invalid digit. </summary>
-function Dec2Long(const _s: string): ULong; overload;
+function Dec2Long(const _s: string): UInt32; overload;
{$IFDEF unicode}
-function Dec2Long(const _s: AnsiString): ULong; overload;
+function Dec2Long(const _s: AnsiString): UInt32; overload;
{$ENDIF}
-function TryDec2Long(const _s: string; out _l: ULong): Boolean; overload;
+function TryDec2Long(const _s: string; out _l: UInt32): Boolean; overload;
{$IFDEF unicode}
-function TryDec2Long(const _s: AnsiString; out _l: ULong): Boolean; overload;
+function TryDec2Long(const _s: AnsiString; out _l: UInt32): Boolean; overload;
{$ENDIF}
///<summary>
/// Converts a positive number to its 2 digit decimal representation (left pads with '0') </summary>
-function Long2Dec2(_l: ULong): string;
+function Long2Dec2(_l: UInt32): string;
///<summary>
/// Converts a positive number to its 4 digit decimal representation (left pads with '0') </summary>
-function Long2Dec4(_l: ULong): string;
+function Long2Dec4(_l: UInt32): string;
///<summary>
/// Converts a positive number to its N digit decimal representation (left pads with '0') </summary>
-function Long2DecN(_l: ULong; _n: ULong): string;
+function Long2DecN(_l: UInt32; _n: UInt32): string;
///<summary>
/// Converts a positive number to its decimal representation </summary>
-function Long2Dec(_l: ULong): string;
-function Long2DecA(_l: ULong): AnsiString;
+function Long2Dec(_l: UInt32): string;
+function Long2DecA(_l: UInt32): AnsiString;
// Str <-> Hex conversion
///<summary>
@@ -113,26 +117,26 @@
///<summary>
/// Converts a string representing a hexadecimal number to a number
/// @Raises EDigitOutOfRange if there is an invalid digit. </summary>
-function Hex2Long(const _s: string): ULong;
+function Hex2Long(const _s: string): UInt32;
///<summary>
/// Tries to interpret the string as the hexadecimal interpretation of a number and
/// returns the value.
/// @value is the converted value, only valid it result = true
/// @returns true, if the string could be converted, false otherwise </summary>
-function TryHex2Long(const _s: string; out _Value: ULong): Boolean;
+function TryHex2Long(const _s: string; out _Value: UInt32): Boolean;
///<summary>
/// Converts a number to its hexadecimal representation </summary>
-function Long2Hex(_l: ULong): string;
+function Long2Hex(_l: UInt32): string;
///<summary>
/// converts a number to its hexadecimal representation left padding with 0 to a length of 2 </summary>
-function Long2Hex2(_l: ULong): string;
+function Long2Hex2(_l: UInt32): string;
///<summary>
/// converts a number to its hexadecimal representation left padding with 0 to a length of 4 </summary>
-function Long2Hex4(_l: ULong): string;
+function Long2Hex4(_l: UInt32): string;
///<summary>
/// converts a number to its hexadecimal representation left padding with 0 to a length of Digits </summary>
-function Long2HexN(_l: ULong; _Digits: Byte): string;
+function Long2HexN(_l: UInt32; _Digits: Byte): string;
// Str <-> any numeric system conversion up to Base36 (that is digits 0..Z)
///<summary>
@@ -148,24 +152,24 @@
///<summary>
/// Converts a Base digit to its number equivalent.
/// @Raises EDigitOutOfRange if there is an invalid digit. </summary>
-function Digit2Long(_a: Char; _Base: TBaseN): ULong;
+function Digit2Long(_a: Char; _Base: TBaseN): UInt32;
///<summary>
/// Converts a string representing a number in Base to a number.
/// @Raises EDigitOutOfRange if there is an invalid digit. </summary>
-function Num2Long(const _s: string; _Base: TBaseN): ULong;
+function Num2Long(const _s: string; _Base: TBaseN): UInt32;
///<summary>
/// Tries to convert a string representing a number in Base to a number.
/// @Value contains the converted number, only valid if Result = true
/// @returns true, if the conversion succeeds, false otherwise. </summary>
-function TryNum2Long(const _s: string; _Base: TBaseN; out _Value: ULong): Boolean; overload;
+function TryNum2Long(const _s: string; _Base: TBaseN; out _Value: UInt32): Boolean; overload;
{$IFDEF unicode}
-function TryNum2Long(const _s: AnsiString; _Base: TBaseN; out _Value: ULong): Boolean; overload;
+function TryNum2Long(const _s: AnsiString; _Base: TBaseN; out _Value: UInt32): Boolean; overload;
{$ENDIF}
///<summary>
/// Converts a number to its Base representation. </summary>
-function Long2Num(_l: ULong; _Base: Byte; _MinWidth: Integer = 1): string;
+function Long2Num(_l: UInt32; _Base: Byte; _MinWidth: Integer = 1): string;
///<summary>
/// Returns the number of characters in S that are valid digits in the given Base. </summary>
function isNumberN(const _s: string; _Base: TBaseN): Integer;
@@ -222,7 +226,10 @@
///<summary>
/// Does the same as TryStrToInt but does not change Value if the string cannot be converted. </summary>
-function TryStr2Int(const _s: string; var _Value: Integer): Boolean;
+function TryStr2Int(const _s: string; var _Value: Integer): Boolean; overload;
+{$IFDEF SUPPORTS_UNICODE}
+function TryStr2Int(const _s: AnsiString; var _Value: Integer): Boolean; overload;
+{$ENDIF SUPPORTS_UNICODE}
///<summary>
/// Converts a string to an int64.
@@ -440,7 +447,56 @@
function Bool2Str(_b: Boolean): string;
type
+ TBitNumber64 = 0..63;
+ TByteNumber64 = 0..7;
+
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+type
+ ///<summary>
+ /// Stores up to 64 bits similar to the Delphi TBits class but
+ /// as a record, so it does not need a destructor </summary>
+ TBits64 = record
+ public
+ type
+ TBitNumber = TBitNumber64;
+ TByteNumber = TByteNumber64;
+ TValue = UInt64;
+ const
+ Low = 0;
+ Bits = 64;
+ High = Bits - 1;
+ private
+ // unfortunately Delphi 2007 does not allow us to use TValue here
+ FValue: UInt64;
+ public
+ class function Create(_Value: TValue): TBits64; static;
+ class function AllSet: TBits64; static;
+ class function NoneSet: TBits64; static;
+ procedure Init(_Value: TValue);
+ function IsBitSet(_BitNo: TBitNumber): Boolean;
+ procedure SetBit(_BitNo: TBitNumber; _BitValue: Boolean);
+ ///<summary>
+ /// interpret the given bit range as an integer and return it </summary>
+ function Extract(_BitFirst, _BitLast: TBitNumber): TValue;
+ ///<summary>
+ /// Overwrite the given bit range with the given value (reverse of Extract) </summary>
+ procedure Overwrite(_BitFirst, _BitLast: TBitNumber; _Value: TValue);
+ function Value: TValue;
+ function GetByte(_ByteNo: TByteNumber): Byte;
+ procedure SetByte(_ByteNo: TByteNumber; _Value: Byte);
+ function AsString: string;
+ class operator BitwiseAnd(_a, _b: TBits64): TBits64;
+ class operator BitwiseOr(_a, _b: TBits64): TBits64;
+ class operator BitwiseXor(_a, _b: TBits64): TBits64;
+ // There is no BitwiseNot operator, but the LogicalNot also works
+ class operator LogicalNot(_a: TBits64): TBits64;
+ class operator Equal(_a, _b: TBits64): Boolean;
+ end;
+{$ENDIF}
+
+type
TBitNumber32 = 0..31;
+ TByteNumber32 = 0..3;
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
type
@@ -448,26 +504,47 @@
/// Stores up to 32 bits similar to the Delphi TBits class but
/// as a record, so it does not need a destructor </summary>
TBits32 = record
+ public
+ type
+ TBitNumber = TBitNumber32;
+ TByteNumber = TByteNumber32;
+ TValue = UInt32;
+ const
+ Low = 0;
+ Bits = 32;
+ High = Bits - 1;
private
- FValue: LongWord;
+ // unfortunately Delphi 2007 does not allow us to use TValue here
+ FValue: UInt32;
public
- class function Create(_Value: LongWord): TBits32; static;
- procedure Init(_Value: LongWord);
- function IsBitSet(_BitNo: TBitNumber32): Boolean;
- procedure SetBit(_BitNo: TBitNumber32; _BitValue: Boolean);
+ class function Create(_Value: TValue): TBits32; static;
+ class function AllSet: TBits32; static;
+ class function NoneSet: TBits32; static;
+ procedure Init(_Value: TValue);
+ function IsBitSet(_BitNo: TBitNumber): Boolean;
+ procedure SetBit(_BitNo: TBitNumber; _BitValue: Boolean);
///<summary>
/// interpret the given bit range as an integer and return it </summary>
- function Extract(_BitFirst, _BitLast: TBitNumber32): LongWord;
+ function Extract(_BitFirst, _BitLast: TBitNumber): TValue;
///<summary>
/// Overwrite the given bit range with the given value (reverse of Extract) </summary>
- procedure Overwrite(_BitFirst, _BitLast: TBitNumber32; _Value: LongWord);
- function Value: Cardinal;
+ procedure Overwrite(_BitFirst, _BitLast: TBitNumber; _Value: TValue);
+ function Value: TValue;
+ function GetByte(_ByteNo: TByteNumber): Byte;
+ procedure SetByte(_ByteNo: TByteNumber; _Value: Byte);
function AsString: string;
+ class operator BitwiseAnd(_a, _b: TBits32): TBits32;
+ class operator BitwiseOr(_a, _b: TBits32): TBits32;
+ class operator BitwiseXor(_a, _b: TBits32): TBits32;
+ // There is no BitwiseNot operator, but the LogicalNot also works
+ class operator LogicalNot(_a: TBits32): TBits32;
+ class operator Equal(_a, _b: TBits32): Boolean;
end;
{$ENDIF}
type
TBitNumber16 = 0..15;
+ TByteNumber16 = 0..1;
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
type
@@ -475,21 +552,35 @@
/// Stores up to 16 bits similar to the Delphi TBits class but
/// as a record, so it does not need a destructor </summary>
TBits16 = record
+ public
+ type
+ TBitNumber = TBitNumber16;
+ TByteNumber = TByteNumber16;
+ TValue = UInt16;
+ const
+ Low = 0;
+ Bits = 16;
+ High = Bits - 1;
private
- FValue: Word;
+ // unfortunately Delphi 2007 does not allow us to use TValue here
+ FValue: UInt16;
public
- class function Create(_Value: Word): TBits16; static;
- procedure Init(_Value: Word);
- function IsBitSet(_BitNo: TBitNumber16): Boolean;
+ class function Create(_Value: TValue): TBits16; static;
+ class function AllSet: TBits16; static;
+ class function NoneSet: TBits16; static;
+ procedure Init(_Value: TValue);
+ function IsBitSet(_BitNo: TBitNumber): Boolean;
function IsAnyBitSet: Boolean;
- procedure SetBit(_BitNo: TBitNumber16; _BitValue: Boolean);
+ procedure SetBit(_BitNo: TBitNumber; _BitValue: Boolean);
///<summary>
/// interpret the given bit range as an integer and return it </summary>
- function Extract(_BitFirst, _BitLast: TBitNumber16): Word;
+ function Extract(_BitFirst, _BitLast: TBitNumber): TValue;
///<summary>
/// Overwrite the given bit range with the given value (reverse of Extract) </summary>
- procedure Overwrite(_BitFirst, _BitLast: TBitNumber16; _Value: Word);
- function Value: Word;
+ procedure Overwrite(_BitFirst, _BitLast: TBitNumber; _Value: TValue);
+ function Value: TValue;
+ function GetByte(_ByteNo: TByteNumber): Byte;
+ procedure SetByte(_ByteNo: TByteNumber; _Value: Byte);
function AsString: string;
class operator BitwiseAnd(_a, _b: TBits16): TBits16;
class operator BitwiseOr(_a, _b: TBits16): TBits16;
@@ -496,11 +587,12 @@
class operator BitwiseXor(_a, _b: TBits16): TBits16;
// There is no BitwiseNot operator, but the LogicalNot also works
class operator LogicalNot(_a: TBits16): TBits16;
+ class operator Equal(_a, _b: TBits16): Boolean;
end;
{$ENDIF}
type
- TBitNumber8 = 0..8;
+ TBitNumber8 = 0..7;
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
type
///<summary>
@@ -507,15 +599,35 @@
/// Stores up to 8 bits similar to the Delphi TBits class but
/// as a record, so it does not need a destructor </summary>
TBits8 = record
+ public
+ type
+ TBitNumber = TBitNumber8;
+ TByteNumber = 0..0;
+ TValue = UInt8;
+ const
+ Low = 0;
+ Bits = 8;
+ High = Bits - 1;
private
- FValue: Byte;
+ // unfortunately Delphi 2007 does not allow us to use TValue here
+ FValue: UInt8;
public
- class function Create(_Value: Byte): TBits8; static;
- procedure Init(_Value: Byte);
- function IsBitSet(_BitNo: TBitNumber8): Boolean;
+ class function Create(_Value: TValue): TBits8; static;
+ class function AllSet: TBits8; static;
+ class function NoneSet: TBits8; static;
+ procedure Init(_Value: TValue);
+ function IsBitSet(_BitNo: TBitNumber): Boolean;
function IsAnyBitSet: Boolean;
- procedure SetBit(_BitNo: TBitNumber8; _BitValue: Boolean);
- function Value: Byte;
+ procedure SetBit(_BitNo: TBitNumber; _BitValue: Boolean);
+ ///<summary>
+ /// interpret the given bit range as an integer and return it </summary>
+ function Extract(_BitFirst, _BitLast: TBitNumber): TValue;
+ ///<summary>
+ /// Overwrite the given bit range with the given value (reverse of Extract) </summary>
+ procedure Overwrite(_BitFirst, _BitLast: TBitNumber; _Value: TValue);
+ function Value: TValue;
+ function GetByte(_ByteNo: TByteNumber): Byte;
+ procedure SetByte(_ByteNo: TByteNumber; _Value: Byte);
function AsString: string;
// according to the documentation:
// > For a logical operator and a bitwise operator using the same symbol,
@@ -530,6 +642,7 @@
class operator BitwiseXor(_a, _b: TBits8): TBits8;
// There is no BitwiseNot operator, but the LogicalNot also works
class operator LogicalNot(_a: TBits8): TBits8;
+ class operator Equal(_a, _b: TBits8): Boolean;
end;
{$ENDIF}
{ TODO -otwm :
@@ -596,7 +709,7 @@
Inc(Result);
end;
-function Digit2Long(_a: Char; _Base: TBaseN): ULong;
+function Digit2Long(_a: Char; _Base: TBaseN): UInt32;
begin
Result := Pos(UpCase(_a), LeftStr(DIGIT_CHARS, _Base));
if Result = 0 then
@@ -604,7 +717,7 @@
Dec(Result);
end;
-function Num2Long(const _s: string; _Base: TBaseN): ULong;
+function Num2Long(const _s: string; _Base: TBaseN): UInt32;
var
i: Integer;
begin
@@ -611,12 +724,12 @@
Result := 0;
for i := 1 to Length(_s) do
if isDigit(_s[i], _Base) then
- Result := (Result * _Base + ULong(Pos(UpCase(_s[i]), DIGIT_CHARS)) - 1)
+ Result := (Result * _Base + UInt32(Pos(UpCase(_s[i]), DIGIT_CHARS)) - 1)
else
raise EDigitOutOfRange.CreateFmt(_('Digit #%d (%s) out of range'), [i, _s[i]]);
end;
-function TryNum2Long(const _s: string; _Base: TBaseN; out _Value: ULong): Boolean;
+function TryNum2Long(const _s: string; _Base: TBaseN; out _Value: UInt32): Boolean;
var
i: Integer;
begin
@@ -624,7 +737,7 @@
_Value := 0;
for i := 1 to Length(_s) do begin
if isDigit(_s[i], _Base) then
- _Value := (_Value * _Base + ULong(Pos(UpCase(_s[i]), DIGIT_CHARS)) - 1)
+ _Value := (_Value * _Base + UInt32(Pos(UpCase(_s[i]), DIGIT_CHARS)) - 1)
else begin
Exit;
end;
@@ -633,7 +746,7 @@
end;
{$IFDEF unicode}
-function TryNum2Long(const _s: AnsiString; _Base: TBaseN; out _Value: ULong): Boolean;
+function TryNum2Long(const _s: AnsiString; _Base: TBaseN; out _Value: UInt32): Boolean;
var
i: Integer;
begin
@@ -641,7 +754,7 @@
_Value := 0;
for i := 1 to Length(_s) do begin
if isDigit(_s[i], _Base) then
- _Value := (_Value * _Base + ULong(Pos(string(UpCase(_s[i])), DIGIT_CHARS)) - 1)
+ _Value := (_Value * _Base + UInt32(Pos(string(UpCase(_s[i])), DIGIT_CHARS)) - 1)
else begin
Exit;
end;
@@ -650,7 +763,7 @@
end;
{$ENDIF}
-function Long2Num(_l: ULong; _Base: Byte; _MinWidth: Integer = 1): string;
+function Long2Num(_l: UInt32; _Base: Byte; _MinWidth: Integer = 1): string;
var
m: Byte;
begin
@@ -753,28 +866,28 @@
Result := Digit2Long(_a, 16);
end;
-function Hex2Long(const _s: string): ULong;
+function Hex2Long(const _s: string): UInt32;
begin
Result := Num2Long(_s, 16);
end;
-function TryHex2Long(const _s: string; out _Value: ULong): Boolean;
+function TryHex2Long(const _s: string; out _Value: UInt32): Boolean;
begin
Result := TryNum2Long(_s, 16, _Value);
end;
-function Long2Hex(_l: ULong): string;
+function Long2Hex(_l: UInt32): string;
begin
Result := Long2Num(_l, 16);
end;
-function Long2HexN(_l: ULong; _Digits: Byte): string;
+function Long2HexN(_l: UInt32; _Digits: Byte): string;
begin
Result := Long2Hex(_l);
Result := StringOfChar('0', _Digits - Length(Result)) + Result;
end;
-function Long2Hex2(_l: ULong): string;
+function Long2Hex2(_l: UInt32): string;
begin
Result := Long2Hex(_l);
if Length(Result) < 2 then
@@ -781,7 +894,7 @@
Result := '0' + Result;
end;
-function Long2Hex4(_l: ULong): string;
+function Long2Hex4(_l: UInt32): string;
var
Len: Integer;
begin
@@ -815,19 +928,19 @@
end;
{$ENDIF}
-function DecDigit2Long(_a: Char): ULong;
+function DecDigit2Long(_a: Char): UInt32;
begin
Result := Digit2Long(_a, 10);
end;
{$IFDEF unicode}
-function DecDigit2Long(_a: AnsiChar): ULong;
+function DecDigit2Long(_a: AnsiChar): UInt32;
begin
Result := Digit2Long(Char(_a), 10);
end;
{$ENDIF}
-function Dec2Long(const _s: string): ULong;
+function Dec2Long(const _s: string): UInt32;
var
c: Char;
i: Integer;
@@ -840,7 +953,7 @@
end;
{$IFDEF unicode}
-function Dec2Long(const _s: AnsiString): ULong; overload;
+function Dec2Long(const _s: AnsiString): UInt32; overload;
var
c: AnsiChar;
i: Integer;
@@ -853,19 +966,19 @@
end;
{$ENDIF}
-function TryDec2Long(const _s: string; out _l: ULong): Boolean;
+function TryDec2Long(const _s: string; out _l: UInt32): Boolean;
begin
Result := TryNum2Long(_s, 10, _l);
end;
{$IFDEF unicode}
-function TryDec2Long(const _s: AnsiString; out _l: ULong): Boolean;
+function TryDec2Long(const _s: AnsiString; out _l: UInt32): Boolean;
begin
Result := TryNum2Long(_s, 10, _l);
end;
{$ENDIF}
-function Long2Dec(_l: ULong): string;
+function Long2Dec(_l: UInt32): string;
var
s: AnsiString;
begin
@@ -873,26 +986,26 @@
Result := string(s);
end;
-function Long2DecA(_l: ULong): AnsiString;
+function Long2DecA(_l: UInt32): AnsiString;
begin
Str(_l, Result);
end;
-function Long2Dec2(_l: ULong): string;
+function Long2Dec2(_l: UInt32): string;
begin
Result := Long2DecN(_l, 2);
end;
-function Long2Dec4(_l: ULong): string;
+function Long2Dec4(_l: UInt32): string;
begin
Result := Long2DecN(_l, 4);
end;
-function Long2DecN(_l: ULong; _n: ULong): string;
+function Long2DecN(_l: UInt32; _n: UInt32): string;
begin
Result := Long2Dec(_l);
- if ULong(Length(Result)) < _n then
- Insert(DupeString('0', _n - ULong(Length(Result))), Result, 1);
+ if UInt32(Length(Result)) < _n then
+ Insert(DupeString('0', _n - UInt32(Length(Result))), Result, 1);
end;
function TimeToSeconds(_Zeit: TDateTime): Integer;
@@ -1046,6 +1159,13 @@
_Value := v;
end;
+{$IFDEF SUPPORTS_UNICODE}
+function TryStr2Int(const _s: AnsiString; var _Value: Integer): Boolean;
+begin
+ Result := TryStr2Int(string(_s), _Value);
+end;
+{$ENDIF SUPPORTS_UNICODE}
+
function Str2Int64(const _s: string; _Default: Int64): Int64;
var
e: Integer;
@@ -1274,26 +1394,169 @@
end;
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+
+{ TBits64 }
+
+class function TBits64.Create(_Value: TValue): TBits64;
+begin
+ Result.Init(_Value);
+end;
+
+class function TBits64.AllSet: TBits64;
+begin
+ Result.Init($FFFFFFFFFFFFFFFF);
+end;
+
+class function TBits64.NoneSet: TBits64;
+begin
+ Result.Init(0);
+end;
+
+procedure TBits64.Init(_Value: TValue);
+begin
+ FValue := _Value;
+end;
+
+type
+ TLoHi64 = packed record
+ Lo: UInt32;
+ Hi: UInt32;
+ end;
+
+function TBits64.IsBitSet(_BitNo: TBitNumber): Boolean;
+var
+ LoHi: TLoHi64 absolute FValue;
+begin
+ // shl only supports 32 bits
+ if _BitNo > 31 then begin
+ Result := ((LoHi.Hi and (1 shl (_BitNo - 32))) <> 0);
+ end else begin
+ Result := ((LoHi.Lo and (1 shl _BitNo)) <> 0);
+ end;
+end;
+
+procedure TBits64.SetBit(_BitNo: TBitNumber; _BitValue: Boolean);
+var
+ LoHi: TLoHi64 absolute FValue;
+begin
+ // shl only supports 32 bits
+ if _BitNo > 31 then begin
+ if _BitValue then
+ LoHi.Hi := LoHi.Hi or (1 shl (_BitNo - 32))
+ else
+ LoHi.Hi := LoHi.Hi and not (1 shl (_BitNo - 32));
+ end else begin
+ if _BitValue then
+ LoHi.Lo := LoHi.Lo or (1 shl _BitNo)
+ else
+ LoHi.Lo := LoHi.Lo and not (1 shl _BitNo);
+ end;
+end;
+
+function TBits64.Extract(_BitFirst, _BitLast: TBitNumber): TValue;
+var
+ i: TBitNumber;
+begin
+ Result := 0;
+ for i := _BitLast downto _BitFirst do begin
+ Result := Result shl 1;
+ if IsBitSet(i) then
+ Result := Result + 1;
+ end;
+end;
+
+procedure TBits64.Overwrite(_BitFirst, _BitLast: TBitNumber; _Value: TValue);
+var
+ i: TBitNumber;
+begin
+ for i := _BitFirst to _BitLast do begin
+ SetBit(i, (_Value and TValue(1)) <> 0);
+ _Value := _Value shr 1;
+ end;
+end;
+
+function TBits64.Value: TValue;
+begin
+ Result := FValue;
+end;
+
+type
+ TByteArr8 = array[TByteNumber64] of Byte;
+
+function TBits64.GetByte(_ByteNo: TByteNumber): Byte;
+var
+ Bytes: TByteArr8 absolute FValue;
+begin
+ Result := Bytes[_byteNo];
+end;
+
+procedure TBits64.SetByte(_ByteNo: TByteNumber; _Value: Byte);
+var
+ Bytes: TByteArr8 absolute FValue;
+begin
+ Bytes[_ByteNo] := _Value;
+end;
+
+function TBits64.AsString: string;
+var
+ i: Integer;
+begin
+ Result := DupeString('0', Bits);
+ for i := High downto Low do
+ if IsBitSet(i) then
+ Result[Bits - i] := '1';
+end;
+
+class operator TBits64.BitwiseAnd(_a, _b: TBits64): TBits64;
+begin
+ Result.Init(_a.Value and _b.Value);
+end;
+
+class operator TBits64.LogicalNot(_a: TBits64): TBits64;
+begin
+ Result.Init(_a.Value xor $FF);
+end;
+
+class operator TBits64.BitwiseOr(_a, _b: TBits64): TBits64;
+begin
+ Result.Init(_a.Value or _b.Value);
+end;
+
+class operator TBits64.BitwiseXor(_a, _b: TBits64): TBits64;
+begin
+ Result.Init(_a.Value xor _b.Value);
+end;
+
+class operator TBits64.Equal(_a, _b: TBits64): Boolean;
+begin
+ Result := _a.Value = _b.Value;
+end;
+
{ TBits32 }
+class function TBits32.AllSet: TBits32;
+begin
+ Result.Init($FFFFFFFF);
+end;
+
function TBits32.AsString: string;
var
i: Integer;
begin
- Result := DupeString('0', 32);
- for i := 31 downto 0 do
+ Result := DupeString('0', Bits);
+ for i := High downto Low do
if IsBitSet(i) then
- Result[32 - i] := '1';
+ Result[Bits - i] := '1';
end;
-class function TBits32.Create(_Value: LongWord): TBits32;
+class function TBits32.Create(_Value: TValue): TBits32;
begin
Result.Init(_Value);
end;
-function TBits32.Extract(_BitFirst, _BitLast: TBitNumber32): LongWord;
+function TBits32.Extract(_BitFirst, _BitLast: TBitNumber): TValue;
var
- i: TBitNumber32;
+ i: TBitNumber;
begin
Result := 0;
for i := _BitLast downto _BitFirst do begin
@@ -1303,9 +1566,14 @@
end;
end;
-procedure TBits32.Overwrite(_BitFirst, _BitLast: TBitNumber32; _Value: LongWord);
+class function TBits32.NoneSet: TBits32;
+begin
+ Result.Init(0);
+end;
+
+procedure TBits32.Overwrite(_BitFirst, _BitLast: TBitNumber; _Value: TValue);
var
- i: TBitNumber32;
+ i: TBitNumber;
begin
for i := _BitFirst to _BitLast do begin
SetBit(i, (_Value and $00000001) <> 0);
@@ -1313,17 +1581,28 @@
end;
end;
-procedure TBits32.Init(_Value: LongWord);
+function TBits32.GetByte(_ByteNo: TByteNumber): Byte;
begin
+ Result := (FValue shr (_ByteNo * 8)) and $FF;
+end;
+
+procedure TBits32.SetByte(_ByteNo: TByteNumber; _Value: Byte);
+begin
+ _ByteNo := _ByteNo * 8;
+ FValue := FValue and ($FFFFFFFF xor ($FF shl _ByteNo)) or (_Value shl _ByteNo);
+end;
+
+procedure TBits32.Init(_Value: TValue);
+begin
FValue := _Value;
end;
-function TBits32.IsBitSet(_BitNo: TBitNumber32): Boolean;
+function TBits32.IsBitSet(_BitNo: TBitNumber): Boolean;
begin
Result := ((FValue and (1 shl _BitNo)) <> 0);
end;
-procedure TBits32.SetBit(_BitNo: TBitNumber32; _BitValue: Boolean);
+procedure TBits32.SetBit(_BitNo: TBitNumber; _BitValue: Boolean);
begin
if _BitValue then
FValue := FValue or (1 shl _BitNo)
@@ -1331,29 +1610,59 @@
FValue := FValue and not (1 shl _BitNo);
end;
-function TBits32.Value: LongWord;
+function TBits32.Value: TValue;
begin
Result := FValue;
end;
+class operator TBits32.BitwiseAnd(_a, _b: TBits32): TBits32;
+begin
+ Result.Init(_a.Value and _b.Value);
+end;
+
+class operator TBits32.LogicalNot(_a: TBits32): TBits32;
+begin
+ Result.Init(_a.Value xor $FF);
+end;
+
+class operator TBits32.BitwiseOr(_a, _b: TBits32): TBits32;
+begin
+ Result.Init(_a.Value or _b.Value);
+end;
+
+class operator TBits32.BitwiseXor(_a, _b: TBits32): TBits32;
+begin
+ Result.Init(_a.Value xor _b.Value);
+end;
+
+class operator TBits32.Equal(_a, _b: TBits32): Boolean;
+begin
+ Result := _a.Value = _b.Value;
+end;
+
{ TBits16 }
+class function TBits16.AllSet: TBits16;
+begin
+ Result.Init($FFFF);
+end;
+
function TBits16.AsString: string;
var
i: Integer;
begin
- Result := DupeString('0', 8);
- for i := 7 downto 0 do
+ Result := DupeString('0', Bits);
+ for i := High downto Low do
if IsBitSet(i) then
- Result[8 - i] := '1';
+ Result[Bits - i] := '1';
end;
-class function TBits16.Create(_Value: Word): TBits16;
+class function TBits16.Create(_Value: TValue): TBits16;
begin
Result.Init(_Value);
end;
-procedure TBits16.Init(_Value: Word);
+procedure TBits16.Init(_Value: TValue);
begin
FValue := _Value;
end;
@@ -1363,7 +1672,7 @@
Result := FValue <> 0;
end;
-function TBits16.IsBitSet(_BitNo: TBitNumber16): Boolean;
+function TBits16.IsBitSet(_BitNo: TBitNumber): Boolean;
begin
Result := ((FValue and (1 shl _BitNo)) <> 0);
end;
@@ -1388,9 +1697,9 @@
Result.Init(_a.Value xor _b.Value);
end;
-function TBits16.Extract(_BitFirst, _BitLast: TBitNumber16): Word;
+function TBits16.Extract(_BitFirst, _BitLast: TBitNumber): TValue;
var
- i: TBitNumber16;
+ i: TBitNumber;
begin
Result := 0;
for i := _BitLast downto _BitFirst do begin
@@ -1400,17 +1709,22 @@
end;
end;
-procedure TBits16.Overwrite(_BitFirst, _BitLast: TBitNumber16; _Value: Word);
+class function TBits16.NoneSet: TBits16;
+begin
+ Result.Init(0);
+end;
+
+procedure TBits16.Overwrite(_BitFirst, _BitLast: TBitNumber; _Value: TValue);
var
- i: TBitNumber16;
+ i: TBitNumber;
begin
for i := _BitFirst to _BitLast do begin
- SetBit(i, (_Value and $00000001) <> 0);
+ SetBit(i, (_Value and TValue(1)) <> 0);
_Value := _Value shr 1;
end;
end;
-procedure TBits16.SetBit(_BitNo: TBitNumber16; _BitValue: Boolean);
+procedure TBits16.SetBit(_BitNo: TBitNumber; _BitValue: Boolean);
begin
if _BitValue then
FValue := FValue or (1 shl _BitNo)
@@ -1418,11 +1732,27 @@
FValue := FValue and not (1 shl _BitNo);
end;
-function TBits16.Value: Word;
+function TBits16.Value: TValue;
begin
Result := FValue;
end;
+function TBits16.GetByte(_ByteNo: TByteNumber): Byte;
+begin
+ Result := (FValue shr (_ByteNo * 8)) and $FF;
+end;
+
+procedure TBits16.SetByte(_ByteNo: TByteNumber; _Value: Byte);
+begin
+ _ByteNo := _ByteNo * 8;
+ FValue := FValue and ($FFFF xor ($FF shl _ByteNo)) or (_Value shl _ByteNo);
+end;
+
+class operator TBits16.Equal(_a, _b: TBits16): Boolean;
+begin
+ Result := _a.Value = _b.Value;
+end;
+
{ TBits8 }
function TBits8.AsString: string;
@@ -1429,28 +1759,43 @@
var
i: Integer;
begin
- Result := DupeString('0', 8);
- for i := 7 downto 0 do
+ Result := DupeString('0', Bits);
+ for i := High downto Low do
if IsBitSet(i) then
- Result[8 - i] := '1';
+ Result[Bits - i] := '1';
end;
-class function TBits8.Create(_Value: Byte): TBits8;
+class function TBits8.AllSet: TBits8;
begin
+ Result.Init($FF);
+end;
+
+class function TBits8.Create(_Value: TValue): TBits8;
+begin
Result.Init(_Value);
end;
-procedure TBits8.Init(_Value: Byte);
+function TBits8.GetByte(_ByteNo: TByteNumber): Byte;
begin
+ Result := FValue;
+end;
+
+procedure TBits8.SetByte(_ByteNo: TByteNumber; _Value: Byte);
+begin
FValue := _Value;
end;
+procedure TBits8.Init(_Value: TValue);
+begin
+ FValue := _Value;
+end;
+
function TBits8.IsAnyBitSet: Boolean;
begin
Result := FValue <> 0;
end;
-function TBits8.IsBitSet(_BitNo: TBitNumber8): Boolean;
+function TBits8.IsBitSet(_BitNo: TBitNumber): Boolean;
begin
Result := ((FValue and (1 shl _BitNo)) <> 0);
end;
@@ -1475,8 +1820,13 @@
Result.Init(_a.Value xor _b.Value);
end;
-procedure TBits8.SetBit(_BitNo: TBitNumber8; _BitValue: Boolean);
+class function TBits8.NoneSet: TBits8;
begin
+ Result.Init(0);
+end;
+
+procedure TBits8.SetBit(_BitNo: TBitNumber; _BitValue: Boolean);
+begin
if _BitValue then
FValue := FValue or (1 shl _BitNo)
else
@@ -1483,10 +1833,38 @@
FValue := FValue and not (1 shl _BitNo);
end;
-function TBits8.Value: Byte;
+function TBits8.Extract(_BitFirst, _BitLast: TBitNumber): TValue;
+var
+ i: Integer;
begin
+ Result := 0;
+ for i := _BitLast downto _BitFirst do begin
+ Result := Result shl 1;
+ if IsBitSet(i) then
+ Result := Result + 1;
+ end;
+end;
+
+procedure TBits8.Overwrite(_BitFirst, _BitLast: TBitNumber; _Value: TValue);
+var
+ i: TBitNumber;
+begin
+ for i := _BitFirst to _BitLast do begin
+ SetBit(i, (_Value and TValue(1)) <> 0);
+ _Value := _Value shr 1;
+ end;
+end;
+
+function TBits8.Value: TValue;
+begin
Result := FValue;
end;
+
+class operator TBits8.Equal(_a, _b: TBits8): Boolean;
+begin
+ Result := _a.Value = _b.Value;
+end;
+
{$ENDIF}
function Bool2Str(_b: Boolean): string;
Modified: trunk/ExternalSource/dzlib/u_dzFileUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2023-07-17 14:35:43 UTC (rev 4045)
+++ trunk/ExternalSource/dzlib/u_dzFileUtils.pas 2023-08-03 12:58:46 UTC (rev 4046)
@@ -1072,8 +1072,8 @@
/// Note that this treats only the text after the last '.' as extension(s). </summary>
function LastExtension: string;
///<summary>
- /// Returns the filename without extension.
- /// Note that this treats everything after the first '.' as extension(s) </summary>
+ /// @Returns the filename including the full path but without extension(s).
+ /// @NOTE: This treats everything after the first '.' as extension(s) </summary>
function BaseName: string;
///<summary>
/// replaces the drive part of the path with the given NewDrive. </summary>
@@ -1133,6 +1133,14 @@
/// Splits all parts of the file name in a TStringArray
/// @returns the number of parts </summary>
function Split: TStringArray;
+ ///<summary>
+ /// @returns True, if the last extension matches the given one (case insensitively)
+ /// Fales otherwise </summary>
+ function HasExtensionLast(const _Ext: string): Boolean;
+ ///<summary>
+ /// @returns True, if the full extension matches the given one (case insensitively)
+ /// Fales otherwise </summary>
+ function HasExtensionFull(const _Ext: string): Boolean;
class function Combine(_Parts: TStringArray): TFilename; static;
///<summary>
/// Same as Init </summary>
@@ -2706,7 +2714,7 @@
try
repeat
if (Sr.Name = '.') or (Sr.Name = '..') then begin
- // ignore
+ // ignore
end else begin
Filename := IncludeTrailingPathDelimiter(_DirName) + Sr.Name;
if (Sr.Attr and SysUtils.faDirectory) <> 0 then begin
@@ -3556,6 +3564,16 @@
Result := Length(Split);
end;
+function TFilename.HasExtensionFull(const _Ext: string): Boolean;
+begin
+ Result := TFileSystem.HasFileExtFull(FFull, _Ext);
+end;
+
+function TFilename.HasExtensionLast(const _Ext: string): Boolean;
+begin
+ Result := TFileSystem.HasFileExtLast(FFull, _Ext);
+end;
+
function TFilename.Parts(_Depth: Integer): string;
var
sa: TStringArray;
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2023-07-17 14:35:43 UTC (rev 4045)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2023-08-03 12:58:46 UTC (rev 4046)
@@ -100,7 +100,8 @@
Red: Byte;
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
function GetValues(_Idx: TValueIdxTriple): Byte; inline;
- procedure SetValues(_Idx: TValueIdxTriple; _Value: Byte); inline;
+ procedure SetValues(_Idx: TValueIdxTriple; _Value: Byte); overload; inline;
+ procedure SetValues(_Red, _Green, _Blue: Byte); overload;
function GetColor: TColor;
///<summary>
/// Sets Blue, Green and Red for the given Color, supporting system colors in addition to RGB colors
@@ -498,10 +499,34 @@
procedure TBitmap_AssignMono824(_Buffer: PByte; _bmp: TBitmap; _YIsReversed: Boolean);
///<summary>
-/// Assign a buffer containg a bitmap in Mono 8 format to a 8 bit gray scale TBitmap </summary>
-procedure TBitmap_AssignMono8(_Buffer: PByte; _bmp: TBitmap; _YIsReversed: Boolean);
+/// Assign a buffer containing a bitmap in Mono 8 format to a 8 bit gray scale TBitmap </summary>
+procedure TBitmap_AssignMono8(_Buffer: PByte; _bmp: TBitmap; _YIsReversed: Boolean); overload;
+procedure TBitmap_AssignMono8(_Buffer: PByte; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64); overload;
+type
+ ///<summary>
+ /// Converts the value at the given position to a Byte and increments BufPtr to point to the
+ /// next value </summary>
+ TBufferBitsToMono8Func = function(var _BufPtr: Pointer): Byte;
+ TBufferBitsToMono8Meth = function(var _BufPtr: Pointer): Byte of object;
+
///<summary>
+/// Converts a 12 bit value at the given position to a Byte and increments BufPtr by 2 </summary>
+function BufferBits12ToMono8(var _BufPtr: Pointer): Byte;
+
+///<summary>
+/// Assign a buffer containing a bitmap in Monochrome format to a 8 bit gray scale TBitmap
+/// @param BufferBitsToMono8Func is a callback function that converts the value at a given
+/// position to a Byte and increments the position to point to
+/// the next value.
+/// @param RowStride (optional) is the number of bytes in Buffer for one row. If 0 it is assumed
+/// that BufferBitsToMono8 will increment Buffer correctly </summary>
+procedure TBitmap_AssignToMono8(_BufferBitsToMono8Func: TBufferBitsToMono8Func;
+ _Buffer: Pointer; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64 = 0); overload;
+procedure TBitmap_AssignToMono8(_BufferBitsToMono8Meth: TBufferBitsToMono8Meth;
+ _Buffer: Pointer; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64 = 0); overload;
+
+///<summary>
/// converts a pf24bit or pf32bit monochrome bitmap to a pf8bit monochrome bitmap </summary>
function TBitmap_MonoToMono8(_bmp: TBitmap): TBitmap; overload;
{$IFDEF SUPPORTS_INLINE}
@@ -795,7 +820,16 @@
{$IFDEF SUPPORTS_INLINE}
inline;
{$ENDIF}
+
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
///<summary>
+/// @param Hue is a value between 0 and 1 </summary>
+procedure RainbowColor(_Hue: Double; out _Color: TdzRgbTriple); overload;
+{$IFDEF SUPPORTS_INLINE}
+inline;
+{$ENDIF}
+{$ENDIF}
+///<summary>
/// @param Brightness is a grayscale value </summary>
function RainbowColor(_Brightness: Byte): TColor; overload;
{$IFDEF SUPPORTS_INLINE}
@@ -1429,6 +1463,13 @@
TdzRgbTripleValues(Self)[_Idx] := _Value;
end;
+procedure TdzRgbTriple.SetValues(_Red, _Green, _Blue: Byte);
+begin
+ Red := _Red;
+ Green := _Green;
+ Blue := _Blue;
+end;
+
procedure TdzRgbTriple.SetBrightness(_Value: Byte);
begin
Red := _Value;
@@ -1916,26 +1957,121 @@
procedure TBitmap_AssignMono8(_Buffer: PByte; _bmp: TBitmap; _YIsReversed: Boolean);
var
+ w: Integer;
+begin
+ Assert(AssertPixelFormat(_bmp, pf8bit));
+ w := _bmp.Width;
+ TBitmap_AssignMono8(_Buffer, _bmp, _YIsReversed, w);
+end;
+
+procedure TBitmap_AssignMono8(_Buffer: PByte; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64);
+var
+ w: Integer;
+ h: Integer;
y: Integer;
ScanLine: PByte;
begin
Assert(AssertPixelFormat(_bmp, pf8bit));
+ w := _bmp.Width;
+ h := _bmp.Height;
+ Assert(_RowStride >= w);
+
// Unfortunately the y coordinates of TBitmap are reversed (the picture is upside down).
// 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 * _bmp.Width);
+ if _YIsReversed and (_RowStride = w) then begin
+ ScanLine := _bmp.ScanLine[h - 1];
+ Move(_Buffer^, ScanLine^, h * w);
end else begin
- for y := 0 to _bmp.Height - 1 do begin
+ for y := 0 to h - 1 do begin
ScanLine := _bmp.ScanLine[y];
- Move(_Buffer^, ScanLine^, _bmp.Width);
- Inc(_Buffer, _bmp.Width);
+ Move(_Buffer^, ScanLine^, w);
+ Inc(_Buffer, _RowStride);
end;
end;
end;
+function BufferBits12ToMono8(var _BufPtr: Pointer): Byte;
+begin
+ Result := MulDiv(PUInt16(_BufPtr)^, 255, 1 shl 12 - 1);
+ IncPtr(_BufPtr, 2);
+end;
+
+procedure TBitmap_AssignToMono8(_BufferBitsToMono8Func: TBufferBitsToMono8Func;
+ _Buffer: Pointer; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64); overload;
+var
+ y: Integer;
+ x: Integer;
+ w: Integer;
+ h: Integer;
+ ScanLine: PByte;
+ Buf: Pointer;
+begin
+ Assert(AssertPixelFormat(_bmp, pf8bit));
+
+ w := _bmp.Width;
+ h := _bmp.Height;
+
+ Assert((_RowStride = 0) or (_RowStride >= w));
+
+ for y := 0 to _bmp.Height - 1 do begin
+ if _YIsReversed then begin
+ ScanLine := _bmp.ScanLine[h - 1];
+ end else begin
+ ScanLine := _bmp.ScanLine[y];
+ end;
+ Buf := _Buffer;
+ for x := 0 to w - 1 do begin
+ ScanLine^ := _BufferBitsToMono8Func(Buf);
+ Inc(ScanLine);
+ end;
+ if _RowStride > 0 then begin
+ IncPtr(_Buffer, _RowStride);
+ end else begin
+ // we assume that BufferBitsToMono8Func inrements the buffer correctly
+ _Buffer := Buf;
+ end;
+ end;
+end;
+
+procedure TBitmap_AssignToMono8(_BufferBitsToMono8Meth: TBufferBitsToMono8Meth;
+ _Buffer: Pointer; _bmp: TBitmap; _YIsReversed: Boolean; _RowStride: Int64 = 0); overload;
+var
+ y: Integer;
+ x: Integer;
+ w: Integer;
+ h: Integer;
+ ScanLine: PByte;
+ Buf: Pointer;
+begin
+ Assert(AssertPixelFormat(_bmp, pf8bit));
+
+ w := _bmp.Width;
+ h := _bmp.Height;
+
+ Assert((_RowStride = 0) or (_RowStride >= w));
+
+ for y := 0 to _bmp.Height - 1 do begin
+ if _YIsReversed then begin
+ ScanLine := _bmp.ScanLine[h - 1];
+ end else begin
+ ScanLine := _bmp.ScanLine[y];
+ end;
+ Buf := _Buffer;
+ for x := 0 to w - 1 do begin
+ ScanLine^ := _BufferBitsToMono8Meth(Buf);
+ Inc(ScanLine);
+ end;
+ if _RowStride > 0 then begin
+ IncPtr(_Buffer, _RowStride);
+ end else begin
+ // we assume that _BufferBitsToMono8Meth inrements the buffer correctly
+ _Buffer := Buf;
+ end;
+ end;
+end;
+
type
PByteArray = SysUtils.PByteArray;
TCopyScanline = procedure(_Width: Integer; _SrcLine: Pointer; _DestLine: Pointer);
@@ -3896,6 +4032,26 @@
end;
end;
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+procedure RainbowColor(_Hue: Double; out _Color: TdzRgbTriple);
+var
+ Value: Double;
+ IntValue: Integer;
+begin
+ Value := EnsureRange(_Hue, 0, 1) * 6;
+ IntValue := Round(Frac(Value) * 255);
+ case Trunc(Value) of
+ 0: _Color.SetValues(255, IntValue, 0);
+ 1: _Color.SetValues(255 - IntValue, 255, 0);
+ 2: _Color.SetValues(0, 255, IntValue);
+ 3: _Color.SetValues(0, 255 - IntValue, 255);
+ 4: _Color.SetValues(IntValue, 0, 255);
+ else // 5
+ _Color.SetValues(255, 0, 255 - IntValue);
+ end;
+end;
+{$ENDIF}
+
procedure RainbowColor(_Brightness: Byte; out _Red, _Green, _Blue: Byte);
var
Brightness: Integer;
@@ -4250,4 +4406,7 @@
end;
end.
+// Here, Delphi 2007 sometimes throws a [DCC Error] F2084 Internal Error: AV06FA6FD9-R00000D1A-0
+// Usually it helps to do a full rebuild or delete the DCU output directory contents
+// In one case the problem went away when I changed the order of units in the project file
Modified: trunk/ExternalSource/dzlib/u_dzMiscUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2023-07-17 14:35:43 UTC (rev 4045)
+++ trunk/ExternalSource/dzlib/u_dzMiscUtils.pas 2023-08-03 12:58:46 UTC (rev 4046)
@@ -74,7 +74,10 @@
function HexDumpString(const _s: AnsiString): string;
///<summary> converts a hexdump of a double back to a double value </summary>
-procedure HexDumpToDbl(const _s: string; var _Value: Double);
+procedure HexDumpToDbl(const _s: string; var _Value: Double); overload;
+{$IFDEF SUPPORTS_UNICODE}
+procedure HexDumpToDbl(const _s: AnsiString; var _Value: Double); overload;
+{$ENDIF SUPPORTS_UNICODE}
///<summary> converts a hexdump of an extended back to an extended value </summary>
procedure HexDumpToExtended(const _s: string; var _Value: Extended);
@@ -497,6 +500,13 @@
end;
end;
+{$IFDEF SUPPORTS_UNICODE}
+procedure HexDumpToDbl(const _s: AnsiString; var _Value: Double);
+begin
+ HexDumpToDbl(string(_s), _Value);
+end;
+{$ENDIF SUPPORTS_UNICODE}
+
procedure HexDumpToExtended(const _s: string; var _Value: Extended);
type
TBuffer = array[0..SizeOf(_Value)] of Byte;
Modified: trunk/ExternalSource/dzlib/u_dzStringUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2023-07-17 14:35:43 UTC (rev 4045)
+++ trunk/ExternalSource/dzlib/u_dzStringUtils.pas 2023-08-03 12:58:46 UTC (rev 4046)
@@ -59,7 +59,7 @@
/// Cuts off the string at the first #0 and returns the new length </summary>
function StrTrimNul(var _s: AnsiString): Integer;
///<summary> use StrTrimNul </summary>
-function StrTrimZero(var _s: AnsiString): integer; deprecated; // use StrTrimNul
+function StrTrimZero(var _s: AnsiString): Integer; deprecated; // use StrTrimNul
///<summary>
/// Converts an array of byte to a string, interpreting the bytes as AnsiString </summary>
@@ -353,7 +353,10 @@
///<summary>
/// Replaces all control characters (ord(c) < ord(' ')) with ReplaceChar.
/// If RemoveDuplicates is true, a sequence of control characters is replaced by a single ReplaceChar. </summary>
-function ReplaceCtrlChars(const _s: string; _ReplaceChar: Char; _RemoveDuplicates: Boolean = True): string;
+function ReplaceCtrlChars(const _s: string; _ReplaceChar: Char; _RemoveDuplicates: Boolean = True): string; overload;
+{$IFDEF SUPPORTS_UNICODE}
+function ReplaceCtrlChars(const _s: AnsiString; _ReplaceChar: AnsiChar; _RemoveDuplicates: Boolean = True): AnsiString; overload;
+{$ENDIF SUPPORTS_UNICODE}
///<summary>
/// Replaces all control characters (ord(c) < ord(' ')) with Spaces.
@@ -389,11 +392,40 @@
/// @returns the Nth character of S or ' ' if S has less than N charaters. </summary>
function nthCharOf(const _s: string; _n: Integer): Char;
+{$IFDEF SUPPORTS_UNICODE}
///<summary>
/// Extract the first word of S using the given delimiters. The word is deleted from S.
/// See also ExtractStr.
/// NOTE: Duplicate delimiters are ignored, so 'abc def' will be split into two words (which you
/// would expect), but also 'abc'#9#9'def' is two words (which you might not expect) </summary>
+function ExtractFirstWord(var _s: AnsiString; const _Delimiter: AnsiString): AnsiString; overload;
+///<summary>
+/// Extract the first word of S using the given delimiters. The word is deleted from S.
+/// See also ExtractStr.
+/// NOTE: Duplicate delimiters are ignored, so 'abc def' will be split into two words (which you
+/// would expect), but also 'abc'#9#9'def' is two words (which you might not expect) </summary>
+function ExtractFirstWord(var _s: AnsiString; _Delimiter: TCharSet): AnsiString; overload;
+///<summary>
+/// Extract the first word of S using the given delimiters. The word is deleted from S.
+/// See also ExtractStr.
+/// NOTE: Duplicate delimiters are ignored, so 'abc def' will be split into two words (which you
+/// would expect), but also 'abc'#9#9'def' is two words (which you might not expect)
+/// @returns true, if a word could be extracted, false otherwise </summary>
+function ExtractFirstWord(var _s: AnsiString; const _Delimiter: AnsiString; out _FirstWord: AnsiString): Boolean; overload;
+///<summary>
+/// Extract the first word of S using the given delimiters. The word is deleted from S.
+/// See also ExtractStr.
+/// NOTE: Duplicate delimiters are ignored, so 'abc def' will be split into two words (which you
+/// would expect), but also 'abc'#9#9'def' is two words (which you might not expect)
+/// @returns true, if a word could be extracted, false otherwise </summary>
+function ExtractFirstWord(var _s: AnsiString; _Delimiter: TCharSet; out _FirstWord: AnsiString): Boolean; overload;
+{$ENDIF SUPPORTS_UNICODE}
+
+///<summary>
+/// Extract the first word of S using the given delimiters. The word is deleted from S.
+/// See also ExtractStr.
+/// NOTE: Duplicate delimiters are ignored, so 'abc def' will be split into two words (which you
+/// would expect), but also 'abc'#9#9'def' is two words (which you might not expect) </summary>
function ExtractFirstWord(var _s: string; const _Delimiter: string): string; overload;
///<summary>
/// Extract the first word of S using the given delimiters. The word is deleted from S.
@@ -574,7 +606,7 @@
end;
function nthWordStartAndEnd(const _s: string; _WordNo: Integer;
- const _Delimiter: AnsiString; out _Start, _Ende: Integer): Boolean; overload;
+ const _Delimiter: string; out _Start, _Ende: Integer): Boolean; overload;
var
i: Integer;
DelimiterSet: TCharSet;
@@ -581,17 +613,23 @@
begin
DelimiterSet := [];
for i := 1 to Length(_Delimiter) do
- Include(DelimiterSet, _Delimiter[i]);
+ Include(DelimiterSet, AnsiChar(_Delimiter[i]));
Result := nthWordStartAndEnd(_s, _WordNo, DelimiterSet, _Start, _Ende);
end;
{$IFDEF SUPPORTS_UNICODE}
-function nthWordStartAndEnd(const _s: string; _WordNo: Integer;
- const _Delimiter: string; out _Start, _Ende: Integer): Boolean; overload;
+function nthWordStartAndEnd(const _s: AnsiString; _WordNo: Integer;
+ const _Delimiter: AnsiString; out _Start, _Ende: Integer): Boolean; overload;
begin
- Result := nthWordStartAndEnd(_s, _WordNo, AnsiString(_Delimiter), _Start, _Ende);
+ Result := nthWordStartAndEnd(string(_s), _WordNo, string(_Delimiter), _Start, _Ende);
end;
+
+function nthWordStartAndEnd(const _s: AnsiString; _WordNo: Integer;
+ const _Delimiter: TCharSet; out _Start, _Ende: Integer): Boolean; overload;
+begin
+ Result := nthWordStartAndEnd(string(_s), _WordNo, _Delimiter, _Start, _Ende);
+end;
{$ENDIF SUPPORTS_UNICODE}
function nthWord(const _s: string; _WordNo: Integer; const _Delimiter: string): string;
@@ -652,6 +690,46 @@
end;
end;
+{$IFDEF SUPPORTS_UNICODE}
+function ExtractFirstWord(var _s: AnsiString; _Delimiter: TCharSet): AnsiString;
+begin
+ if not ExtractFirstWord(_s, _Delimiter, Result) then begin // s contained only Delimiters
+ Result := '';
+ _s := '';
+ end;
+end;
+
+function ExtractFirstWord(var _s: AnsiString; const _Delimiter: AnsiString): AnsiString;
+begin
+ if not ExtractFirstWord(_s, _Delimiter, Result) then begin // s contained only Delimiters
+ Result := '';
+ _s := '';
+ end;
+end;
+
+function ExtractFirstWord(var _s: AnsiString; const _Delimiter: AnsiString; out _FirstWord: AnsiString): Boolean;
+var
+ Start, Ende: Integer;
+begin
+ Result := nthWordStartAndEnd(_s, 1, _Delimiter, Start, Ende);
+ if Result then begin
+ _FirstWord := Copy(_s, Start, Ende - Start);
+ _s := TailStr(_s, Ende + 1);
+ end;
+end;
+
+function ExtractFirstWord(var _s: AnsiString; _Delimiter: TCharSet; out _FirstWord: AnsiString): Boolean;
+var
+ Start, Ende: Integer;
+begin
+ Result := nthWordStartAndEnd(_s, 1, _Delimiter, Start, Ende);
+ if Result then begin
+ _FirstWord := Copy(_s, Start, Ende - Start);
+ _s := TailStr(_s, Ende + 1);
+ end;
+end;
+{$ENDIF SUPPORTS_UNICODE}
+
function ExtractFirstN(var _s: string; _n: Integer): string;
begin
Result := Copy(_s, 1, _n);
@@ -782,6 +860,13 @@
Dup := False;
end;
+{$IFDEF SUPPORTS_UNICODE}
+function ReplaceCtrlChars(const _s: AnsiString; _ReplaceChar: AnsiChar; _RemoveDuplicates: Boolean = True): AnsiString;
+begin
+ Result := AnsiString(ReplaceCtrlChars(string(_s), Char(_ReplaceChar), _RemoveDuplicates));
+end;
+{$ENDIF SUPPORTS_UNICODE}
+
function ContainsOnlyCharsFrom(const _s: string; _ValidChars: TCharSet): Boolean;
var
i: Integer;
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2023-07-17 14:35:43 UTC (rev 4045)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2023-08-03 12:58:46 UTC (rev 4046)
@@ -693,6 +693,10 @@
function TTabControl_GetSelectedObject(_TabControl: TTabControl; out _Obj: Pointer): Boolean; overload;
function TTabControl_GetSelectedObject(_TabControl: TTabControl; out _Idx: Integer; out _Obj: Pointer): Boolean; overload;
+///<sumamry>
+/// disables and re-enables the timer so it starts again </summary>
+procedure TTimer_Restart(_tim: TTimer);
+
///<summary> Enables longer SimpleText (longer than 127 characters)
/// Call once to enable. Works, by adding a single panel with owner drawing and
/// setting the StatusBar's OnDrawPanel to a custom drawing method.
@@ -707,7 +711,7 @@
/// Resize one panel a StatusBar to take up all the space the others don't need
/// @param sb is the TStatusBar to work on
/// @param PanelIdxToChange is the index of the panel whose size should be changed </summary>
-procedure TStatusBar_Resize(_sb: TStatusBar; _PanelIdxToChange: integer);
+procedure TStatusBar_Resize(_sb: TStatusBar; _PanelIdxToChange: Integer);
///<summary>
/// Sets the text of a status bar panel and optionally adjusts its width to fit.
@@ -3213,6 +3217,12 @@
_Obj := _TabControl.Tabs.Objects[_Idx];
end;
+procedure TTimer_Restart(_tim: TTimer);
+begin
+ _tim.Enabled := False;
+ _tim.Enabled := True;
+end;
+
type
// Note: This class is never instantiated, only the DrawPanel method will be used
// without ever referencing the self pointer (which is NIL), so it should work
@@ -3246,7 +3256,7 @@
_StatusBar.OnDrawPanel := Painter.DrawPanel;
end;
-procedure TStatusBar_Resize(_sb: TStatusBar; _PanelIdxToChange: integer);
+procedure TStatusBar_Resize(_sb: TStatusBar; _PanelIdxToChange: Integer);
var
w: Integer;
i: Integer;
@@ -5523,7 +5533,7 @@
function TPopupMenu_AppendMenuItem(_pm: TPopupMenu; const _Caption: string): TMenuItem; overload;
const
- NilEvent: TMethod = (code: nil; data: nil);
+ NilEvent: TMethod = (Code: nil; Data: nil);
begin
Result := TPopupMenu_AppendMenuItem(_pm, _Caption, TNotifyEvent(NilEvent));
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|