2014-11-08 23:41:35 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2015-06-03 11:07:39 +00:00
|
|
|
Unit fpsUtils provides a variety of <b>utility functions</b> used
|
|
|
|
throughout the fpspreadsheet library.
|
2014-11-08 23:41:35 +00:00
|
|
|
|
|
|
|
LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus
|
|
|
|
distribution, for details about the license.
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
unit fpsutils;
|
2014-05-14 15:24:02 +00:00
|
|
|
|
|
|
|
// to do: Remove the patched FormatDateTime when the feature of square brackets
|
|
|
|
// in time format codes is in the rtl
|
2014-10-24 20:44:37 +00:00
|
|
|
// to do: Remove the declaration UTF8FormatSettings and InitUTF8FormatSettings
|
|
|
|
// when this same modification is in LazUtils of Laz stable
|
2014-05-14 15:24:02 +00:00
|
|
|
|
2009-01-09 08:39:40 +00:00
|
|
|
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
|
|
|
|
interface
|
|
|
|
|
|
|
|
uses
|
2015-06-28 17:59:09 +00:00
|
|
|
Classes, SysUtils, //StrUtils,
|
2015-01-17 22:57:23 +00:00
|
|
|
fpstypes;
|
2010-05-25 09:11:02 +00:00
|
|
|
|
|
|
|
// Exported types
|
|
|
|
type
|
2014-06-23 21:49:20 +00:00
|
|
|
{@@ Selection direction along column or along row }
|
2010-05-25 09:11:02 +00:00
|
|
|
TsSelectionDirection = (fpsVerticalSelection, fpsHorizontalSelection);
|
2014-06-23 21:49:20 +00:00
|
|
|
|
2015-05-28 20:08:24 +00:00
|
|
|
{@@ Color value, composed of r(ed), g(reen) and b(lue) components }
|
|
|
|
TRGBA = record r, g, b, a: byte end;
|
|
|
|
|
2013-12-23 12:11:20 +00:00
|
|
|
const
|
2014-06-23 21:49:20 +00:00
|
|
|
{@@ Date formatting string for unambiguous date/time display as strings
|
|
|
|
Can be used for text output when date/time cell support is not available }
|
2013-12-23 12:11:20 +00:00
|
|
|
ISO8601Format='yyyymmdd"T"hhmmss';
|
2014-06-23 21:49:20 +00:00
|
|
|
{@@ Extended ISO 8601 date/time format, used in e.g. ODF/opendocument }
|
2013-12-23 13:35:36 +00:00
|
|
|
ISO8601FormatExtended='yyyy"-"mm"-"dd"T"hh":"mm":"ss';
|
2014-09-02 09:25:54 +00:00
|
|
|
{@@ ISO 8601 date-only format, used in ODF/opendocument }
|
|
|
|
ISO8601FormatDateOnly='yyyy"-"mm"-"dd';
|
2014-06-23 21:49:20 +00:00
|
|
|
{@@ ISO 8601 time-only format, used in ODF/opendocument }
|
2014-06-18 21:54:29 +00:00
|
|
|
ISO8601FormatTimeOnly='"PT"hh"H"nn"M"ss"S"';
|
2014-07-27 17:31:02 +00:00
|
|
|
{@@ ISO 8601 time-only format, with hours overflow }
|
|
|
|
ISO8601FormatHoursOverflow='"PT"[hh]"H"nn"M"ss.zz"S"';
|
2013-12-23 12:11:20 +00:00
|
|
|
|
2010-05-25 09:11:02 +00:00
|
|
|
// Endianess helper functions
|
2009-01-09 08:39:40 +00:00
|
|
|
function WordToLE(AValue: Word): Word;
|
|
|
|
function DWordToLE(AValue: Cardinal): Cardinal;
|
|
|
|
function IntegerToLE(AValue: Integer): Integer;
|
2009-04-21 15:08:43 +00:00
|
|
|
function WideStringToLE(const AValue: WideString): WideString;
|
2009-01-09 08:39:40 +00:00
|
|
|
|
2009-01-10 22:58:00 +00:00
|
|
|
function WordLEtoN(AValue: Word): Word;
|
|
|
|
function DWordLEtoN(AValue: Cardinal): Cardinal;
|
2009-04-21 15:08:43 +00:00
|
|
|
function WideStringLEToN(const AValue: WideString): WideString;
|
2009-01-10 22:58:00 +00:00
|
|
|
|
2015-07-30 16:28:30 +00:00
|
|
|
// Cell, column and row strings
|
2010-05-25 09:11:02 +00:00
|
|
|
function ParseIntervalString(const AStr: string;
|
2014-07-02 15:14:58 +00:00
|
|
|
out AFirstCellRow, AFirstCellCol, ACount: Cardinal;
|
2014-06-19 19:25:40 +00:00
|
|
|
out ADirection: TsSelectionDirection): Boolean;
|
2014-04-08 09:48:30 +00:00
|
|
|
function ParseCellRangeString(const AStr: string;
|
2014-07-02 15:14:58 +00:00
|
|
|
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal;
|
2014-08-18 13:48:46 +00:00
|
|
|
out AFlags: TsRelFlags): Boolean; overload;
|
|
|
|
function ParseCellRangeString(const AStr: string;
|
|
|
|
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal): Boolean; overload;
|
2015-01-03 20:03:55 +00:00
|
|
|
function ParseCellRangeString(const AStr: String;
|
|
|
|
out ARange: TsCellRange; out AFlags: TsRelFlags): Boolean; overload;
|
|
|
|
function ParseCellRangeString(const AStr: String;
|
|
|
|
out ARange: TsCellRange): Boolean; overload;
|
2010-05-25 09:11:02 +00:00
|
|
|
function ParseCellString(const AStr: string;
|
2014-07-02 15:14:58 +00:00
|
|
|
out ACellRow, ACellCol: Cardinal; out AFlags: TsRelFlags): Boolean; overload;
|
2014-04-08 09:48:30 +00:00
|
|
|
function ParseCellString(const AStr: string;
|
2014-07-02 15:14:58 +00:00
|
|
|
out ACellRow, ACellCol: Cardinal): Boolean; overload;
|
2015-02-22 23:38:28 +00:00
|
|
|
function ParseSheetCellString(const AStr: String;
|
|
|
|
out ASheetName: String; out ACellRow, ACellCol: Cardinal): Boolean;
|
2010-05-25 09:11:02 +00:00
|
|
|
function ParseCellRowString(const AStr: string;
|
2014-07-02 15:14:58 +00:00
|
|
|
out AResult: Cardinal): Boolean;
|
2010-05-25 09:11:02 +00:00
|
|
|
function ParseCellColString(const AStr: string;
|
2014-07-02 15:14:58 +00:00
|
|
|
out AResult: Cardinal): Boolean;
|
2014-04-19 19:29:13 +00:00
|
|
|
|
|
|
|
function GetColString(AColIndex: Integer): String;
|
2015-01-03 20:03:55 +00:00
|
|
|
|
2014-12-16 18:28:41 +00:00
|
|
|
function GetCellString(ARow,ACol: Cardinal;
|
|
|
|
AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
|
2014-08-18 13:48:46 +00:00
|
|
|
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
|
2015-01-03 20:03:55 +00:00
|
|
|
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload;
|
|
|
|
function GetCellRangeString(ARange: TsCellRange;
|
|
|
|
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload;
|
2014-04-19 19:29:13 +00:00
|
|
|
|
2014-05-25 16:49:45 +00:00
|
|
|
function GetErrorValueStr(AErrorValue: TsErrorValue): String;
|
2015-02-25 09:43:37 +00:00
|
|
|
function GetFileFormatName(AFormat: TsSpreadsheetFormat): string;
|
2015-03-08 00:50:10 +00:00
|
|
|
function GetFileFormatExt(AFormat: TsSpreadsheetFormat): String;
|
|
|
|
function GetFormatFromFileName(const AFileName: TFileName;
|
|
|
|
out SheetType: TsSpreadsheetFormat): Boolean;
|
2014-05-25 16:49:45 +00:00
|
|
|
|
2014-05-20 16:13:48 +00:00
|
|
|
function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload;
|
|
|
|
|
2015-05-19 10:55:18 +00:00
|
|
|
procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64;
|
|
|
|
out ANumerator, ADenominator: Int64);
|
2014-10-19 21:20:57 +00:00
|
|
|
function TryStrToFloatAuto(AText: String; out ANumber: Double;
|
2014-10-20 21:04:20 +00:00
|
|
|
out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean;
|
2015-03-31 19:01:16 +00:00
|
|
|
function TryFractionStrToFloat(AText: String; out ANumber: Double;
|
2015-05-19 16:18:01 +00:00
|
|
|
out AIsMixed: Boolean; out AMaxDigits: Integer): Boolean;
|
2015-03-31 19:01:16 +00:00
|
|
|
|
2015-05-19 16:18:01 +00:00
|
|
|
function TwipsToPts(AValue: Integer): Single; inline;
|
|
|
|
function PtsToTwips(AValue: Single): Integer; inline;
|
2015-04-30 21:55:55 +00:00
|
|
|
function cmToPts(AValue: Double): Double; inline;
|
|
|
|
function PtsToCm(AValue: Double): Double; inline;
|
|
|
|
function InToMM(AValue: Double): Double; inline;
|
|
|
|
function InToPts(AValue: Double): Double; inline;
|
|
|
|
function PtsToIn(AValue: Double): Double; inline;
|
|
|
|
function mmToPts(AValue: Double): Double; inline;
|
|
|
|
function mmToIn(AValue: Double): Double; inline;
|
|
|
|
function PtsToMM(AValue: Double): Double; inline;
|
|
|
|
function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double; inline;
|
|
|
|
function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer; inline;
|
|
|
|
function HTMLLengthStrToPts(AValue: String; DefaultUnits: String = 'pt'): Double;
|
2014-05-27 13:09:23 +00:00
|
|
|
|
2014-07-02 11:51:59 +00:00
|
|
|
function UTF8TextToXMLText(AText: ansistring): ansistring;
|
2014-09-29 22:27:03 +00:00
|
|
|
function ValidXMLText(var AText: ansistring; ReplaceSpecialChars: Boolean = true): Boolean;
|
|
|
|
|
2015-05-28 20:08:24 +00:00
|
|
|
function ColorToHTMLColorStr(AValue: TsColor; AExcelDialect: Boolean = false): String;
|
|
|
|
function HTMLColorStrToColor(AValue: String): TsColor;
|
|
|
|
|
|
|
|
function GetColorName(AColor: TsColor): String;
|
|
|
|
function HighContrastColor(AColor: TsColor): TsColor;
|
|
|
|
function IsPaletteIndex(AColor: TsColor): Boolean;
|
|
|
|
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
|
|
|
|
function SetAsPaletteIndex(AIndex: Integer): TsColor;
|
|
|
|
function TintedColor(AColor: TsColor; tint: Double): TsColor;
|
2014-05-27 22:12:48 +00:00
|
|
|
|
2014-07-04 20:41:07 +00:00
|
|
|
function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String;
|
|
|
|
|
2014-10-22 15:57:07 +00:00
|
|
|
function InitSortParams(ASortByCols: Boolean = true; ANumSortKeys: Integer = 1;
|
|
|
|
ASortPriority: TsSortPriority = spNumAlpha): TsSortParams;
|
|
|
|
|
2015-03-02 12:23:52 +00:00
|
|
|
procedure SplitHyperlink(AValue: String; out ATarget, ABookmark: String);
|
2015-03-08 17:04:25 +00:00
|
|
|
procedure FixHyperlinkPathDelims(var ATarget: String);
|
2015-03-02 12:23:52 +00:00
|
|
|
|
2015-03-04 17:30:59 +00:00
|
|
|
procedure InitCell(out ACell: TCell); overload;
|
|
|
|
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); overload;
|
2015-03-05 10:54:06 +00:00
|
|
|
procedure InitFormatRecord(out AValue: TsCellFormat);
|
2015-04-30 21:55:55 +00:00
|
|
|
procedure InitPageLayout(out APageLayout: TsPageLayout);
|
2015-03-04 17:30:59 +00:00
|
|
|
|
2015-05-31 16:34:40 +00:00
|
|
|
procedure CopyCellValue(AFromCell, AToCell: PCell);
|
|
|
|
function HasFormula(ACell: PCell): Boolean;
|
|
|
|
function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean;
|
|
|
|
|
2014-07-10 15:55:40 +00:00
|
|
|
procedure AppendToStream(AStream: TStream; const AString: String); inline; overload;
|
|
|
|
procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload;
|
|
|
|
procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String); inline; overload;
|
|
|
|
|
2014-10-06 10:43:10 +00:00
|
|
|
{ For silencing the compiler... }
|
2014-06-20 15:58:22 +00:00
|
|
|
procedure Unused(const A1);
|
|
|
|
procedure Unused(const A1, A2);
|
|
|
|
procedure Unused(const A1, A2, A3);
|
|
|
|
|
2014-05-31 21:04:53 +00:00
|
|
|
var
|
2014-11-08 23:41:35 +00:00
|
|
|
{@@ Default value for the screen pixel density (pixels per inch). Is needed
|
|
|
|
for conversion of distances to pixels}
|
2014-05-31 21:04:53 +00:00
|
|
|
ScreenPixelsPerInch: Integer = 96;
|
2015-05-31 16:34:40 +00:00
|
|
|
|
2014-11-08 23:41:35 +00:00
|
|
|
{@@ FPC format settings for which all strings have been converted to UTF8 }
|
2014-10-24 20:44:37 +00:00
|
|
|
UTF8FormatSettings: TFormatSettings;
|
2014-05-31 21:04:53 +00:00
|
|
|
|
2009-01-09 08:39:40 +00:00
|
|
|
implementation
|
|
|
|
|
2014-05-14 15:24:02 +00:00
|
|
|
uses
|
2014-10-19 21:20:57 +00:00
|
|
|
Math, lazutf8, fpsStrings;
|
2014-05-14 15:24:02 +00:00
|
|
|
|
2014-06-23 21:49:20 +00:00
|
|
|
{******************************************************************************}
|
|
|
|
{ Endianess helper functions }
|
|
|
|
{******************************************************************************}
|
2009-01-09 08:39:40 +00:00
|
|
|
|
2014-06-23 21:49:20 +00:00
|
|
|
{ Excel files are all written with little endian byte order,
|
2009-01-09 08:39:40 +00:00
|
|
|
so it's necessary to swap the data to be able to build a
|
|
|
|
correct file on big endian systems.
|
2009-01-10 22:58:00 +00:00
|
|
|
|
2014-06-23 21:49:20 +00:00
|
|
|
The routines WordToLE, DWordToLE, IntegerToLE etc are preferable to
|
|
|
|
System unit routines because they ensure that the correct overloaded version
|
|
|
|
of the conversion routines will be used, avoiding typecasts which are less readable.
|
2009-01-10 22:58:00 +00:00
|
|
|
|
|
|
|
They also guarantee delphi compatibility. For Delphi we just support
|
|
|
|
big-endian isn't support, because Delphi doesn't support it.
|
2009-01-09 08:39:40 +00:00
|
|
|
}
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
WordLEToLE converts a word value from big-endian to little-endian byte order.
|
|
|
|
|
|
|
|
@param AValue Big-endian word value
|
|
|
|
@return Little-endian word value
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2009-01-09 08:39:40 +00:00
|
|
|
function WordToLE(AValue: Word): Word;
|
|
|
|
begin
|
2009-01-10 22:58:00 +00:00
|
|
|
{$IFDEF FPC}
|
|
|
|
Result := NtoLE(AValue);
|
2009-01-09 08:39:40 +00:00
|
|
|
{$ELSE}
|
|
|
|
Result := AValue;
|
|
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
DWordLEToLE converts a DWord value from big-endian to little-endian byte-order.
|
|
|
|
|
|
|
|
@param AValue Big-endian DWord value
|
|
|
|
@return Little-endian DWord value
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2009-01-09 08:39:40 +00:00
|
|
|
function DWordToLE(AValue: Cardinal): Cardinal;
|
|
|
|
begin
|
2009-01-10 22:58:00 +00:00
|
|
|
{$IFDEF FPC}
|
|
|
|
Result := NtoLE(AValue);
|
2009-01-09 08:39:40 +00:00
|
|
|
{$ELSE}
|
|
|
|
Result := AValue;
|
|
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts an integer value from big-endian to little-endian byte-order.
|
|
|
|
|
|
|
|
@param AValue Big-endian integer value
|
|
|
|
@return Little-endian integer value
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2009-01-09 08:39:40 +00:00
|
|
|
function IntegerToLE(AValue: Integer): Integer;
|
|
|
|
begin
|
2009-01-10 22:58:00 +00:00
|
|
|
{$IFDEF FPC}
|
|
|
|
Result := NtoLE(AValue);
|
|
|
|
{$ELSE}
|
|
|
|
Result := AValue;
|
|
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts a word value from little-endian to big-endian byte-order.
|
|
|
|
|
|
|
|
@param AValue Little-endian word value
|
|
|
|
@return Big-endian word value
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2009-01-10 22:58:00 +00:00
|
|
|
function WordLEtoN(AValue: Word): Word;
|
|
|
|
begin
|
|
|
|
{$IFDEF FPC}
|
|
|
|
Result := LEtoN(AValue);
|
|
|
|
{$ELSE}
|
|
|
|
Result := AValue;
|
|
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts a DWord value from little-endian to big-endian byte-order.
|
|
|
|
|
|
|
|
@param AValue Little-endian DWord value
|
|
|
|
@return Big-endian DWord value
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2009-01-10 22:58:00 +00:00
|
|
|
function DWordLEtoN(AValue: Cardinal): Cardinal;
|
|
|
|
begin
|
|
|
|
{$IFDEF FPC}
|
|
|
|
Result := LEtoN(AValue);
|
2009-01-09 08:39:40 +00:00
|
|
|
{$ELSE}
|
|
|
|
Result := AValue;
|
|
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts a widestring from big-endian to little-endian byte-order.
|
|
|
|
|
|
|
|
@param AValue Big-endian widestring
|
|
|
|
@return Little-endian widestring
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2009-04-21 15:08:43 +00:00
|
|
|
function WideStringToLE(const AValue: WideString): WideString;
|
2014-06-20 15:58:22 +00:00
|
|
|
{$IFNDEF FPC}
|
2009-04-21 15:08:43 +00:00
|
|
|
var
|
|
|
|
j: integer;
|
2014-06-20 15:58:22 +00:00
|
|
|
{$ENDIF}
|
2009-04-21 15:08:43 +00:00
|
|
|
begin
|
|
|
|
{$IFDEF FPC}
|
|
|
|
{$IFDEF FPC_LITTLE_ENDIAN}
|
|
|
|
Result:=AValue;
|
|
|
|
{$ELSE}
|
|
|
|
Result:=AValue;
|
|
|
|
for j := 1 to Length(AValue) do begin
|
|
|
|
PWORD(@Result[j])^:=NToLE(PWORD(@Result[j])^);
|
|
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
{$ELSE}
|
|
|
|
Result:=AValue;
|
|
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts a widestring from little-endian to big-endian byte-order.
|
|
|
|
|
|
|
|
@param AValue Little-endian widestring
|
|
|
|
@return Big-endian widestring
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2009-04-21 15:08:43 +00:00
|
|
|
function WideStringLEToN(const AValue: WideString): WideString;
|
2014-06-20 15:58:22 +00:00
|
|
|
{$IFNDEF FPC}
|
2009-04-21 15:08:43 +00:00
|
|
|
var
|
|
|
|
j: integer;
|
2014-06-20 15:58:22 +00:00
|
|
|
{$ENDIF}
|
2009-04-21 15:08:43 +00:00
|
|
|
begin
|
|
|
|
{$IFDEF FPC}
|
|
|
|
{$IFDEF FPC_LITTLE_ENDIAN}
|
|
|
|
Result:=AValue;
|
|
|
|
{$ELSE}
|
|
|
|
Result:=AValue;
|
|
|
|
for j := 1 to Length(AValue) do begin
|
|
|
|
PWORD(@Result[j])^:=LEToN(PWORD(@Result[j])^);
|
|
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
{$ELSE}
|
|
|
|
Result:=AValue;
|
|
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2010-05-25 09:11:02 +00:00
|
|
|
Parses strings like A5:A10 into an selection interval information
|
2014-06-23 21:49:20 +00:00
|
|
|
|
|
|
|
@param AStr Cell range string, such as A5:A10
|
|
|
|
@param AFirstCellRow Row index of the first cell of the range (output)
|
|
|
|
@param AFirstCellCol Column index of the first cell of the range (output)
|
|
|
|
@param ACount Number of cells included in the range (output)
|
|
|
|
@param ADirection fpsVerticalSelection if the range is along a column,
|
|
|
|
fpsHorizontalSelection if the range is along a row
|
2014-09-21 16:50:56 +00:00
|
|
|
|
2014-06-23 21:49:20 +00:00
|
|
|
@return false if the string is not a valid cell range
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2010-05-25 09:11:02 +00:00
|
|
|
function ParseIntervalString(const AStr: string;
|
2014-07-02 15:14:58 +00:00
|
|
|
out AFirstCellRow, AFirstCellCol, ACount: Cardinal;
|
2014-06-19 19:25:40 +00:00
|
|
|
out ADirection: TsSelectionDirection): Boolean;
|
2010-05-25 09:11:02 +00:00
|
|
|
var
|
2014-04-08 09:48:30 +00:00
|
|
|
//Cells: TStringList;
|
2014-07-02 15:14:58 +00:00
|
|
|
LastCellRow, LastCellCol: Cardinal;
|
2014-04-08 09:48:30 +00:00
|
|
|
p: Integer;
|
|
|
|
s1, s2: String;
|
2010-05-25 09:11:02 +00:00
|
|
|
begin
|
|
|
|
Result := True;
|
|
|
|
|
2014-04-08 09:48:30 +00:00
|
|
|
{ Simpler:
|
|
|
|
use "pos" instead of the TStringList overhead.
|
|
|
|
And: the StringList is not free'ed here
|
|
|
|
|
2010-05-25 09:11:02 +00:00
|
|
|
// First get the cells
|
|
|
|
Cells := TStringList.Create;
|
|
|
|
ExtractStrings([':'],[], PChar(AStr), Cells);
|
|
|
|
|
|
|
|
// Then parse each of them
|
|
|
|
Result := ParseCellString(Cells[0], AFirstCellRow, AFirstCellCol);
|
|
|
|
if not Result then Exit;
|
|
|
|
Result := ParseCellString(Cells[1], LastCellRow, LastCellCol);
|
|
|
|
if not Result then Exit;
|
2014-04-08 09:48:30 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
// First find the position of the colon and split into parts
|
|
|
|
p := pos(':', AStr);
|
|
|
|
if p = 0 then exit(false);
|
|
|
|
s1 := copy(AStr, 1, p-1);
|
|
|
|
s2 := copy(AStr, p+1, Length(AStr));
|
|
|
|
|
|
|
|
// Then parse each of them
|
|
|
|
Result := ParseCellString(s1, AFirstCellRow, AFirstCellCol);
|
|
|
|
if not Result then Exit;
|
|
|
|
Result := ParseCellString(s2, LastCellRow, LastCellCol);
|
|
|
|
if not Result then Exit;
|
2010-05-25 09:11:02 +00:00
|
|
|
|
|
|
|
if AFirstCellRow = LastCellRow then
|
|
|
|
begin
|
|
|
|
ADirection := fpsHorizontalSelection;
|
|
|
|
ACount := LastCellCol - AFirstCellCol + 1;
|
|
|
|
end
|
|
|
|
else if AFirstCellCol = LastCellCol then
|
|
|
|
begin
|
|
|
|
ADirection := fpsVerticalSelection;
|
|
|
|
ACount := LastCellRow - AFirstCellRow + 1;
|
|
|
|
end
|
|
|
|
else Exit(False);
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-04-08 09:48:30 +00:00
|
|
|
Parses strings like A5:C10 into a range selection information.
|
2014-05-24 19:44:40 +00:00
|
|
|
Returns in AFlags also information on relative/absolute cells.
|
2014-06-23 21:49:20 +00:00
|
|
|
|
|
|
|
@param AStr Cell range string, such as A5:C10
|
|
|
|
@param AFirstCellRow Row index of the top/left cell of the range (output)
|
|
|
|
@param AFirstCellCol Column index of the top/left cell of the range (output)
|
|
|
|
@param ALastCellRow Row index of the bottom/right cell of the range (output)
|
|
|
|
@param ALastCellCol Column index of the bottom/right cell of the range (output)
|
|
|
|
@param AFlags a set containing an element for AFirstCellRow, AFirstCellCol,
|
|
|
|
ALastCellRow, ALastCellCol if they represent relative
|
|
|
|
cell addresses.
|
2014-09-21 16:50:56 +00:00
|
|
|
|
2014-06-23 21:49:20 +00:00
|
|
|
@return false if the string is not a valid cell range
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-04-08 09:48:30 +00:00
|
|
|
function ParseCellRangeString(const AStr: string;
|
2014-07-02 15:14:58 +00:00
|
|
|
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal;
|
2014-06-19 19:25:40 +00:00
|
|
|
out AFlags: TsRelFlags): Boolean;
|
2014-04-08 09:48:30 +00:00
|
|
|
var
|
|
|
|
p: Integer;
|
|
|
|
s: String;
|
2014-05-24 19:44:40 +00:00
|
|
|
f: TsRelFlags;
|
2014-04-08 09:48:30 +00:00
|
|
|
begin
|
|
|
|
Result := True;
|
|
|
|
|
|
|
|
// First find the colon
|
|
|
|
p := pos(':', AStr);
|
|
|
|
if p = 0 then exit(false);
|
|
|
|
|
|
|
|
// Analyze part after the colon
|
|
|
|
s := copy(AStr, p+1, Length(AStr));
|
2014-05-24 19:44:40 +00:00
|
|
|
Result := ParseCellString(s, ALastCellRow, ALastCellCol, f);
|
2014-04-08 09:48:30 +00:00
|
|
|
if not Result then exit;
|
|
|
|
|
|
|
|
// Analyze part before the colon
|
|
|
|
s := copy(AStr, 1, p-1);
|
|
|
|
Result := ParseCellString(s, AFirstCellRow, AFirstCellCol, AFlags);
|
2014-05-24 19:44:40 +00:00
|
|
|
|
|
|
|
// Add flags of 2nd part
|
|
|
|
if rfRelRow in f then Include(AFlags, rfRelRow2);
|
|
|
|
if rfRelCol in f then Include(AFlags, rfRelCol2);
|
2014-04-08 09:48:30 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-08-18 13:48:46 +00:00
|
|
|
Parses strings like A5:C10 into a range selection information.
|
|
|
|
Information on relative/absolute cells is ignored.
|
|
|
|
|
|
|
|
@param AStr Cell range string, such as A5:C10
|
|
|
|
@param AFirstCellRow Row index of the top/left cell of the range (output)
|
|
|
|
@param AFirstCellCol Column index of the top/left cell of the range (output)
|
|
|
|
@param ALastCellRow Row index of the bottom/right cell of the range (output)
|
|
|
|
@param ALastCellCol Column index of the bottom/right cell of the range (output)
|
|
|
|
@return false if the string is not a valid cell range
|
2014-09-21 16:50:56 +00:00
|
|
|
--------------------------------------------------------------------------------}
|
2014-08-18 13:48:46 +00:00
|
|
|
function ParseCellRangeString(const AStr: string;
|
|
|
|
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal): Boolean;
|
|
|
|
var
|
|
|
|
flags: TsRelFlags;
|
|
|
|
begin
|
2014-09-21 16:50:56 +00:00
|
|
|
Result := ParseCellRangeString(AStr,
|
|
|
|
AFirstCellRow, AFirstCellCol,
|
|
|
|
ALastCellRow, ALastCellCol,
|
|
|
|
flags
|
|
|
|
);
|
2014-08-18 13:48:46 +00:00
|
|
|
end;
|
|
|
|
|
2015-01-03 20:03:55 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Parses strings like A5:C10 into a range selection information.
|
|
|
|
Returns in AFlags also information on relative/absolute cells.
|
|
|
|
|
|
|
|
@param AStr Cell range string, such as A5:C10
|
|
|
|
@param ARange TsCellRange record of the zero-based row and column
|
|
|
|
indexes of the top/left and right/bottom corrners
|
|
|
|
@param AFlags a set containing an element for ARange.Row1 (top row),
|
|
|
|
ARange.Col1 (left column), ARange.Row2 (bottom row),
|
|
|
|
ARange.Col2 (right column) if they represent relative
|
|
|
|
cell addresses.
|
|
|
|
@return false if the string is not a valid cell range
|
|
|
|
--------------------------------------------------------------------------------}
|
|
|
|
function ParseCellRangeString(const AStr: String;
|
|
|
|
out ARange: TsCellRange; out AFlags: TsRelFlags): Boolean;
|
|
|
|
begin
|
|
|
|
Result := ParseCelLRangeString(AStr, ARange.Row1, ARange.Col1, ARange.Row2,
|
|
|
|
ARange.Col2, AFlags);
|
|
|
|
end;
|
|
|
|
|
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Parses strings like A5:C10 into a range selection information.
|
|
|
|
Information on relative/absolute cells is ignored.
|
|
|
|
|
|
|
|
@param AStr Cell range string, such as A5:C10
|
|
|
|
@param ARange TsCellRange record of the zero-based row and column
|
|
|
|
indexes of the top/left and right/bottom corrners
|
|
|
|
@return false if the string is not a valid cell range
|
|
|
|
--------------------------------------------------------------------------------}
|
|
|
|
function ParseCellRangeString(const AStr: String;
|
|
|
|
out ARange: TsCellRange): Boolean;
|
|
|
|
begin
|
|
|
|
Result := ParseCellRangeString(AStr, ARange.Row1, ARange.Col1, ARange.Row2,
|
|
|
|
ARange.Col2);
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2010-05-25 09:11:02 +00:00
|
|
|
Parses a cell string, like 'A1' into zero-based column and row numbers
|
2014-05-24 19:44:40 +00:00
|
|
|
Note that there can be several letters to address for more than 26 columns.
|
2014-04-08 09:48:30 +00:00
|
|
|
'AFlags' indicates relative addresses.
|
2014-05-24 19:44:40 +00:00
|
|
|
|
2014-06-23 21:49:20 +00:00
|
|
|
@param AStr Cell range string, such as A1
|
|
|
|
@param ACellRow Row index of the top/left cell of the range (output)
|
|
|
|
@param ACellCol Column index of the top/left cell of the range (output)
|
|
|
|
@param AFlags A set containing an element for ACellRow and/or ACellCol,
|
|
|
|
if they represent a relative cell address.
|
|
|
|
@return False if the string is not a valid cell range
|
|
|
|
|
|
|
|
@example "AMP$200" --> (rel) column 1029 (= 26*26*1 + 26*16 + 26 - 1)
|
|
|
|
(abs) row = 199 (abs)
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-07-02 15:14:58 +00:00
|
|
|
function ParseCellString(const AStr: String; out ACellRow, ACellCol: Cardinal;
|
2014-06-19 19:25:40 +00:00
|
|
|
out AFlags: TsRelFlags): Boolean;
|
2014-04-08 09:48:30 +00:00
|
|
|
|
2014-05-24 19:44:40 +00:00
|
|
|
function Scan(AStartPos: Integer): Boolean;
|
|
|
|
const
|
|
|
|
LETTERS = ['A'..'Z'];
|
|
|
|
DIGITS = ['0'..'9'];
|
|
|
|
var
|
|
|
|
i: Integer;
|
|
|
|
isAbs: Boolean;
|
|
|
|
begin
|
|
|
|
Result := false;
|
|
|
|
|
|
|
|
i := AStartPos;
|
|
|
|
// Scan letters
|
|
|
|
while (i <= Length(AStr)) do begin
|
|
|
|
if (UpCase(AStr[i]) in LETTERS) then begin
|
2014-08-12 14:52:57 +00:00
|
|
|
ACellCol := Cardinal(ord(UpCase(AStr[i])) - ord('A')) + 1 + ACellCol * 26;
|
2014-09-21 16:50:56 +00:00
|
|
|
if ACellCol >= MAX_COL_COUNT then
|
|
|
|
// too many columns (dropping this limitation could cause overflow
|
|
|
|
// if a too long string is passed
|
2014-08-30 18:03:22 +00:00
|
|
|
exit;
|
2014-05-24 19:44:40 +00:00
|
|
|
inc(i);
|
2010-05-25 09:11:02 +00:00
|
|
|
end
|
2014-05-24 19:44:40 +00:00
|
|
|
else
|
|
|
|
if (AStr[i] in DIGITS) or (AStr[i] = '$') then
|
|
|
|
break
|
|
|
|
else begin
|
|
|
|
ACellCol := 0;
|
|
|
|
exit; // Only letters or $ allowed
|
|
|
|
end;
|
2010-05-25 09:11:02 +00:00
|
|
|
end;
|
2014-05-24 19:44:40 +00:00
|
|
|
if AStartPos = 1 then Include(AFlags, rfRelCol);
|
|
|
|
|
2014-09-17 08:38:31 +00:00
|
|
|
if i > Length(AStr) then
|
|
|
|
exit;
|
|
|
|
|
2014-05-24 19:44:40 +00:00
|
|
|
isAbs := (AStr[i] = '$');
|
|
|
|
if isAbs then inc(i);
|
2010-05-25 09:11:02 +00:00
|
|
|
|
2014-08-21 22:04:35 +00:00
|
|
|
if i > Length(AStr) then
|
|
|
|
exit;
|
|
|
|
|
2014-05-24 19:44:40 +00:00
|
|
|
// Scan digits
|
|
|
|
while (i <= Length(AStr)) do begin
|
|
|
|
if (AStr[i] in DIGITS) then begin
|
2014-08-12 14:52:57 +00:00
|
|
|
ACellRow := Cardinal(ord(AStr[i]) - ord('0')) + ACellRow * 10;
|
2014-05-24 19:44:40 +00:00
|
|
|
inc(i);
|
2010-05-25 09:11:02 +00:00
|
|
|
end
|
2014-05-24 19:44:40 +00:00
|
|
|
else begin
|
|
|
|
ACellCol := 0;
|
|
|
|
ACellRow := 0;
|
|
|
|
AFlags := [];
|
|
|
|
exit;
|
|
|
|
end;
|
2010-05-25 09:11:02 +00:00
|
|
|
end;
|
|
|
|
|
2014-05-24 19:44:40 +00:00
|
|
|
dec(ACellCol);
|
|
|
|
dec(ACellRow);
|
|
|
|
if not isAbs then Include(AFlags, rfRelRow);
|
2010-05-25 09:11:02 +00:00
|
|
|
|
2014-05-24 19:44:40 +00:00
|
|
|
Result := true;
|
2010-05-25 09:11:02 +00:00
|
|
|
end;
|
|
|
|
|
2014-05-24 19:44:40 +00:00
|
|
|
begin
|
|
|
|
ACellCol := 0;
|
|
|
|
ACellRow := 0;
|
|
|
|
AFlags := [];
|
|
|
|
|
|
|
|
if AStr = '' then
|
|
|
|
Exit(false);
|
|
|
|
|
|
|
|
if (AStr[1] = '$') then
|
|
|
|
Result := Scan(2)
|
|
|
|
else
|
|
|
|
Result := Scan(1);
|
2010-05-25 09:11:02 +00:00
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Parses a cell string, like 'A1' into zero-based column and row numbers
|
|
|
|
Note that there can be several letters to address for more than 26 columns.
|
|
|
|
|
|
|
|
For compatibility with old version which does not return flags for relative
|
|
|
|
cell addresses.
|
|
|
|
|
|
|
|
@param AStr Cell range string, such as A1
|
|
|
|
@param ACellRow Row index of the top/left cell of the range (output)
|
|
|
|
@param ACellCol Column index of the top/left cell of the range (output)
|
|
|
|
@return False if the string is not a valid cell range
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-04-08 09:48:30 +00:00
|
|
|
function ParseCellString(const AStr: string;
|
2014-07-02 15:14:58 +00:00
|
|
|
out ACellRow, ACellCol: Cardinal): Boolean;
|
2014-04-08 09:48:30 +00:00
|
|
|
var
|
|
|
|
flags: TsRelFlags;
|
|
|
|
begin
|
2014-06-19 19:25:40 +00:00
|
|
|
Result := ParseCellString(AStr, ACellRow, ACellCol, flags);
|
2014-04-08 09:48:30 +00:00
|
|
|
end;
|
|
|
|
|
2015-02-22 23:38:28 +00:00
|
|
|
function ParseSheetCellString(const AStr: String; out ASheetName: String;
|
|
|
|
out ACellRow, ACellCol: Cardinal): Boolean;
|
|
|
|
var
|
|
|
|
p: Integer;
|
|
|
|
begin
|
|
|
|
p := UTF8Pos('!', AStr);
|
|
|
|
if p = 0 then begin
|
|
|
|
Result := ParseCellString(AStr, ACellRow, ACellCol);
|
|
|
|
ASheetName := '';
|
|
|
|
end else begin
|
|
|
|
ASheetName := UTF8Copy(AStr, 1, p-1);
|
|
|
|
Result := ParseCellString(UTF8Copy(AStr, p+1, UTF8Length(AStr)), ACellRow, ACellCol);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Parses a cell row string to a zero-based row number.
|
|
|
|
|
|
|
|
@param AStr Cell row string, such as '1', 1-based!
|
|
|
|
@param AResult Index of the row (zero-based!) (putput)
|
|
|
|
@return False if the string is not a valid cell row string
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-07-02 15:14:58 +00:00
|
|
|
function ParseCellRowString(const AStr: string; out AResult: Cardinal): Boolean;
|
2010-05-25 09:11:02 +00:00
|
|
|
begin
|
|
|
|
try
|
|
|
|
AResult := StrToInt(AStr) - 1;
|
|
|
|
except
|
|
|
|
Result := False;
|
|
|
|
end;
|
|
|
|
Result := True;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Parses a cell column string, like 'A' or 'CZ', into a zero-based column number.
|
|
|
|
Note that there can be several letters to address more than 26 columns.
|
|
|
|
|
|
|
|
@param AStr Cell range string, such as A1
|
|
|
|
@param AResult Zero-based index of the column (output)
|
|
|
|
@return False if the string is not a valid cell column string
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-07-02 15:14:58 +00:00
|
|
|
function ParseCellColString(const AStr: string; out AResult: Cardinal): Boolean;
|
2010-05-25 09:11:02 +00:00
|
|
|
const
|
|
|
|
INT_NUM_LETTERS = 26;
|
|
|
|
begin
|
|
|
|
Result := False;
|
|
|
|
AResult := 0;
|
|
|
|
|
|
|
|
if Length(AStr) = 1 then AResult := Ord(AStr[1]) - Ord('A')
|
|
|
|
else if Length(AStr) = 2 then
|
|
|
|
begin
|
|
|
|
AResult := (Ord(AStr[1]) - Ord('A') + 1) * INT_NUM_LETTERS
|
|
|
|
+ Ord(AStr[2]) - Ord('A');
|
|
|
|
end
|
2014-04-08 09:48:30 +00:00
|
|
|
else if Length(AStr) = 3 then
|
|
|
|
begin
|
|
|
|
AResult := (Ord(AStr[1]) - Ord('A') + 1) * INT_NUM_LETTERS * INT_NUM_LETTERS
|
|
|
|
+ (Ord(AStr[2]) - Ord('A') + 1) * INT_NUM_LETTERS
|
|
|
|
+ Ord(AStr[3]) - Ord('A');
|
|
|
|
end
|
2010-05-25 09:11:02 +00:00
|
|
|
else Exit(False);
|
|
|
|
|
|
|
|
Result := True;
|
|
|
|
end;
|
|
|
|
|
2014-04-19 19:29:13 +00:00
|
|
|
function Letter(AValue: Integer): char;
|
|
|
|
begin
|
|
|
|
Result := Char(AValue + ord('A'));
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Calculates an Excel column name ('A', 'B' etc) from the zero-based column index
|
|
|
|
|
|
|
|
@param AColIndex Zero-based column index
|
|
|
|
@return Letter-based column name string. Can contain several letter in case of
|
|
|
|
more than 26 columns
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-04-19 19:29:13 +00:00
|
|
|
function GetColString(AColIndex: Integer): String;
|
2014-09-21 16:50:56 +00:00
|
|
|
{ Code adapted from:
|
|
|
|
http://stackoverflow.com/questions/12796973/vba-function-to-convert-column-number-to-letter }
|
2014-05-25 16:49:45 +00:00
|
|
|
var
|
|
|
|
n: Integer;
|
|
|
|
c: byte;
|
2014-04-19 19:29:13 +00:00
|
|
|
begin
|
2014-05-25 16:49:45 +00:00
|
|
|
Result := '';
|
|
|
|
n := AColIndex + 1;
|
|
|
|
while (n > 0) do begin
|
|
|
|
c := (n - 1) mod 26;
|
|
|
|
Result := char(c + ord('A')) + Result;
|
|
|
|
n := (n - c) div 26;
|
|
|
|
end;
|
2014-04-19 19:29:13 +00:00
|
|
|
end;
|
|
|
|
|
2014-05-23 23:13:49 +00:00
|
|
|
const
|
|
|
|
RELCHAR: Array[boolean] of String = ('$', '');
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Calculates a cell address string from zero-based column and row indexes and
|
|
|
|
the relative address state flags.
|
|
|
|
|
|
|
|
@param ARowIndex Zero-based row index
|
|
|
|
@param AColIndex Zero-based column index
|
2014-08-07 22:24:22 +00:00
|
|
|
@param AFlags An optional set containing an entry for column and row
|
|
|
|
if these addresses are relative. By default, relative
|
|
|
|
addresses are assumed.
|
2014-07-04 08:48:12 +00:00
|
|
|
@return Excel type of cell address containing $ characters for absolute
|
2014-06-23 21:49:20 +00:00
|
|
|
address parts.
|
2014-07-04 08:48:12 +00:00
|
|
|
@example ARowIndex = 0, AColIndex = 0, AFlags = [rfRelRow] --> $A1
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-08-07 22:24:22 +00:00
|
|
|
function GetCellString(ARow, ACol: Cardinal;
|
|
|
|
AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
|
2014-05-23 23:13:49 +00:00
|
|
|
begin
|
|
|
|
Result := Format('%s%s%s%d', [
|
|
|
|
RELCHAR[rfRelCol in AFlags], GetColString(ACol),
|
|
|
|
RELCHAR[rfRelRow in AFlags], ARow+1
|
|
|
|
]);
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Calculates a cell range address string from zero-based column and row indexes
|
|
|
|
and the relative address state flags.
|
|
|
|
|
|
|
|
@param ARow1 Zero-based index of the first row in the range
|
|
|
|
@param ACol1 Zero-based index of the first column in the range
|
|
|
|
@param ARow2 Zero-based index of the last row in the range
|
|
|
|
@param ACol2 Zero-based index of the last column in the range
|
|
|
|
@param AFlags A set containing an entry for first and last column and
|
|
|
|
row if their addresses are relative.
|
2014-12-16 18:28:41 +00:00
|
|
|
@param Compact If the range consists only of a single cell and compact
|
|
|
|
is true then the simple cell string is returned (e.g. A1).
|
|
|
|
If compact is false then the cell is repeated (e.g. A1:A1)
|
2014-07-04 08:48:12 +00:00
|
|
|
@return Excel type of cell address range containing '$' characters for absolute
|
2014-06-23 21:49:20 +00:00
|
|
|
address parts and a ':' to separate the first and last cells of the
|
|
|
|
range
|
2014-07-04 08:48:12 +00:00
|
|
|
@example ARow1 = 0, ACol1 = 0, ARow = 2, ACol = 1, AFlags = [rfRelRow, rfRelRow2]
|
2014-06-23 21:49:20 +00:00
|
|
|
--> $A1:$B3
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-08-18 13:48:46 +00:00
|
|
|
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
|
2015-01-03 20:03:55 +00:00
|
|
|
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String;
|
2014-05-23 23:13:49 +00:00
|
|
|
begin
|
2014-11-05 23:45:48 +00:00
|
|
|
if Compact and (ARow1 = ARow2) and (ACol1 = ACol2) then
|
|
|
|
Result := GetCellString(ARow1, ACol1, AFlags)
|
|
|
|
else
|
|
|
|
Result := Format('%s%s%s%d:%s%s%s%d', [
|
|
|
|
RELCHAR[rfRelCol in AFlags], GetColString(ACol1),
|
|
|
|
RELCHAR[rfRelRow in AFlags], ARow1 + 1,
|
|
|
|
RELCHAR[rfRelCol2 in AFlags], GetColString(ACol2),
|
|
|
|
RELCHAR[rfRelRow2 in AFlags], ARow2 + 1
|
|
|
|
]);
|
2014-05-23 23:13:49 +00:00
|
|
|
end;
|
|
|
|
|
2015-01-03 20:03:55 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Calculates a cell range address string from a TsCellRange record
|
|
|
|
and the relative address state flags.
|
|
|
|
|
|
|
|
@param ARange TsCellRange record containing the zero-based indexes of
|
|
|
|
the first and last row and columns of the range
|
|
|
|
@param AFlags A set containing an entry for first and last column and
|
|
|
|
row if their addresses are relative.
|
|
|
|
@param Compact If the range consists only of a single cell and compact
|
|
|
|
is true then the simple cell string is returned (e.g. A1).
|
|
|
|
If compact is false then the cell is repeated (e.g. A1:A1)
|
|
|
|
@return Excel type of cell address range containing '$' characters for absolute
|
|
|
|
address parts and a ':' to separate the first and last cells of the
|
|
|
|
range
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function GetCellRangeString(ARange: TsCellRange;
|
|
|
|
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String;
|
|
|
|
begin
|
|
|
|
Result := GetCellRangeString(ARange.Row1, ARange.Col1, ARange.Row2, ARange.Col2,
|
|
|
|
AFlags, Compact);
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Returns the message text assigned to an error value
|
|
|
|
|
|
|
|
@param AErrorValue Error code as defined by TsErrorvalue
|
|
|
|
@return Text corresponding to the error code.
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-05-25 16:49:45 +00:00
|
|
|
function GetErrorValueStr(AErrorValue: TsErrorValue): String;
|
|
|
|
begin
|
|
|
|
case AErrorValue of
|
|
|
|
errOK : Result := '';
|
|
|
|
errEmptyIntersection : Result := '#NULL!';
|
|
|
|
errDivideByZero : Result := '#DIV/0!';
|
|
|
|
errWrongType : Result := '#VALUE!';
|
|
|
|
errIllegalRef : Result := '#REF!';
|
|
|
|
errWrongName : Result := '#NAME?';
|
|
|
|
errOverflow : Result := '#NUM!';
|
|
|
|
errArgError : Result := '#N/A';
|
|
|
|
// --- no Excel errors --
|
|
|
|
errFormulaNotSupported : Result := '#FORMULA?';
|
|
|
|
else Result := '#UNKNOWN ERROR';
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-02-25 09:43:37 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Returns the name of the given spreadsheet file format.
|
|
|
|
|
|
|
|
@param AFormat Identifier of the file format
|
|
|
|
@return 'BIFF2', 'BIFF3', 'BIFF4', 'BIFF5', 'BIFF8', 'OOXML', 'Open Document',
|
|
|
|
'CSV, 'WikiTable Pipes', or 'WikiTable WikiMedia"
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function GetFileFormatName(AFormat: TsSpreadsheetFormat): string;
|
|
|
|
begin
|
|
|
|
case AFormat of
|
|
|
|
sfExcel2 : Result := 'BIFF2';
|
|
|
|
sfExcel5 : Result := 'BIFF5';
|
|
|
|
sfExcel8 : Result := 'BIFF8';
|
|
|
|
sfooxml : Result := 'OOXML';
|
|
|
|
sfOpenDocument : Result := 'Open Document';
|
|
|
|
sfCSV : Result := 'CSV';
|
2015-07-28 22:13:48 +00:00
|
|
|
sfHTML : Result := 'HTML';
|
2015-02-25 09:43:37 +00:00
|
|
|
sfWikiTable_Pipes : Result := 'WikiTable Pipes';
|
|
|
|
sfWikiTable_WikiMedia : Result := 'WikiTable WikiMedia';
|
|
|
|
else Result := rsUnknownSpreadsheetFormat;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-03-08 00:50:10 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Returns the default extension of each spreadsheet file format
|
|
|
|
|
|
|
|
@param AFormat Identifier of the file format
|
|
|
|
@retur File extension
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function GetFileFormatExt(AFormat: TsSpreadsheetFormat): String;
|
|
|
|
begin
|
|
|
|
case AFormat of
|
|
|
|
sfExcel2,
|
|
|
|
sfExcel5,
|
|
|
|
sfExcel8 : Result := STR_EXCEL_EXTENSION;
|
|
|
|
sfOOXML : Result := STR_OOXML_EXCEL_EXTENSION;
|
|
|
|
sfOpenDocument : Result := STR_OPENDOCUMENT_CALC_EXTENSION;
|
|
|
|
sfCSV : Result := STR_COMMA_SEPARATED_EXTENSION;
|
2015-07-28 22:13:48 +00:00
|
|
|
sfHTML : Result := STR_HTML_EXTENSION;
|
2015-03-08 00:50:10 +00:00
|
|
|
sfWikiTable_Pipes : Result := STR_WIKITABLE_PIPES_EXTENSION;
|
|
|
|
sfWikiTable_WikiMedia : Result := STR_WIKITABLE_WIKIMEDIA_EXTENSION;
|
|
|
|
else raise Exception.Create(rsUnknownSpreadsheetFormat);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Determines the spreadsheet type from the file type extension
|
|
|
|
|
|
|
|
@param AFileName Name of the file to be considered
|
|
|
|
@param SheetType File format found from analysis of the extension (output)
|
|
|
|
@return True if the file matches any of the known formats, false otherwise
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function GetFormatFromFileName(const AFileName: TFileName;
|
|
|
|
out SheetType: TsSpreadsheetFormat): Boolean;
|
|
|
|
var
|
|
|
|
suffix: String;
|
|
|
|
begin
|
|
|
|
Result := true;
|
|
|
|
suffix := Lowercase(ExtractFileExt(AFileName));
|
|
|
|
case suffix of
|
|
|
|
STR_EXCEL_EXTENSION : SheetType := sfExcel8;
|
|
|
|
STR_OOXML_EXCEL_EXTENSION : SheetType := sfOOXML;
|
|
|
|
STR_OPENDOCUMENT_CALC_EXTENSION : SheetType := sfOpenDocument;
|
|
|
|
STR_COMMA_SEPARATED_EXTENSION : SheetType := sfCSV;
|
2015-07-28 22:13:48 +00:00
|
|
|
STR_HTML_EXTENSION, '.htm' : SheetType := sfHTML;
|
2015-03-08 00:50:10 +00:00
|
|
|
STR_WIKITABLE_PIPES_EXTENSION : SheetType := sfWikiTable_Pipes;
|
|
|
|
STR_WIKITABLE_WIKIMEDIA_EXTENSION : SheetType := sfWikiTable_WikiMedia;
|
|
|
|
else Result := False;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Helper function to reduce typing: "if a conditions is true return the first
|
|
|
|
number format, otherwise return the second format"
|
|
|
|
|
|
|
|
@param ACondition Boolean expression
|
|
|
|
@param AValue1 First built-in number format code
|
|
|
|
@param AValue2 Second built-in number format code
|
|
|
|
@return AValue1 if ACondition is true, AValue2 otherwise.
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function IfThen(ACondition: Boolean;
|
|
|
|
AValue1, AValue2: TsNumberFormat): TsNumberFormat;
|
2014-05-20 16:13:48 +00:00
|
|
|
begin
|
|
|
|
if ACondition then Result := AValue1 else Result := AValue2;
|
|
|
|
end;
|
|
|
|
|
2015-03-31 19:01:16 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Approximates a floating point value as a fraction and returns the values of
|
|
|
|
numerator and denominator.
|
|
|
|
|
|
|
|
@param AValue Floating point value to be analyzed
|
|
|
|
@param AMaxDenominator Maximum value of the denominator allowed
|
|
|
|
@param ANumerator (out) Numerator of the best approximating fraction
|
|
|
|
@param ADenominator (out) Denominator of the best approximating fraction
|
|
|
|
-------------------------------------------------------------------------------}
|
2015-05-19 10:55:18 +00:00
|
|
|
procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64;
|
|
|
|
out ANumerator, ADenominator: Int64);
|
2015-04-18 14:58:38 +00:00
|
|
|
// Uses method of continued fractions, adapted version from a function in
|
|
|
|
// Bart Broersma's fractions.pp unit:
|
|
|
|
// http://svn.code.sf.net/p/flyingsheep/code/trunk/ConsoleProjecten/fractions/
|
|
|
|
const
|
|
|
|
MaxInt64 = High(Int64);
|
|
|
|
MinInt64 = Low(Int64);
|
2015-03-31 19:01:16 +00:00
|
|
|
var
|
2015-04-18 14:58:38 +00:00
|
|
|
H1, H2, K1, K2, A, NewA, tmp, prevH1, prevK1: Int64;
|
2015-05-19 10:55:18 +00:00
|
|
|
B, test, diff, prevdiff: Double;
|
2015-04-19 22:03:33 +00:00
|
|
|
PendingOverflow: Boolean;
|
2015-04-18 14:58:38 +00:00
|
|
|
i: Integer = 0;
|
2015-03-31 19:01:16 +00:00
|
|
|
begin
|
2015-04-18 14:58:38 +00:00
|
|
|
if (AValue > MaxInt64) or (AValue < MinInt64) then
|
|
|
|
raise Exception.Create('Range error');
|
2015-03-31 19:01:16 +00:00
|
|
|
|
2015-04-18 14:58:38 +00:00
|
|
|
if abs(AValue) < 0.5 / AMaxDenominator then
|
2015-03-31 19:01:16 +00:00
|
|
|
begin
|
2015-04-18 14:58:38 +00:00
|
|
|
ANumerator := 0;
|
|
|
|
ADenominator := AMaxDenominator;
|
|
|
|
exit;
|
|
|
|
end;
|
2015-03-31 19:01:16 +00:00
|
|
|
|
2015-04-18 14:58:38 +00:00
|
|
|
H1 := 1;
|
|
|
|
H2 := 0;
|
|
|
|
K1 := 0;
|
|
|
|
K2 := 1;
|
|
|
|
B := AValue;
|
|
|
|
NewA := Round(Floor(B));
|
|
|
|
prevH1 := H1;
|
|
|
|
prevK1 := K1;
|
2015-05-19 10:55:18 +00:00
|
|
|
prevdiff := 1E308;
|
2015-04-18 14:58:38 +00:00
|
|
|
repeat
|
|
|
|
inc(i);
|
|
|
|
A := NewA;
|
|
|
|
tmp := H1;
|
|
|
|
H1 := A * H1 + H2;
|
|
|
|
H2 := tmp;
|
|
|
|
tmp := K1;
|
|
|
|
K1 := A * K1 + K2;
|
|
|
|
K2 := tmp;
|
|
|
|
test := H1/K1;
|
|
|
|
diff := test - AValue;
|
2015-05-19 10:55:18 +00:00
|
|
|
{ Use the previous result if the denominator becomes larger than the allowed
|
|
|
|
value, or if the difference becomes worse because the "best" result has
|
|
|
|
been missed due to rounding error - this is more stable than using a
|
|
|
|
predefined precision in comparing diff with zero. }
|
|
|
|
if (abs(K1) >= AMaxDenominator) or (abs(diff) > abs(prevdiff)) then
|
2015-03-31 19:01:16 +00:00
|
|
|
begin
|
2015-04-18 14:58:38 +00:00
|
|
|
H1 := prevH1;
|
|
|
|
K1 := prevK1;
|
|
|
|
break;
|
2015-03-31 19:01:16 +00:00
|
|
|
end;
|
2015-04-18 14:58:38 +00:00
|
|
|
if (Abs(B - A) < 1E-30) then
|
|
|
|
B := 1E30 //happens when H1/K1 exactly matches Value
|
|
|
|
else
|
|
|
|
B := 1 / (B - A);
|
|
|
|
PendingOverFlow := (B * H1 + H2 > MaxInt64) or
|
|
|
|
(B * K1 + K2 > MaxInt64) or
|
|
|
|
(B > MaxInt64);
|
|
|
|
if not PendingOverflow then
|
|
|
|
NewA := Round(Floor(B));
|
|
|
|
prevH1 := H1;
|
|
|
|
prevK1 := K1;
|
2015-05-19 10:55:18 +00:00
|
|
|
prevdiff := diff;
|
2015-04-18 14:58:38 +00:00
|
|
|
until PendingOverflow;
|
|
|
|
ANumerator := H1;
|
|
|
|
ADenominator := K1;
|
2015-03-31 19:01:16 +00:00
|
|
|
end;
|
|
|
|
|
2014-10-19 21:20:57 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Converts a string to a floating point number. No assumption on decimal and
|
|
|
|
thousand separator are made.
|
|
|
|
Is needed for reading CSV files.
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function TryStrToFloatAuto(AText: String; out ANumber: Double;
|
2014-10-20 21:04:20 +00:00
|
|
|
out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean;
|
2014-10-19 21:20:57 +00:00
|
|
|
var
|
2014-10-20 09:22:06 +00:00
|
|
|
i: Integer;
|
2014-10-19 21:20:57 +00:00
|
|
|
testSep: Char;
|
|
|
|
testSepPos: Integer;
|
2014-10-20 21:04:20 +00:00
|
|
|
lastDigitPos: Integer;
|
2014-10-19 21:20:57 +00:00
|
|
|
isPercent: Boolean;
|
|
|
|
fs: TFormatSettings;
|
|
|
|
done: Boolean;
|
|
|
|
begin
|
|
|
|
Result := false;
|
|
|
|
AWarning := '';
|
2014-10-20 21:04:20 +00:00
|
|
|
ADecimalSeparator := #0;
|
|
|
|
AThousandSeparator := #0;
|
2014-10-19 21:20:57 +00:00
|
|
|
if AText = '' then
|
|
|
|
exit;
|
|
|
|
|
|
|
|
fs := DefaultFormatSettings;
|
|
|
|
|
|
|
|
// We scan the string starting from its end. If we find a point or a comma,
|
|
|
|
// we have a candidate for the decimal or thousand separator. If we find
|
|
|
|
// the same character again it was a thousand separator, if not it was
|
|
|
|
// a decimal separator.
|
|
|
|
|
|
|
|
// There is one amgiguity: Using a thousand separator for number < 1.000.000,
|
|
|
|
// but no decimal separator misinterprets the thousand separator as a
|
|
|
|
// decimal separator.
|
|
|
|
|
2014-10-20 21:04:20 +00:00
|
|
|
done := false; // Indicates that both decimal and thousand separators are found
|
|
|
|
testSep := #0; // Separator candidate to be tested
|
|
|
|
testSepPos := 0; // Position of this separator candidate in the string
|
|
|
|
lastDigitPos := 0; // Position of the last numerical digit
|
|
|
|
isPercent := false; // Flag for percentage format
|
|
|
|
|
2014-10-19 21:20:57 +00:00
|
|
|
i := Length(AText); // Start at end...
|
|
|
|
while i >= 1 do // ...and search towards start
|
|
|
|
begin
|
2014-10-20 21:04:20 +00:00
|
|
|
case AText[i] of
|
|
|
|
'0'..'9':
|
|
|
|
if (lastDigitPos = 0) and (AText[i] in ['0'..'9']) then
|
|
|
|
lastDigitPos := i;
|
|
|
|
|
|
|
|
'e', 'E':
|
2014-12-31 16:50:31 +00:00
|
|
|
;
|
2014-10-20 21:04:20 +00:00
|
|
|
|
|
|
|
'%':
|
2014-10-20 21:52:53 +00:00
|
|
|
begin
|
|
|
|
isPercent := true;
|
|
|
|
// There may be spaces before the % sign which we don't want
|
|
|
|
dec(i);
|
|
|
|
while (i >= 1) do
|
|
|
|
if AText[i] = ' ' then
|
|
|
|
dec(i)
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
inc(i);
|
|
|
|
break;
|
|
|
|
end;
|
|
|
|
end;
|
2014-10-20 21:04:20 +00:00
|
|
|
|
|
|
|
'+', '-':
|
|
|
|
;
|
|
|
|
|
|
|
|
'.', ',':
|
2014-10-19 21:20:57 +00:00
|
|
|
begin
|
2014-10-20 21:04:20 +00:00
|
|
|
if testSep = #0 then begin
|
|
|
|
testSep := AText[i];
|
|
|
|
testSepPos := i;
|
|
|
|
end;
|
|
|
|
// This is the right-most separator candidate in the text
|
|
|
|
// It can be a decimal or a thousand separator.
|
|
|
|
// Therefore, we continue searching from here.
|
|
|
|
dec(i);
|
|
|
|
while i >= 1 do
|
2014-10-20 16:14:59 +00:00
|
|
|
begin
|
2014-10-20 23:17:07 +00:00
|
|
|
if not (AText[i] in ['0'..'9', '+', '-', '.', ',']) then
|
2014-10-20 21:04:20 +00:00
|
|
|
exit;
|
|
|
|
|
2014-10-20 23:17:07 +00:00
|
|
|
// If we find the testSep character again it must be a thousand separator,
|
|
|
|
// and there are no decimals.
|
2014-10-20 21:04:20 +00:00
|
|
|
if (AText[i] = testSep) then
|
|
|
|
begin
|
|
|
|
// ... but only if there are 3 numerical digits in between
|
|
|
|
if (testSepPos - i = 4) then
|
|
|
|
begin
|
|
|
|
fs.ThousandSeparator := testSep;
|
|
|
|
// The decimal separator is the "other" character.
|
|
|
|
if testSep = '.' then
|
|
|
|
fs.DecimalSeparator := ','
|
|
|
|
else
|
|
|
|
fs.DecimalSeparator := '.';
|
|
|
|
AThousandSeparator := fs.ThousandSeparator;
|
2014-10-20 23:17:07 +00:00
|
|
|
ADecimalSeparator := #0; // this indicates that there are no decimals
|
2014-10-20 21:04:20 +00:00
|
|
|
done := true;
|
|
|
|
i := 0;
|
|
|
|
end else
|
|
|
|
begin
|
|
|
|
Result := false;
|
|
|
|
exit;
|
|
|
|
end;
|
|
|
|
end
|
2014-10-20 16:14:59 +00:00
|
|
|
else
|
2014-10-20 21:04:20 +00:00
|
|
|
// If we find the "other" separator character, then testSep was a
|
|
|
|
// decimal separator and the current character is a thousand separator.
|
|
|
|
// But there must be 3 digits in between.
|
|
|
|
if AText[i] in ['.', ','] then
|
|
|
|
begin
|
|
|
|
if testSepPos - i <> 4 then // no 3 digits in between --> no number, maybe a date.
|
|
|
|
exit;
|
|
|
|
fs.DecimalSeparator := testSep;
|
|
|
|
fs.ThousandSeparator := AText[i];
|
|
|
|
ADecimalSeparator := fs.DecimalSeparator;
|
|
|
|
AThousandSeparator := fs.ThousandSeparator;
|
|
|
|
done := true;
|
|
|
|
i := 0;
|
|
|
|
end;
|
|
|
|
dec(i);
|
2014-10-20 16:14:59 +00:00
|
|
|
end;
|
2014-10-19 21:20:57 +00:00
|
|
|
end;
|
2014-10-20 21:04:20 +00:00
|
|
|
|
|
|
|
else
|
|
|
|
exit; // Non-numeric character found, no need to continue
|
|
|
|
|
2014-10-19 21:20:57 +00:00
|
|
|
end;
|
|
|
|
dec(i);
|
|
|
|
end;
|
|
|
|
|
|
|
|
// Only one separator candicate found, we assume it is a decimal separator
|
|
|
|
if (testSep <> #0) and not done then
|
|
|
|
begin
|
|
|
|
// Warning in case of ambiguous detection of separator. If only one separator
|
|
|
|
// type is found and it is at the third position from the string's end it
|
|
|
|
// might by a thousand separator or a decimal separator. We assume the
|
|
|
|
// latter case, but create a warning.
|
2014-10-20 21:04:20 +00:00
|
|
|
if (lastDigitPos - testSepPos = 3) and not isPercent then
|
2014-10-19 21:20:57 +00:00
|
|
|
AWarning := Format(rsAmbiguousDecThouSeparator, [AText]);
|
|
|
|
fs.DecimalSeparator := testSep;
|
2014-10-20 21:04:20 +00:00
|
|
|
ADecimalSeparator := fs.DecimalSeparator;
|
2014-10-19 21:20:57 +00:00
|
|
|
// Make sure that the thousand separator is different from the decimal sep.
|
|
|
|
if testSep = '.' then fs.ThousandSeparator := ',' else fs.ThousandSeparator := '.';
|
|
|
|
end;
|
|
|
|
|
|
|
|
// Delete all thousand separators from the string - StrToFloat does not like them...
|
|
|
|
AText := StringReplace(AText, fs.ThousandSeparator, '', [rfReplaceAll]);
|
|
|
|
|
|
|
|
// Is the last character a percent sign?
|
|
|
|
if isPercent then
|
|
|
|
while (Length(AText) > 0) and (AText[Length(AText)] in ['%', ' ']) do
|
|
|
|
Delete(AText, Length(AText), 1);
|
|
|
|
|
|
|
|
// Try string-to-number conversion
|
|
|
|
Result := TryStrToFloat(AText, ANumber, fs);
|
|
|
|
|
2014-10-20 21:04:20 +00:00
|
|
|
// If successful ...
|
|
|
|
if Result then
|
|
|
|
begin
|
|
|
|
// ... take care of the percentage sign
|
|
|
|
if isPercent then
|
|
|
|
ANumber := ANumber * 0.01;
|
|
|
|
end;
|
2014-10-19 21:20:57 +00:00
|
|
|
end;
|
|
|
|
|
2015-03-31 19:01:16 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Assumes that the specified text is a string representation of a mathematical
|
|
|
|
fraction and tries to extract the floating point value of this number.
|
|
|
|
Returns also the maximum count of digits used in the numerator or
|
|
|
|
denominator of the fraction
|
|
|
|
|
|
|
|
@param AText String to be considered
|
|
|
|
@param ANumber (out) value of the converted floating point number
|
|
|
|
@param AMaxDigits Maximum count of digits used in the numerator or
|
|
|
|
denominator of the fraction
|
|
|
|
|
|
|
|
@return TRUE if a number value can be retrieved successfully, FALSE otherwise
|
|
|
|
|
|
|
|
@example AText := '1 3/4' --> ANumber = 1.75; AMaxDigits = 1; Result = true
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function TryFractionStrToFloat(AText: String; out ANumber: Double;
|
2015-05-19 16:18:01 +00:00
|
|
|
out AIsMixed: Boolean; out AMaxDigits: Integer): Boolean;
|
2015-03-31 19:01:16 +00:00
|
|
|
var
|
|
|
|
p: Integer;
|
|
|
|
s, sInt, sNum, sDenom: String;
|
|
|
|
i,num,denom: Integer;
|
|
|
|
begin
|
|
|
|
Result := false;
|
|
|
|
s := '';
|
|
|
|
sInt := '';
|
|
|
|
sNum := '';
|
|
|
|
sDenom := '';
|
|
|
|
|
|
|
|
p := 1;
|
|
|
|
while p <= Length(AText) do begin
|
|
|
|
case AText[p] of
|
|
|
|
'0'..'9': s := s + AText[p];
|
|
|
|
' ': begin sInt := s; s := ''; end;
|
|
|
|
'/': begin sNum := s; s := ''; end;
|
|
|
|
else exit;
|
|
|
|
end;
|
|
|
|
inc(p);
|
|
|
|
end;
|
|
|
|
sDenom := s;
|
|
|
|
|
|
|
|
if (sInt <> '') and not TryStrToInt(sInt, i) then
|
|
|
|
exit;
|
|
|
|
if (sNum = '') or not TryStrtoInt(sNum, num) then
|
|
|
|
exit;
|
|
|
|
if (sDenom = '') or not TryStrToInt(sDenom, denom) then
|
|
|
|
exit;
|
|
|
|
if denom = 0 then
|
|
|
|
exit;
|
|
|
|
|
|
|
|
ANumber := num / denom;
|
|
|
|
if sInt <> '' then
|
|
|
|
ANumber := ANumber + i;
|
|
|
|
|
2015-05-19 16:18:01 +00:00
|
|
|
AIsMixed := (sInt <> '');
|
2015-03-31 19:01:16 +00:00
|
|
|
AMaxDigits := Length(sDenom);
|
|
|
|
|
|
|
|
Result := true;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Excel's unit of row heights is "twips", i.e. 1/20 point.
|
|
|
|
Converts Twips to points.
|
|
|
|
|
|
|
|
@param AValue Length value in twips
|
|
|
|
@return Value converted to points
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-06-13 20:32:58 +00:00
|
|
|
function TwipsToPts(AValue: Integer): Single;
|
|
|
|
begin
|
|
|
|
Result := AValue / 20;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts points to twips (1 twip = 1/20 point)
|
|
|
|
|
|
|
|
@param AValue Length value in points
|
|
|
|
@return Value converted to twips
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-06-13 20:32:58 +00:00
|
|
|
function PtsToTwips(AValue: Single): Integer;
|
|
|
|
begin
|
|
|
|
Result := round(AValue * 20);
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts centimeters to points (72 pts = 1 inch)
|
|
|
|
|
|
|
|
@param AValue Length value in centimeters
|
|
|
|
@return Value converted to points
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-06-13 20:32:58 +00:00
|
|
|
function cmToPts(AValue: Double): Double;
|
|
|
|
begin
|
|
|
|
Result := AValue * 72 / 2.54;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts points to centimeters
|
|
|
|
|
|
|
|
@param AValue Length value in points
|
|
|
|
@return Value converted to centimeters
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-06-13 20:32:58 +00:00
|
|
|
function PtsToCm(AValue: Double): Double;
|
|
|
|
begin
|
|
|
|
Result := AValue / 72 * 2.54;
|
|
|
|
end;
|
|
|
|
|
2015-04-30 21:55:55 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Converts inches to millimeters
|
|
|
|
|
|
|
|
@param AValue Length value in inches
|
|
|
|
@return Value converted to mm
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function InToMM(AValue: Double): Double;
|
|
|
|
begin
|
|
|
|
Result := AValue * 25.4;
|
|
|
|
end;
|
|
|
|
|
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Converts millimeters to inches
|
|
|
|
|
|
|
|
@param AValue Length value in millimeters
|
|
|
|
@return Value converted to inches
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function mmToIn(AValue: Double): Double;
|
|
|
|
begin
|
|
|
|
Result := AValue / 25.4;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts inches to points (72 pts = 1 inch)
|
|
|
|
|
|
|
|
@param AValue Length value in inches
|
|
|
|
@return Value converted to points
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-06-13 20:32:58 +00:00
|
|
|
function InToPts(AValue: Double): Double;
|
|
|
|
begin
|
|
|
|
Result := AValue * 72;
|
|
|
|
end;
|
|
|
|
|
2015-04-29 20:00:07 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Converts points to inches (72 pts = 1 inch)
|
|
|
|
|
|
|
|
@param AValue Length value in points
|
|
|
|
@return Value converted to inches
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function PtsToIn(AValue: Double): Double;
|
|
|
|
begin
|
|
|
|
Result := AValue / 72;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts millimeters to points (72 pts = 1 inch)
|
|
|
|
|
|
|
|
@param AValue Length value in millimeters
|
|
|
|
@return Value converted to points
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-06-13 20:32:58 +00:00
|
|
|
function mmToPts(AValue: Double): Double;
|
|
|
|
begin
|
|
|
|
Result := AValue * 72 / 25.4;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts points to millimeters
|
|
|
|
|
|
|
|
@param AValue Length value in points
|
|
|
|
@return Value converted to millimeters
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-06-13 20:32:58 +00:00
|
|
|
function PtsToMM(AValue: Double): Double;
|
|
|
|
begin
|
|
|
|
Result := AValue / 72 * 25.4;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts pixels to points.
|
|
|
|
|
|
|
|
@param AValue Length value given in pixels
|
|
|
|
@param AScreenPixelsPerInch Pixels per inch of the screen
|
|
|
|
@return Value converted to points
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-06-13 20:32:58 +00:00
|
|
|
function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double;
|
|
|
|
begin
|
|
|
|
Result := (AValue / AScreenPixelsPerInch) * 72;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts points to pixels
|
|
|
|
@param AValue Length value given in points
|
|
|
|
@param AScreenPixelsPerInch Pixels per inch of the screen
|
|
|
|
@return Value converted to pixels
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-06-13 20:32:58 +00:00
|
|
|
function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer;
|
|
|
|
begin
|
|
|
|
Result := Round(AValue / 72 * AScreenPixelsPerInch);
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts a HTML length string to points. The units are assumed to be the last
|
|
|
|
two digits of the string, such as '1.25in'
|
|
|
|
|
|
|
|
@param AValue HTML string representing a length with appended units code,
|
|
|
|
such as '1.25in'. These unit codes are accepted:
|
|
|
|
'px' (pixels), 'pt' (points), 'in' (inches), 'mm' (millimeters),
|
|
|
|
'cm' (centimeters).
|
2015-04-30 21:55:55 +00:00
|
|
|
@param DefaultUnits String identifying the units to be used if not contained
|
|
|
|
in AValue.
|
2014-06-23 21:49:20 +00:00
|
|
|
@return Extracted length in points
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2015-04-30 21:55:55 +00:00
|
|
|
function HTMLLengthStrToPts(AValue: String; DefaultUnits: String = 'pt'): Double;
|
2014-06-13 20:32:58 +00:00
|
|
|
var
|
|
|
|
units: String;
|
|
|
|
x: Double;
|
|
|
|
res: Word;
|
|
|
|
begin
|
|
|
|
if (Length(AValue) > 1) and (AValue[Length(AValue)] in ['a'..'z', 'A'..'Z']) then begin
|
|
|
|
units := lowercase(Copy(AValue, Length(AValue)-1, 2));
|
2015-04-30 21:55:55 +00:00
|
|
|
if units = '' then units := DefaultUnits;
|
2014-06-13 20:32:58 +00:00
|
|
|
val(copy(AValue, 1, Length(AValue)-2), x, res);
|
|
|
|
// No hasseling with the decimal point...
|
|
|
|
end else begin
|
2015-04-30 21:55:55 +00:00
|
|
|
units := DefaultUnits;
|
2014-06-13 20:32:58 +00:00
|
|
|
val(AValue, x, res);
|
|
|
|
end;
|
|
|
|
if res <> 0 then
|
|
|
|
raise Exception.CreateFmt('No valid number or units (%s)', [AValue]);
|
|
|
|
|
|
|
|
if (units = 'pt') or (units = '') then
|
|
|
|
Result := x
|
|
|
|
else
|
|
|
|
if units = 'in' then
|
|
|
|
Result := InToPts(x)
|
|
|
|
else if units = 'cm' then
|
|
|
|
Result := cmToPts(x)
|
|
|
|
else if units = 'mm' then
|
|
|
|
Result := mmToPts(x)
|
|
|
|
else if units = 'px' then
|
|
|
|
Result := pxToPts(Round(x), ScreenPixelsPerInch)
|
|
|
|
else
|
|
|
|
raise Exception.Create('Unknown length units');
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2015-05-28 20:08:24 +00:00
|
|
|
Determines the name of a color from its rgb value
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function GetColorName(AColor: TsColor): string;
|
|
|
|
var
|
|
|
|
rgba: TRGBA absolute AColor;
|
|
|
|
begin
|
|
|
|
case AColor of
|
|
|
|
scAqua : Result := rsAqua;
|
|
|
|
scBeige : Result := rsBeige;
|
|
|
|
scBlack : Result := rsBlack;
|
|
|
|
scBlue : Result := rsBlue;
|
|
|
|
scBlueGray : Result := rsBlueGray;
|
|
|
|
scBrown : Result := rsBrown;
|
|
|
|
scCoral : Result := rsCoral;
|
|
|
|
scCyan : Result := rsCyan;
|
|
|
|
scDarkBlue : Result := rsDarkBlue;
|
|
|
|
scDarkGreen : Result := rsDarkGreen;
|
|
|
|
scDarkPurple : Result := rsDarkPurple;
|
|
|
|
scDarkRed : Result := rsDarkRed;
|
|
|
|
scDarkTeal : Result := rsDarkTeal;
|
|
|
|
scGold : Result := rsGold;
|
|
|
|
scGray : Result := rsGray;
|
|
|
|
scGray10pct : Result := rsGray10pct;
|
|
|
|
scGray20pct : Result := rsGray20pct;
|
|
|
|
scGray40pct : Result := rsGray40pct;
|
|
|
|
scGray80pct : Result := rsGray80pct;
|
|
|
|
scGreen : Result := rsGreen;
|
|
|
|
scIceBlue : Result := rsIceBlue;
|
|
|
|
scIndigo : Result := rsIndigo;
|
|
|
|
scIvory : Result := rsIvory;
|
|
|
|
scLavander : Result := rsLavander;
|
|
|
|
scLightBlue : Result := rsLightBlue;
|
|
|
|
scLightGreen : Result := rsLightGreen;
|
|
|
|
scLightOrange: Result := rsLightOrange;
|
|
|
|
scLightTurquoise: Result := rsLightTurquoise;
|
|
|
|
scLightYellow: Result := rsLightYellow;
|
|
|
|
scLime : Result := rsLime;
|
|
|
|
scMagenta : Result := rsMagenta;
|
|
|
|
scNavy : Result := rsNavy;
|
|
|
|
scOceanBlue : Result := rsOceanBlue;
|
|
|
|
scOlive : Result := rsOlive;
|
|
|
|
scOliveGreen : Result := rsOliveGreen;
|
|
|
|
scOrange : Result := rsOrange;
|
|
|
|
scPaleBlue : Result := rsPaleBlue;
|
|
|
|
scPeriwinkle : Result := rsPeriwinkle;
|
|
|
|
scPink : Result := rsPink;
|
|
|
|
scPlum : Result := rsPlum;
|
|
|
|
scPurple : Result := rsPurple;
|
|
|
|
scRed : Result := rsRed;
|
|
|
|
scRose : Result := rsRose;
|
|
|
|
scSeaGreen : Result := rsSeaGreen;
|
|
|
|
scSilver : Result := rsSilver;
|
|
|
|
scSkyBlue : Result := rsSkyBlue;
|
|
|
|
scTan : Result := rsTan;
|
|
|
|
scTeal : Result := rsTeal;
|
|
|
|
scVeryDarkGreen: Result := rsVeryDarkGreen;
|
|
|
|
// scViolet : Result := rsViolet;
|
|
|
|
scWheat : Result := rsWheat;
|
|
|
|
scWhite : Result := rsWhite;
|
|
|
|
scYellow : Result := rsYellow;
|
|
|
|
scTransparent: Result := rsTransparent;
|
|
|
|
scNotDefined : Result := rsNotDefined;
|
2015-05-28 21:54:05 +00:00
|
|
|
else
|
|
|
|
case rgba.a of
|
|
|
|
$00:
|
|
|
|
Result := Format('R%d G%d B%d', [rgba.r, rgba.g, rgba.b]);
|
|
|
|
scPaletteIndexMask shr 24:
|
|
|
|
Result := Format(rsPaletteIndex, [AColor and $00FFFFFF]);
|
|
|
|
else
|
|
|
|
Result := '';
|
|
|
|
end;
|
2015-05-28 20:08:24 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Converts a HTML color string to a TsColor alue. Needed for the ODS file format.
|
2014-06-23 21:49:20 +00:00
|
|
|
|
2014-07-29 21:02:14 +00:00
|
|
|
@param AValue HTML color string, such as '#FF0000'
|
2014-06-23 21:49:20 +00:00
|
|
|
@return rgb color value in little endian byte-sequence. This value is
|
|
|
|
compatible with the TColor data type of the graphics unit.
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2015-05-28 20:08:24 +00:00
|
|
|
function HTMLColorStrToColor(AValue: String): TsColor;
|
2014-06-13 20:32:58 +00:00
|
|
|
begin
|
|
|
|
if AValue = '' then
|
|
|
|
Result := scNotDefined
|
|
|
|
else
|
|
|
|
if AValue[1] = '#' then begin
|
|
|
|
AValue[1] := '$';
|
2014-08-02 19:21:23 +00:00
|
|
|
Result := LongRGBToExcelPhysical(DWord(StrToInt(AValue)));
|
2014-06-13 20:32:58 +00:00
|
|
|
end else begin
|
|
|
|
AValue := lowercase(AValue);
|
|
|
|
if AValue = 'red' then
|
|
|
|
Result := $0000FF
|
|
|
|
else if AValue = 'cyan' then
|
|
|
|
Result := $FFFF00
|
|
|
|
else if AValue = 'blue' then
|
|
|
|
Result := $FF0000
|
|
|
|
else if AValue = 'purple' then
|
|
|
|
Result := $800080
|
|
|
|
else if AValue = 'yellow' then
|
|
|
|
Result := $00FFFF
|
|
|
|
else if AValue = 'lime' then
|
|
|
|
Result := $00FF00
|
|
|
|
else if AValue = 'white' then
|
|
|
|
Result := $FFFFFF
|
|
|
|
else if AValue = 'black' then
|
|
|
|
Result := $000000
|
|
|
|
else if (AValue = 'gray') or (AValue = 'grey') then
|
|
|
|
Result := $808080
|
|
|
|
else if AValue = 'silver' then
|
|
|
|
Result := $C0C0C0
|
|
|
|
else if AValue = 'maroon' then
|
|
|
|
Result := $000080
|
|
|
|
else if AValue = 'green' then
|
|
|
|
Result := $008000
|
|
|
|
else if AValue = 'olive' then
|
|
|
|
Result := $008080;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-06-23 21:49:20 +00:00
|
|
|
Converts an rgb color value to a string as used in HTML code (for ods)
|
|
|
|
|
2014-07-29 21:02:14 +00:00
|
|
|
@param AValue RGB color value (compatible with the TColor data type
|
|
|
|
of the graphics unit)
|
|
|
|
@param AExcelDialect If TRUE, returned string is in Excels format for xlsx,
|
|
|
|
i.e. in AARRGGBB notation, like '00FF0000' for "red"
|
|
|
|
@return HTML-compatible string, like '#FF0000' (AExcelDialect = false)
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2015-05-28 20:08:24 +00:00
|
|
|
function ColorToHTMLColorStr(AValue: TsColor;
|
|
|
|
AExcelDialect: Boolean = false): String;
|
2014-06-13 20:32:58 +00:00
|
|
|
var
|
2015-05-28 20:08:24 +00:00
|
|
|
rgb: TRGBA absolute AValue;
|
2014-06-13 20:32:58 +00:00
|
|
|
begin
|
2014-07-29 21:02:14 +00:00
|
|
|
if AExcelDialect then
|
|
|
|
Result := Format('00%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b])
|
|
|
|
else
|
|
|
|
Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]);
|
2014-06-13 20:32:58 +00:00
|
|
|
end;
|
|
|
|
|
2014-09-21 16:50:56 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-07-02 11:51:59 +00:00
|
|
|
Converts a string encoded in UTF8 to a string usable in XML. For this purpose,
|
|
|
|
some characters must be translated.
|
|
|
|
|
|
|
|
@param AText input string encoded as UTF8
|
|
|
|
@return String usable in XML with some characters replaced by the HTML codes.
|
2014-09-21 16:50:56 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-07-02 11:51:59 +00:00
|
|
|
function UTF8TextToXMLText(AText: ansistring): ansistring;
|
|
|
|
var
|
2015-07-28 22:13:48 +00:00
|
|
|
Idx: Integer;
|
|
|
|
AppoSt:ansistring;
|
2014-07-02 11:51:59 +00:00
|
|
|
begin
|
2015-07-28 22:13:48 +00:00
|
|
|
Result := '';
|
|
|
|
idx := 1;
|
|
|
|
while idx <= Length(AText) do
|
2014-07-02 11:51:59 +00:00
|
|
|
begin
|
|
|
|
case AText[Idx] of
|
|
|
|
'&': begin
|
2015-07-28 22:13:48 +00:00
|
|
|
AppoSt := Copy(AText, Idx, 6);
|
2014-07-02 11:51:59 +00:00
|
|
|
if (Pos('&', AppoSt) = 1) or
|
|
|
|
(Pos('<', AppoSt) = 1) or
|
|
|
|
(Pos('>', AppoSt) = 1) or
|
|
|
|
(Pos('"', AppoSt) = 1) or
|
2015-06-08 17:03:55 +00:00
|
|
|
(Pos(''', AppoSt) = 1) or
|
|
|
|
(Pos('%', AppoSt) = 1) // %
|
|
|
|
then begin
|
2014-07-02 11:51:59 +00:00
|
|
|
//'&' is the first char of a special chat, it must not be converted
|
2015-07-28 22:13:48 +00:00
|
|
|
Result := Result + AText[Idx];
|
2014-07-02 11:51:59 +00:00
|
|
|
end else begin
|
2015-07-28 22:13:48 +00:00
|
|
|
Result := Result + '&';
|
2014-07-02 11:51:59 +00:00
|
|
|
end;
|
|
|
|
end;
|
2015-07-28 22:13:48 +00:00
|
|
|
'<': Result := Result + '<';
|
|
|
|
'>': Result := Result + '>';
|
|
|
|
'"': Result := Result + '"';
|
|
|
|
'''':Result := Result + ''';
|
|
|
|
'%': Result := Result + '%';
|
2015-07-30 16:28:30 +00:00
|
|
|
{ this breaks multi-line labels in xlsx
|
2015-07-28 22:13:48 +00:00
|
|
|
#10: begin
|
|
|
|
Result := Result + '<br />';
|
|
|
|
if (idx < Length(AText)) and (AText[idx+1] = #13) then inc(idx);
|
|
|
|
end;
|
|
|
|
#13: begin
|
|
|
|
Result := Result + '<br />';
|
|
|
|
if (idx < Length(AText)) and (AText[idx+1] = #10) then inc(idx);
|
|
|
|
end;
|
2015-07-30 16:28:30 +00:00
|
|
|
}
|
2015-05-10 22:04:09 +00:00
|
|
|
{
|
|
|
|
#10: WrkStr := WrkStr + ' ';
|
|
|
|
#13: WrkStr := WrkStr + ' ';
|
|
|
|
}
|
2014-07-02 11:51:59 +00:00
|
|
|
else
|
2015-07-28 22:13:48 +00:00
|
|
|
Result := Result + AText[Idx];
|
2014-07-02 11:51:59 +00:00
|
|
|
end;
|
2015-07-28 22:13:48 +00:00
|
|
|
inc(idx);
|
2014-07-02 11:51:59 +00:00
|
|
|
end;
|
|
|
|
end;
|
2014-06-13 20:32:58 +00:00
|
|
|
|
2014-09-29 22:27:03 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Checks a string for characters that are not permitted in XML strings.
|
|
|
|
The function returns FALSE if a character <#32 is contained (except for
|
|
|
|
#9, #10, #13), TRUE otherwise. Invalid characters are replaced by a box symbol.
|
|
|
|
|
|
|
|
If ReplaceSpecialChars is TRUE, some other characters are converted
|
|
|
|
to valid HTML codes by calling UTF8TextToXMLText
|
|
|
|
|
|
|
|
@param AText String to be checked. Is replaced by valid string.
|
|
|
|
@param ReplaceSpecialChars Special characters are replaced by their HTML
|
|
|
|
codes (e.g. '>' --> '>')
|
|
|
|
@return FALSE if characters < #32 were replaced, TRUE otherwise.
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function ValidXMLText(var AText: ansistring;
|
|
|
|
ReplaceSpecialChars: Boolean = true): Boolean;
|
|
|
|
const
|
|
|
|
BOX = #$E2#$8E#$95;
|
|
|
|
var
|
|
|
|
i: Integer;
|
|
|
|
begin
|
|
|
|
Result := true;
|
|
|
|
for i := Length(AText) downto 1 do
|
|
|
|
if (AText[i] < #32) and not (AText[i] in [#9, #10, #13]) then begin
|
|
|
|
// Replace invalid character by box symbol
|
|
|
|
Delete(AText, i, 1);
|
|
|
|
Insert(BOX, AText, i);
|
|
|
|
// AText[i] := '?';
|
|
|
|
Result := false;
|
|
|
|
end;
|
|
|
|
if ReplaceSpecialChars then
|
|
|
|
AText := UTF8TextToXMLText(AText);
|
|
|
|
end;
|
|
|
|
|
2014-05-14 15:24:02 +00:00
|
|
|
|
2014-11-08 23:41:35 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
2014-07-04 20:41:07 +00:00
|
|
|
Extracts compare information from an input string such as "<2.4".
|
|
|
|
Is needed for some Excel-strings.
|
|
|
|
|
|
|
|
@param AString Input string starting with "<", "<=", ">", ">=", "<>" or "="
|
2014-07-29 21:02:14 +00:00
|
|
|
If this start code is missing a "=" is assumed.
|
2014-11-08 23:41:35 +00:00
|
|
|
@param ACompareOp Identifier for the comparing operation extracted
|
|
|
|
- see TsCompareOperation
|
2014-07-04 20:41:07 +00:00
|
|
|
@return Input string with the comparing characters stripped.
|
2014-11-08 23:41:35 +00:00
|
|
|
-------------------------------------------------------------------------------}
|
2014-07-04 20:41:07 +00:00
|
|
|
function AnalyzeComparestr(AString: String; out ACompareOp: TsCompareOperation): String;
|
|
|
|
|
|
|
|
procedure RemoveChars(ACount: Integer; ACompare: TsCompareOperation);
|
|
|
|
begin
|
|
|
|
ACompareOp := ACompare;
|
|
|
|
if ACount = 0 then
|
|
|
|
Result := AString
|
|
|
|
else
|
|
|
|
Result := Copy(AString, 1+ACount, Length(AString));
|
|
|
|
end;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Length(AString) > 1 then
|
|
|
|
case AString[1] of
|
|
|
|
'<' : case AString[2] of
|
|
|
|
'>' : RemoveChars(2, coNotEqual);
|
|
|
|
'=' : RemoveChars(2, coLessEqual);
|
|
|
|
else RemoveChars(1, coLess);
|
|
|
|
end;
|
|
|
|
'>' : case AString[2] of
|
|
|
|
'=' : RemoveChars(2, coGreaterEqual);
|
2014-07-29 21:02:14 +00:00
|
|
|
else RemoveChars(1, coGreater);
|
2014-07-04 20:41:07 +00:00
|
|
|
end;
|
|
|
|
'=' : RemoveChars(1, coEqual);
|
|
|
|
else RemoveChars(0, coEqual);
|
|
|
|
end
|
|
|
|
else
|
|
|
|
RemoveChars(0, coEqual);
|
|
|
|
end;
|
|
|
|
|
2014-10-22 15:57:07 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Initializes a Sortparams record. This record sets paramaters used when cells
|
|
|
|
are sorted.
|
|
|
|
|
|
|
|
@param ASortByCols If true sorting occurs along columns, i.e. the
|
|
|
|
ColRowIndex of the sorting keys refer to column indexes.
|
|
|
|
If False, sorting occurs along rows, and the
|
|
|
|
ColRowIndexes refer to row indexes
|
|
|
|
Default: true
|
|
|
|
@param ANumSortKeys Determines how many columns or rows are used as sorting
|
2014-10-23 13:38:41 +00:00
|
|
|
keys. (Default: 1). Every sort key is initialized for
|
|
|
|
ascending sort direction and case-sensitive comparison.
|
2014-10-22 15:57:07 +00:00
|
|
|
@param ASortPriority Determines the order or text and numeric data in
|
|
|
|
mixed content type cell ranges.
|
|
|
|
Default: spNumAlpha, i.e. numbers before text (in
|
|
|
|
ascending sort)
|
|
|
|
@return The initializaed TsSortParams record
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function InitSortParams(ASortByCols: Boolean = true; ANumSortKeys: Integer = 1;
|
|
|
|
ASortPriority: TsSortPriority = spNumAlpha): TsSortParams;
|
|
|
|
var
|
|
|
|
i: Integer;
|
|
|
|
begin
|
|
|
|
Result.SortByCols := ASortByCols;
|
2014-11-03 15:34:57 +00:00
|
|
|
Result.Priority := ASortPriority;
|
2014-10-22 15:57:07 +00:00
|
|
|
SetLength(Result.Keys, ANumSortKeys);
|
|
|
|
for i:=0 to High(Result.Keys) do begin
|
2014-10-23 13:38:41 +00:00
|
|
|
Result.Keys[i].ColRowIndex := i;
|
|
|
|
Result.Keys[i].Options := []; // Ascending & case-sensitive
|
2014-10-22 15:57:07 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-03-02 12:23:52 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Splits a hyperlink string at the # character.
|
|
|
|
|
|
|
|
@param AValue Hyperlink string to be processed
|
|
|
|
@param ATarget Part before the # ("Target")
|
|
|
|
@param ABookmark Part after the # ("Bookmark")
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
procedure SplitHyperlink(AValue: String; out ATarget, ABookmark: String);
|
|
|
|
var
|
|
|
|
p: Integer;
|
|
|
|
begin
|
|
|
|
p := pos('#', AValue);
|
|
|
|
if p = 0 then
|
|
|
|
begin
|
|
|
|
ATarget := AValue;
|
|
|
|
ABookmark := '';
|
|
|
|
end else
|
|
|
|
begin
|
|
|
|
ATarget := Copy(AValue, 1, p-1);
|
|
|
|
ABookmark := Copy(AValue, p+1, Length(AValue));
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-03-08 17:04:25 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Replaces backslashes by forward slashes in hyperlink path names
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
procedure FixHyperlinkPathDelims(var ATarget: String);
|
|
|
|
var
|
|
|
|
i: Integer;
|
|
|
|
begin
|
2015-03-15 11:02:15 +00:00
|
|
|
for i:=1 to Length(ATarget) do
|
|
|
|
if ATarget[i] = '\' then ATarget[i] := '/';
|
2015-03-08 17:04:25 +00:00
|
|
|
end;
|
|
|
|
|
2015-03-04 17:30:59 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Initalizes a new cell.
|
|
|
|
@return New cell record
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
procedure InitCell(out ACell: TCell);
|
|
|
|
begin
|
|
|
|
ACell.FormulaValue := '';
|
|
|
|
ACell.UTF8StringValue := '';
|
|
|
|
FillChar(ACell, SizeOf(ACell), 0);
|
|
|
|
end;
|
|
|
|
|
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Initalizes a new cell and presets the row and column fields of the cell record
|
|
|
|
to the parameters passed to the procedure.
|
|
|
|
|
|
|
|
@param ARow Row index of the new cell
|
|
|
|
@param ACol Column index of the new cell
|
|
|
|
@return New cell record with row and column fields preset to passed values.
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell);
|
|
|
|
begin
|
|
|
|
InitCell(ACell);
|
|
|
|
ACell.Row := ARow;
|
|
|
|
ACell.Col := ACol;
|
|
|
|
end;
|
|
|
|
|
2015-03-05 10:54:06 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Initializes the fields of a TsCellFormaRecord
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
procedure InitFormatRecord(out AValue: TsCellFormat);
|
|
|
|
begin
|
|
|
|
AValue.Name := '';
|
|
|
|
AValue.NumberFormatStr := '';
|
|
|
|
FillChar(AValue, SizeOf(AValue), 0);
|
|
|
|
AValue.BorderStyles := DEFAULT_BORDERSTYLES;
|
|
|
|
AValue.Background := EMPTY_FILL;
|
2015-04-18 14:58:38 +00:00
|
|
|
AValue.NumberFormatIndex := -1; // GENERAL format not contained in NumFormatList
|
2015-03-05 10:54:06 +00:00
|
|
|
end;
|
|
|
|
|
2015-04-30 21:55:55 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Initializes the fields of a TsPageLayout record
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
procedure InitPageLayout(out APageLayout: TsPageLayout);
|
2015-05-01 15:14:25 +00:00
|
|
|
var
|
|
|
|
i: Integer;
|
2015-04-30 21:55:55 +00:00
|
|
|
begin
|
|
|
|
with APageLayout do begin
|
|
|
|
Orientation := spoPortrait;
|
|
|
|
PageWidth := 210;
|
|
|
|
PageHeight := 297;
|
|
|
|
LeftMargin := InToMM(0.7);
|
|
|
|
RightMargin := InToMM(0.7);
|
|
|
|
TopMargin := InToMM(0.78740157499999996);
|
|
|
|
BottomMargin := InToMM(0.78740157499999996);
|
|
|
|
HeaderMargin := InToMM(0.3);
|
|
|
|
FooterMargin := InToMM(0.3);
|
|
|
|
StartPageNumber := 1;
|
|
|
|
ScalingFactor := 100; // Percent
|
|
|
|
FitWidthToPages := 0; // use as many pages as needed
|
|
|
|
FitHeightToPages := 0;
|
|
|
|
Copies := 1;
|
|
|
|
Options := [];
|
2015-05-01 15:14:25 +00:00
|
|
|
for i:=0 to 2 do Headers[i] := '';
|
|
|
|
for i:=0 to 2 do Footers[i] := '';
|
2015-04-30 21:55:55 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-05-31 16:34:40 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Copies the value of a cell to another one. Does not copy the formula, erases
|
|
|
|
the formula of the destination cell if there is one!
|
|
|
|
|
|
|
|
@param AFromCell Cell from which the value is to be copied
|
|
|
|
@param AToCell Cell to which the value is to be copied
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
procedure CopyCellValue(AFromCell, AToCell: PCell);
|
|
|
|
begin
|
|
|
|
Assert(AFromCell <> nil);
|
|
|
|
Assert(AToCell <> nil);
|
|
|
|
|
|
|
|
AToCell^.ContentType := AFromCell^.ContentType;
|
|
|
|
AToCell^.NumberValue := AFromCell^.NumberValue;
|
|
|
|
AToCell^.DateTimeValue := AFromCell^.DateTimeValue;
|
|
|
|
AToCell^.BoolValue := AFromCell^.BoolValue;
|
|
|
|
AToCell^.ErrorValue := AFromCell^.ErrorValue;
|
|
|
|
AToCell^.UTF8StringValue := AFromCell^.UTF8StringValue;
|
|
|
|
AToCell^.FormulaValue := ''; // This is confirmed with Excel
|
|
|
|
end;
|
|
|
|
|
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Returns TRUE if the cell contains a formula.
|
|
|
|
|
|
|
|
@param ACell Pointer to the cell checked
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function HasFormula(ACell: PCell): Boolean;
|
|
|
|
begin
|
|
|
|
Result := Assigned(ACell) and (Length(ACell^.FormulaValue) > 0);
|
|
|
|
end;
|
|
|
|
|
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Checks whether two format records have same border attributes
|
|
|
|
|
|
|
|
@param AFormat1 Pointer to the first one of the two format records to be compared
|
|
|
|
@param AFormat2 Pointer to the second one of the two format records to be compared
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean;
|
|
|
|
|
|
|
|
function NoBorder(AFormat: PsCellFormat): Boolean;
|
|
|
|
begin
|
|
|
|
Result := (AFormat = nil) or
|
|
|
|
not (uffBorder in AFormat^.UsedFormattingFields) or
|
|
|
|
(AFormat^.Border = []);
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
nobrdr1, nobrdr2: Boolean;
|
|
|
|
cb: TsCellBorder;
|
|
|
|
begin
|
|
|
|
nobrdr1 := NoBorder(AFormat1);
|
|
|
|
nobrdr2 := NoBorder(AFormat2);
|
|
|
|
if (nobrdr1 and nobrdr2) then
|
|
|
|
Result := true
|
|
|
|
else
|
|
|
|
if (nobrdr1 and (not nobrdr2) ) or ( (not nobrdr1) and nobrdr2) then
|
|
|
|
Result := false
|
|
|
|
else begin
|
|
|
|
Result := false;
|
|
|
|
if AFormat1^.Border <> AFormat2^.Border then
|
|
|
|
exit;
|
|
|
|
for cb in TsCellBorder do begin
|
|
|
|
if AFormat1^.BorderStyles[cb].LineStyle <> AFormat2^.BorderStyles[cb].LineStyle then
|
|
|
|
exit;
|
|
|
|
if AFormat1^.BorderStyles[cb].Color <> AFormat2^.BorderStyles[cb].Color then
|
|
|
|
exit;
|
|
|
|
end;
|
|
|
|
Result := true;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2014-11-08 23:41:35 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Appends a string to a stream
|
|
|
|
|
|
|
|
@param AStream Stream to which the string will be added
|
|
|
|
@param AString String to be written to the stream
|
|
|
|
-------------------------------------------------------------------------------}
|
2014-07-10 15:55:40 +00:00
|
|
|
procedure AppendToStream(AStream: TStream; const AString: string);
|
|
|
|
begin
|
|
|
|
if Length(AString) > 0 then
|
|
|
|
AStream.WriteBuffer(AString[1], Length(AString));
|
|
|
|
end;
|
|
|
|
|
2014-11-08 23:41:35 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Appends two strings to a stream
|
|
|
|
|
|
|
|
@param AStream Stream to which the strings will be added
|
|
|
|
@param AString1 First string to be written to the stream
|
|
|
|
@param AString2 Second string to be written to the stream
|
|
|
|
-------------------------------------------------------------------------------}
|
2014-07-10 15:55:40 +00:00
|
|
|
procedure AppendToStream(AStream: TStream; const AString1, AString2: String);
|
|
|
|
begin
|
|
|
|
AppendToStream(AStream, AString1);
|
|
|
|
AppendToStream(AStream, AString2);
|
|
|
|
end;
|
|
|
|
|
2014-11-08 23:41:35 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Appends three strings to a stream
|
|
|
|
|
|
|
|
@param AStream Stream to which the strings will be added
|
|
|
|
@param AString1 First string to be written to the stream
|
|
|
|
@param AString2 Second string to be written to the stream
|
|
|
|
@param AString3 Third string to be written to the stream
|
|
|
|
-------------------------------------------------------------------------------}
|
2014-07-10 15:55:40 +00:00
|
|
|
procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String);
|
|
|
|
begin
|
|
|
|
AppendToStream(AStream, AString1);
|
|
|
|
AppendToStream(AStream, AString2);
|
|
|
|
AppendToStream(AStream, AString3);
|
|
|
|
end;
|
|
|
|
|
2014-08-06 15:49:04 +00:00
|
|
|
{ Modifying colors }
|
|
|
|
{ Next function are copies of GraphUtils to avoid a dependence on the Graphics unit. }
|
|
|
|
|
|
|
|
const
|
|
|
|
HUE_000 = 0;
|
|
|
|
HUE_060 = 43;
|
|
|
|
HUE_120 = 85;
|
|
|
|
HUE_180 = 128;
|
|
|
|
HUE_240 = 170;
|
|
|
|
|
|
|
|
procedure RGBtoHLS(const R, G, B: Byte; out H, L, S: Byte);
|
|
|
|
var
|
2014-08-12 14:52:57 +00:00
|
|
|
cMax, cMin: Integer; // max and min RGB values
|
2014-08-06 15:49:04 +00:00
|
|
|
Rdelta, Gdelta, Bdelta: Byte; // intermediate value: % of spread from max
|
2014-08-12 14:52:57 +00:00
|
|
|
diff: Integer;
|
2014-08-06 15:49:04 +00:00
|
|
|
begin
|
|
|
|
// calculate lightness
|
|
|
|
cMax := MaxIntValue([R, G, B]);
|
|
|
|
cMin := MinIntValue([R, G, B]);
|
|
|
|
L := (integer(cMax) + cMin + 1) div 2;
|
|
|
|
diff := cMax - cMin;
|
|
|
|
|
|
|
|
if diff = 0
|
|
|
|
then begin
|
|
|
|
// r=g=b --> achromatic case
|
|
|
|
S := 0;
|
|
|
|
H := 0;
|
|
|
|
end
|
|
|
|
else begin
|
|
|
|
// chromatic case
|
|
|
|
// saturation
|
|
|
|
if L <= 128
|
|
|
|
then S := integer(diff * 255) div (cMax + cMin)
|
|
|
|
else S := integer(diff * 255) div (510 - cMax - cMin);
|
|
|
|
|
|
|
|
// hue
|
|
|
|
Rdelta := (cMax - R);
|
|
|
|
Gdelta := (cMax - G);
|
|
|
|
Bdelta := (cMax - B);
|
|
|
|
|
|
|
|
if R = cMax
|
|
|
|
then H := (HUE_000 + integer(Bdelta - Gdelta) * HUE_060 div diff) and $ff
|
|
|
|
else if G = cMax
|
|
|
|
then H := HUE_120 + integer(Rdelta - Bdelta) * HUE_060 div diff
|
|
|
|
else H := HUE_240 + integer(Gdelta - Rdelta) * HUE_060 div diff;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure HLStoRGB(const H, L, S: Byte; out R, G, B: Byte);
|
|
|
|
|
|
|
|
// utility routine for HLStoRGB
|
|
|
|
function HueToRGB(const n1, n2: Byte; Hue: Integer): Byte;
|
|
|
|
begin
|
|
|
|
if Hue > 255
|
|
|
|
then Dec(Hue, 255)
|
|
|
|
else if Hue < 0
|
|
|
|
then Inc(Hue, 255);
|
|
|
|
|
|
|
|
// return r,g, or b value from this tridrant
|
|
|
|
case Hue of
|
|
|
|
HUE_000..HUE_060 - 1: Result := n1 + (n2 - n1) * Hue div HUE_060;
|
|
|
|
HUE_060..HUE_180 - 1: Result := n2;
|
|
|
|
HUE_180..HUE_240 - 1: Result := n1 + (n2 - n1) * (HUE_240 - Hue) div HUE_060;
|
|
|
|
else
|
|
|
|
Result := n1;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
2014-08-12 14:52:57 +00:00
|
|
|
n1, n2: Integer;
|
2014-08-06 15:49:04 +00:00
|
|
|
begin
|
|
|
|
if S = 0
|
|
|
|
then begin
|
|
|
|
// achromatic case
|
|
|
|
R := L;
|
|
|
|
G := L;
|
|
|
|
B := L;
|
|
|
|
end
|
|
|
|
else begin
|
|
|
|
// chromatic case
|
|
|
|
// set up magic numbers
|
|
|
|
if L < 128
|
|
|
|
then begin
|
2014-10-06 10:43:10 +00:00
|
|
|
n2 := Integer(L) + Integer(L) * S div 255;
|
2014-08-06 15:49:04 +00:00
|
|
|
n1 := 2 * L - n2;
|
|
|
|
end
|
|
|
|
else begin
|
2014-10-06 10:43:10 +00:00
|
|
|
n2 := Integer(S) + L - Integer(L) * S div 255;
|
2014-08-06 15:49:04 +00:00
|
|
|
n1 := 2 * L - n2 - 1;
|
|
|
|
end;
|
|
|
|
|
|
|
|
// get RGB
|
|
|
|
R := HueToRGB(n1, n2, H + HUE_120);
|
|
|
|
G := HueToRGB(n1, n2, H);
|
|
|
|
B := HueToRGB(n1, n2, H - HUE_120);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-05-28 20:08:24 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Constructs a TsColor from a palette index. It has bit 15 in the high-order
|
|
|
|
byte set.
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function SetAsPaletteIndex(AIndex: Integer): TsColor;
|
|
|
|
begin
|
|
|
|
Result := (DWord(AIndex) and scRGBMask) or scPaletteIndexMask;
|
|
|
|
end;
|
|
|
|
|
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Checks whether the specified TsColor represents a palette index
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function IsPaletteIndex(AColor: TsColor): Boolean;
|
|
|
|
begin
|
|
|
|
Result := AColor and scPaletteIndexMask = scPaletteIndexMask;
|
|
|
|
end;
|
|
|
|
|
2014-11-08 23:41:35 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Excel defines theme colors and applies a "tint" factor (-1...+1) to darken
|
2014-08-06 15:49:04 +00:00
|
|
|
or brighten them.
|
2014-11-08 23:41:35 +00:00
|
|
|
|
|
|
|
This method "tints" a given color with a factor
|
|
|
|
|
2014-08-06 15:49:04 +00:00
|
|
|
The algorithm is described in
|
|
|
|
http://msdn.microsoft.com/en-us/library/documentformat.openxml.spreadsheet.backgroundcolor.aspx
|
2014-11-08 23:41:35 +00:00
|
|
|
|
|
|
|
@param AColor rgb color to be modified
|
|
|
|
@param tint Factor (-1...+1) to be used for the operation
|
|
|
|
@return Modified color
|
|
|
|
-------------------------------------------------------------------------------}
|
2015-05-28 20:08:24 +00:00
|
|
|
function TintedColor(AColor: TsColor; tint: Double): TsColor;
|
2014-08-06 15:49:04 +00:00
|
|
|
const
|
|
|
|
HLSMAX = 255;
|
|
|
|
var
|
|
|
|
r, g, b: byte;
|
|
|
|
h, l, s: Byte;
|
|
|
|
lum: Double;
|
|
|
|
begin
|
2015-05-28 20:08:24 +00:00
|
|
|
if (tint = 0) or (TRGBA(AColor).a <> 0) then begin
|
2014-08-06 15:49:04 +00:00
|
|
|
Result := AColor;
|
|
|
|
exit;
|
|
|
|
end;
|
|
|
|
|
|
|
|
r := TRGBA(AColor).r;
|
|
|
|
g := TRGBA(AColor).g;
|
|
|
|
b := TRGBA(AColor).b;
|
|
|
|
RGBToHLS(r, g, b, h, l, s);
|
|
|
|
|
|
|
|
lum := l;
|
|
|
|
if tint < 0 then
|
|
|
|
lum := lum * (1.0 + tint)
|
|
|
|
else
|
|
|
|
if tint > 0 then
|
|
|
|
lum := lum * (1.0-tint) + (HLSMAX - HLSMAX * (1.0-tint));
|
|
|
|
l := Min(255, round(lum));
|
|
|
|
HLSToRGB(h, l, s, r, g, b);
|
|
|
|
|
|
|
|
TRGBA(Result).r := r;
|
|
|
|
TRGBA(Result).g := g;
|
|
|
|
TRGBA(Result).b := b;
|
|
|
|
TRGBA(Result).a := 0;
|
|
|
|
end;
|
|
|
|
|
2014-11-08 23:41:35 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Returns the color index for black or white depending on a color being "bright"
|
|
|
|
or "dark".
|
2014-09-11 22:57:55 +00:00
|
|
|
|
2015-05-28 20:08:24 +00:00
|
|
|
@param AColor rgb color to be analyzed
|
2014-11-08 23:41:35 +00:00
|
|
|
@return The color index for black (scBlack) if AColorValue is a "bright" color,
|
|
|
|
or white (scWhite) if AColorValue is a "dark" color.
|
|
|
|
-------------------------------------------------------------------------------}
|
2015-05-28 20:08:24 +00:00
|
|
|
function HighContrastColor(AColor: TsColor): TsColor;
|
2014-09-25 15:48:44 +00:00
|
|
|
begin
|
2015-05-28 20:08:24 +00:00
|
|
|
if TRGBA(AColor).r + TRGBA(AColor).g + TRGBA(AColor).b < 3*128 then
|
2014-09-25 15:48:44 +00:00
|
|
|
Result := scWhite
|
|
|
|
else
|
|
|
|
Result := scBlack;
|
|
|
|
end;
|
|
|
|
|
2015-05-28 20:08:24 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Converts the RGB part of a LongRGB logical structure to its physical representation.
|
|
|
|
In other words: RGBA (where A is 0 and omitted in the function call) => ABGR
|
|
|
|
Needed for conversion of palette colors.
|
|
|
|
|
|
|
|
@param RGB DWord value containing RGBA bytes in big endian byte-order
|
|
|
|
@return DWord containing RGB bytes in little-endian byte-order (A = 0)
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
|
|
|
|
begin
|
|
|
|
{$IFDEF FPC}
|
|
|
|
{$IFDEF ENDIAN_LITTLE}
|
|
|
|
result := RGB shl 8; //tags $00 at end for the A byte
|
|
|
|
result := SwapEndian(result); //flip byte order
|
|
|
|
{$ELSE}
|
|
|
|
//Big endian
|
|
|
|
result := RGB; //leave value as is //todo: verify if this turns out ok
|
|
|
|
{$ENDIF}
|
|
|
|
{$ELSE}
|
|
|
|
// messed up result
|
|
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
2014-06-20 15:58:22 +00:00
|
|
|
{$PUSH}{$HINTS OFF}
|
2014-06-23 21:49:20 +00:00
|
|
|
{@@ Silence warnings due to an unused parameter }
|
2014-06-20 15:58:22 +00:00
|
|
|
procedure Unused(const A1);
|
2014-06-23 21:49:20 +00:00
|
|
|
// code "borrowed" from TAChart
|
2014-06-20 15:58:22 +00:00
|
|
|
begin
|
|
|
|
end;
|
|
|
|
|
2014-06-23 21:49:20 +00:00
|
|
|
{@@ Silence warnings due to two unused parameters }
|
2014-06-20 15:58:22 +00:00
|
|
|
procedure Unused(const A1, A2);
|
2014-06-23 21:49:20 +00:00
|
|
|
// code "borrowed" from TAChart
|
2014-06-20 15:58:22 +00:00
|
|
|
begin
|
|
|
|
end;
|
|
|
|
|
2014-06-23 21:49:20 +00:00
|
|
|
{@@ Silence warnings due to three unused parameters }
|
2014-06-20 15:58:22 +00:00
|
|
|
procedure Unused(const A1, A2, A3);
|
2014-06-23 21:49:20 +00:00
|
|
|
// code adapted from TAChart
|
2014-06-20 15:58:22 +00:00
|
|
|
begin
|
|
|
|
end;
|
|
|
|
{$POP}
|
|
|
|
|
2014-08-10 14:52:30 +00:00
|
|
|
|
2014-11-08 23:41:35 +00:00
|
|
|
{@@ ----------------------------------------------------------------------------
|
|
|
|
Creates a FPC format settings record in which all strings are encoded as
|
|
|
|
UTF8.
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
procedure InitUTF8FormatSettings;
|
|
|
|
// remove when available in LazUtils
|
|
|
|
var
|
|
|
|
i: Integer;
|
|
|
|
begin
|
|
|
|
UTF8FormatSettings := DefaultFormatSettings;
|
|
|
|
UTF8FormatSettings.CurrencyString := AnsiToUTF8(DefaultFormatSettings.CurrencyString);
|
|
|
|
for i:=1 to 12 do begin
|
|
|
|
UTF8FormatSettings.LongMonthNames[i] := AnsiToUTF8(DefaultFormatSettings.LongMonthNames[i]);
|
|
|
|
UTF8FormatSettings.ShortMonthNames[i] := AnsiToUTF8(DefaultFormatSettings.ShortMonthNames[i]);
|
|
|
|
end;
|
|
|
|
for i:=1 to 7 do begin
|
|
|
|
UTF8FormatSettings.LongDayNames[i] := AnsiToUTF8(DefaultFormatSettings.LongDayNames[i]);
|
|
|
|
UTF8FormatSettings.ShortDayNames[i] := AnsiToUTF8(DefaultFormatSettings.ShortDayNames[i]);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
2014-10-24 20:44:37 +00:00
|
|
|
initialization
|
|
|
|
InitUTF8FormatSettings;
|
2014-08-10 14:52:30 +00:00
|
|
|
|
2009-01-09 08:39:40 +00:00
|
|
|
end.
|
|
|
|
|