pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Include unit fpsutils in doc-o-matic project. Update fpspreadsheet.chm help file.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3228 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-23 21:49:20 +00:00
parent 0553425233
commit 517bdca8fb
3 changed files with 548 additions and 132 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
components/fpspreadsheet/fpspreadsheet.chm
View File

Binary file not shown.

161
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -51,7 +51,6 @@ type
=SUM(A1:D1) - SUM operation in a interval =SUM(A1:D1) - SUM operation in a interval
</pre> </pre>
} }
TsFormula = record TsFormula = record
FormulaStr: string; FormulaStr: string;
DoubleValue: double; DoubleValue: double;
@ -142,7 +141,7 @@ type
end; end;
{@@ Expanded formula. Used by backend modules. Provides more information than the text only. {@@ Expanded formula. Used by backend modules. Provides more information than the text only.
Consists of TsFormulaElements. } Is an array of TsFormulaElement items. }
TsExpandedFormula = array of TsFormulaElement; TsExpandedFormula = array of TsFormulaElement;
{@@ RPN formula. Similar to the expanded formula, but in RPN notation. {@@ RPN formula. Similar to the expanded formula, but in RPN notation.
@ -371,7 +370,7 @@ type
only one of the ContentTypes is valid. For other fields only one of the ContentTypes is valid. For other fields
use TWorksheet.ReadAsUTF8Text and similar methods use TWorksheet.ReadAsUTF8Text and similar methods
@see TWorksheet.ReadAsUTF8Text } @see ReadAsUTF8Text }
TCell = record TCell = record
Col: Cardinal; // zero-based Col: Cardinal; // zero-based
Row: Cardinal; // zero-based Row: Cardinal; // zero-based
@ -655,8 +654,10 @@ type
end; end;
{ TsWorkbook } {@@
The workbook collects the worksheets and provides methods for reading from
and writing to file.
}
TsWorkbook = class TsWorkbook = class
private private
{ Internal data } { Internal data }
@ -817,11 +818,16 @@ type
end; end;
{ TsCustomSpreadReader }
{@@ TsSpreadReader class reference type } {@@ TsSpreadReader class reference type }
TsSpreadReaderClass = class of TsCustomSpreadReader; TsSpreadReaderClass = class of TsCustomSpreadReader;
{ TsCustomSpreadReader } {@@
Custom reader of spreadsheet files. "Custom" means that it provides only
the basic functionality. The main implementation is done in derived classes
for each individual file format.
}
TsCustomSpreadReader = class TsCustomSpreadReader = class
protected protected
{@@ A copy of the workbook's FormatSetting to extract some localized number format information } {@@ A copy of the workbook's FormatSetting to extract some localized number format information }
@ -832,9 +838,13 @@ type
FNumFormatList: TsCustomNumFormatList; FNumFormatList: TsCustomNumFormatList;
procedure CreateNumFormatList; virtual; procedure CreateNumFormatList; virtual;
{ Record reading methods } { Record reading methods }
{@@ Abstract method for reading a blank cell. Must be overridden by descendent classes. }
procedure ReadBlank(AStream: TStream); virtual; abstract; procedure ReadBlank(AStream: TStream); virtual; abstract;
{@@ Abstract method for reading a formula cell. Must be overridden by descendent classes. }
procedure ReadFormula(AStream: TStream); virtual; abstract; procedure ReadFormula(AStream: TStream); virtual; abstract;
{@@ Abstract method for reading a text cell. Must be overridden by descendent classes. }
procedure ReadLabel(AStream: TStream); virtual; abstract; procedure ReadLabel(AStream: TStream); virtual; abstract;
{@@ Abstract method for reading a number cell. Must be overridden by descendent classes. }
procedure ReadNumber(AStream: TStream); virtual; abstract; procedure ReadNumber(AStream: TStream); virtual; abstract;
public public
constructor Create(AWorkbook: TsWorkbook); virtual; // To allow descendents to override it constructor Create(AWorkbook: TsWorkbook); virtual; // To allow descendents to override it
@ -843,22 +853,31 @@ type
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); virtual; procedure ReadFromFile(AFileName: string; AData: TsWorkbook); virtual;
procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); virtual; procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); virtual;
procedure ReadFromStrings(AStrings: TStrings; AData: TsWorkbook); virtual; procedure ReadFromStrings(AStrings: TStrings; AData: TsWorkbook); virtual;
{@@ Instance of the workbook which is currently being read. }
property Workbook: TsWorkbook read FWorkbook; property Workbook: TsWorkbook read FWorkbook;
{@@ List of number formats found in the file. }
property NumFormatList: TsCustomNumFormatList read FNumFormatList; property NumFormatList: TsCustomNumFormatList read FNumFormatList;
end; end;
{@@ TsSpreadWriter class reference type }
TsSpreadWriterClass = class of TsCustomSpreadWriter;
TCellsCallback = procedure (ACell: PCell; AStream: TStream) of object;
{ TsCustomSpreadWriter } { TsCustomSpreadWriter }
{@@ TsSpreadWriter class reference type }
TsSpreadWriterClass = class of TsCustomSpreadWriter;
{@@ Callback function when iterating cells while accessing a stream }
TCellsCallback = procedure (ACell: PCell; AStream: TStream) of object;
{@@
Custom writer of spreadsheet files. "Custom" means that it provides only
the basic functionality. The main implementation is done in derived classes
for each individual file format. }
TsCustomSpreadWriter = class TsCustomSpreadWriter = class
private private
FWorkbook: TsWorkbook; FWorkbook: TsWorkbook;
protected protected
{@@ List of number formats found in the workbook. }
FNumFormatList: TsCustomNumFormatList; FNumFormatList: TsCustomNumFormatList;
{ Helper routines } { Helper routines }
procedure AddDefaultFormats(); virtual; procedure AddDefaultFormats(); virtual;
@ -874,19 +893,25 @@ type
procedure WriteCellCallback(ACell: PCell; AStream: TStream); procedure WriteCellCallback(ACell: PCell; AStream: TStream);
procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree); procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree);
{ Record writing methods } { Record writing methods }
{@@ abstract method for writing a blank cell. Must be overridden by descendent classes. }
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); virtual; abstract; procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); virtual; abstract;
{@@ abstract method for a date/time value to a cell. Must be overridden by descendent classes. }
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); virtual; abstract; procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); virtual; abstract;
{@@ abstract method for a formula to a cell. Must be overridden by descendent classes. }
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); virtual; procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); virtual;
{@@ abstract method for am RPN formula to a cell. Must be overridden by descendent classes. }
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); virtual; procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); virtual;
{@@ abstract method for a string to a cell. Must be overridden by descendent classes. }
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); virtual; abstract; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); virtual; abstract;
{@@ abstract method for a number value to a cell. Must be overridden by descendent classes. }
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); virtual; abstract; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); virtual; abstract;
public public
{@@ {@@ An array with cells which are models for the used styles
An array with cells which are models for the used styles In this array the Row property holds the index to the corresponding XF field }
In this array the Row property holds the Index to the corresponding XF field
}
FFormattingStyles: array of TCell; FFormattingStyles: array of TCell;
NextXFIndex: Integer; // Indicates which should be the next XF (Style) Index when filling the styles list {@@ Indicates which should be the next XF (style) index when filling the FFormattingStyles array }
NextXFIndex: Integer;
constructor Create(AWorkbook: TsWorkbook); virtual; // To allow descendents to override it constructor Create(AWorkbook: TsWorkbook); virtual; // To allow descendents to override it
destructor Destroy; override; destructor Destroy; override;
{ General writing methods } { General writing methods }
@ -894,45 +919,28 @@ type
procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); virtual; procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); virtual;
procedure WriteToStream(AStream: TStream); virtual; procedure WriteToStream(AStream: TStream); virtual;
procedure WriteToStrings(AStrings: TStrings); virtual; procedure WriteToStrings(AStrings: TStrings); virtual;
{@@ Instance of the workbook which is currently being saved. }
property Workbook: TsWorkbook read FWorkbook; property Workbook: TsWorkbook read FWorkbook;
{@@ List of number formats found in the workbook. }
property NumFormatList: TsCustomNumFormatList read FNumFormatList; property NumFormatList: TsCustomNumFormatList read FNumFormatList;
end; end;
{@@ List of registered formats } {@@ List of registered formats }
TsSpreadFormatData = record TsSpreadFormatData = record
ReaderClass: TsSpreadReaderClass; ReaderClass: TsSpreadReaderClass;
WriterClass: TsSpreadWriterClass; WriterClass: TsSpreadWriterClass;
Format: TsSpreadsheetFormat; Format: TsSpreadsheetFormat;
end; end;
{@@ Helper for simplification of RPN formula creation } { Simple creation an RPNFormula array to be used in fpspreadsheet. }
{@@ Helper record for simplification of RPN formula creation }
PRPNItem = ^TRPNItem; PRPNItem = ^TRPNItem;
TRPNItem = record TRPNItem = record
FE: TsFormulaElement; FE: TsFormulaElement;
Next: PRPNItem; Next: PRPNItem;
end; end;
{@@
Simple creation an RPNFormula array to be used in fpspreadsheet.
For each formula element, use one of the RPNxxxx functions implemented here.
They are designed to be nested into each other. Terminate the chain by
using nil.
Example:
The RPN formula for the string expression "$A1+2" can be created as follows:
<pre>
var
f: TsRPNFormula;
f := CreateRPNFormula(
RPNCellValue('A1',
RPNNumber(2,
RPNFunc(fekAdd,
nil))));
</pre>
}
function CreateRPNFormula(AItem: PRPNItem): TsRPNFormula; function CreateRPNFormula(AItem: PRPNItem): TsRPNFormula;
procedure DestroyRPNFormula(AItem: PRPNItem); procedure DestroyRPNFormula(AItem: PRPNItem);
@ -1215,7 +1223,7 @@ const
); );
{@@ {@@
Registers a new reader/writer pair for a format Registers a new reader/writer pair for a given spreadsheet file format
} }
procedure RegisterSpreadFormat( procedure RegisterSpreadFormat(
AReaderClass: TsSpreadReaderClass; AReaderClass: TsSpreadReaderClass;
@ -1233,7 +1241,7 @@ begin
end; end;
{@@ {@@
Returns the name of the given file format. Returns the name of the given spreadsheet file format.
@param AFormat Identifier of the file format @param AFormat Identifier of the file format
@return 'BIFF2', 'BIFF3', 'BIFF4', 'BIFF5', 'BIFF8', 'OOXML', 'Open Document', @return 'BIFF2', 'BIFF3', 'BIFF4', 'BIFF5', 'BIFF8', 'OOXML', 'Open Document',
@ -3521,8 +3529,15 @@ begin
end; end;
{@@ {@@
Convenience method which creates the correct Convenience method which creates the correct reader object for a given
reader object for a given spreadsheet format. spreadsheet format.
@param AFormat File format which is assumed when reading a document into
to workbook. An exception is raised when the document has
a different format.
@return An instance of a TsCustomSpreadReader descendent which is able to
read thi given file format.
} }
function TsWorkbook.CreateSpreadReader(AFormat: TsSpreadsheetFormat): TsCustomSpreadReader; function TsWorkbook.CreateSpreadReader(AFormat: TsSpreadsheetFormat): TsCustomSpreadReader;
var var
@ -3541,8 +3556,13 @@ begin
end; end;
{@@ {@@
Convenience method which creates the correct Convenience method which creates the correct writer object for a given
writer object for a given spreadsheet format. spreadsheet format.
@param AFormat File format to be used for writing the workbook
@return An instance of a TsCustomSpreadWriter descendent which is able to
write the given file format.
} }
function TsWorkbook.CreateSpreadWriter(AFormat: TsSpreadsheetFormat): TsCustomSpreadWriter; function TsWorkbook.CreateSpreadWriter(AFormat: TsSpreadsheetFormat): TsCustomSpreadWriter;
var var
@ -3561,7 +3581,10 @@ begin
end; end;
{@@ {@@
Reads the document from a file. Reads the document from a file. It is assumed to have a given file format.
@param AFileName Name of the file to be read
@param AFormat File format assumed
} }
procedure TsWorkbook.ReadFromFile(AFileName: string; procedure TsWorkbook.ReadFromFile(AFileName: string;
AFormat: TsSpreadsheetFormat); AFormat: TsSpreadsheetFormat);
@ -3620,13 +3643,16 @@ begin
raise Exception.CreateFmt(lpNoValidSpreadsheetFile, [AFileName]); raise Exception.CreateFmt(lpNoValidSpreadsheetFile, [AFileName]);
end; end;
{@@
Reads the document from a file, but ignores the extension.
}
procedure TsWorkbook.ReadFromFileIgnoringExtension(AFileName: string); procedure TsWorkbook.ReadFromFileIgnoringExtension(AFileName: string);
var var
SheetType: TsSpreadsheetFormat; SheetType: TsSpreadsheetFormat;
lException: Exception; lException: Exception;
begin begin
SheetType := sfExcel8; SheetType := sfExcel8;
while (SheetType in [sfExcel2..sfExcel8]) and (lException <> nil) do while (SheetType in [sfExcel2..sfExcel8, sfOpenDocument, sfOOXML]) and (lException <> nil) do
begin begin
try try
Dec(SheetType); Dec(SheetType);
@ -3642,6 +3668,9 @@ end;
{@@ {@@
Reads the document from a seekable stream. Reads the document from a seekable stream.
@param AStream Stream being read
@param AFormat File format assumed.
} }
procedure TsWorkbook.ReadFromStream(AStream: TStream; procedure TsWorkbook.ReadFromStream(AStream: TStream;
AFormat: TsSpreadsheetFormat); AFormat: TsSpreadsheetFormat);
@ -3658,9 +3687,13 @@ begin
end; end;
{@@ {@@
Writes the document to a file. Writes the document to a file. If the file doesn't exist, it will be created.
If the file doesn't exist, it will be created. @param AFileName Name of the file to be written
@param AFormat The file will be written in this file format
@param AOverwriteExisting If the file is already existing it will be
overwritten in case of AOverwriteExisting = true.
If false an exception will be raised.
} }
procedure TsWorkbook.WriteToFile(const AFileName: string; procedure TsWorkbook.WriteToFile(const AFileName: string;
const AFormat: TsSpreadsheetFormat; const AOverwriteExisting: Boolean = False); const AFormat: TsSpreadsheetFormat; const AOverwriteExisting: Boolean = False);
@ -3676,7 +3709,13 @@ begin
end; end;
{@@ {@@
Writes the document to file based on the extension. If this was an earlier sfExcel type file, it will be upgraded to sfExcel8, Writes the document to file based on the extension.
If this was an earlier sfExcel type file, it will be upgraded to sfExcel8.
@param AFileName Name of the destination file
@param AOverwriteExisting If the file already exists it will be overwritten
of AOverwriteExisting is true. In case of false, an
exception will be raised.
} }
procedure TsWorkbook.WriteToFile(const AFileName: String; procedure TsWorkbook.WriteToFile(const AFileName: String;
const AOverwriteExisting: Boolean); const AOverwriteExisting: Boolean);
@ -3692,6 +3731,9 @@ end;
{@@ {@@
Writes the document to a stream Writes the document to a stream
@param AStream Instance of the stream being written to
@param AFormat File format being written.
} }
procedure TsWorkbook.WriteToStream(AStream: TStream; AFormat: TsSpreadsheetFormat); procedure TsWorkbook.WriteToStream(AStream: TStream; AFormat: TsSpreadsheetFormat);
var var
@ -4782,6 +4824,13 @@ begin
// nothing to do here // nothing to do here
end; end;
{@@
Callback function for collecting all formatting styles found in the worksheet.
@param ACell Pointer to the worksheet cell being tested whether its format
already has been found in the array FFormattingStyles.
@param AStream Stream to which the workbook is written
}
procedure TsCustomSpreadWriter.ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream); procedure TsCustomSpreadWriter.ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream);
var var
Len: Integer; Len: Integer;
@ -4803,6 +4852,10 @@ begin
Inc(NextXFIndex); Inc(NextXFIndex);
end; end;
{@@
This method collects all formatting styles found in the worksheet and
stores unique prototypes in the array FFormattingStyles.
}
procedure TsCustomSpreadWriter.ListAllFormattingStyles; procedure TsCustomSpreadWriter.ListAllFormattingStyles;
var var
i: Integer; i: Integer;
@ -5308,10 +5361,10 @@ end;
needed parameters must have been created before. needed parameters must have been created before.
@param AToken Formula element indicating the function to be executed, @param AToken Formula element indicating the function to be executed,
see the TsFEKind enumeration for possible values. see the TFEKind enumeration for possible values.
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
@see TsFEKind @see TFEKind
} }
function RPNFunc(AToken: TFEKind; ANext: PRPNItem): PRPNItem; function RPNFunc(AToken: TFEKind; ANext: PRPNItem): PRPNItem;
begin begin
@ -5327,11 +5380,11 @@ end;
They must have been created before. They must have been created before.
@param AToken Formula element indicating the function to be executed, @param AToken Formula element indicating the function to be executed,
see the TsFEKind enumeration for possible values. see the TFEKind enumeration for possible values.
@param ANumParams Number of arguments used in the formula @param ANumParams Number of arguments used in the formula
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
@see TsFEKind @see TFEKind
} }
function RPNFunc(AToken: TFEKind; ANumParams: Byte; ANext: PRPNItem): PRPNItem; function RPNFunc(AToken: TFEKind; ANumParams: Byte; ANext: PRPNItem): PRPNItem;
begin begin

509
components/fpspreadsheet/fpsutils.pas
View File

@ -16,20 +16,31 @@ uses
// Exported types // Exported types
type type
{@@ Selection direction along column or along row }
TsSelectionDirection = (fpsVerticalSelection, fpsHorizontalSelection); TsSelectionDirection = (fpsVerticalSelection, fpsHorizontalSelection);
{@@ Set of characters }
TsDecsChars = set of char; TsDecsChars = set of char;
// to be removed when fpc trunk is stable {@@ Options for the FormatDateTime function to activate time interval strings
with more than 24 hours.
Will be removed when this feature is in fpc/stable
}
TFormatDateTimeOption = (fdoInterval); TFormatDateTimeOption = (fdoInterval);
{@@ Options for the FormatDateTime function to activate time interval strings
with more than 24 hours.
Will be removed when this feature is in fpc/stable
}
TFormatDateTimeOptions = set of TFormatDateTimeOption; TFormatDateTimeOptions = set of TFormatDateTimeOption;
const const
// Date formatting string for unambiguous date/time display as strings {@@ Date formatting string for unambiguous date/time display as strings
// Can be used for text output when date/time cell support is not available Can be used for text output when date/time cell support is not available }
ISO8601Format='yyyymmdd"T"hhmmss'; ISO8601Format='yyyymmdd"T"hhmmss';
// Extended ISO 8601 date/time format, used in e.g. ODF/opendocument {@@ Extended ISO 8601 date/time format, used in e.g. ODF/opendocument }
ISO8601FormatExtended='yyyy"-"mm"-"dd"T"hh":"mm":"ss'; ISO8601FormatExtended='yyyy"-"mm"-"dd"T"hh":"mm":"ss';
// ISO 8601 time-only format, used in ODF/opendocument {@@ ISO 8601 time-only format, used in ODF/opendocument }
ISO8601FormatTimeOnly='"PT"hh"H"nn"M"ss"S"'; ISO8601FormatTimeOnly='"PT"hh"H"nn"M"ss"S"';
// Endianess helper functions // Endianess helper functions
@ -89,8 +100,8 @@ function AddAMPM(const ATimeFormatString: String;
function StripAMPM(const ATimeFormatString: String): String; function StripAMPM(const ATimeFormatString: String): String;
function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte;
function AddIntervalBrackets(AFormatString: String): String; function AddIntervalBrackets(AFormatString: String): String;
function MakeLongDateFormat(AShortDateFormat: String): String; function MakeLongDateFormat(ADateFormat: String): String;
function MakeShortDateFormat(AShortDateFormat: String): String; function MakeShortDateFormat(ADateFormat: String): String;
function SpecialDateTimeFormat(ACode: String; function SpecialDateTimeFormat(ACode: String;
const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; const AFormatSettings: TFormatSettings; ForWriting: Boolean): String;
procedure SplitFormatString(const AFormatString: String; out APositivePart, procedure SplitFormatString(const AFormatString: String; out APositivePart,
@ -130,21 +141,28 @@ implementation
uses uses
Math; Math;
{ {******************************************************************************}
Endianess helper functions { Endianess helper functions }
{******************************************************************************}
Excel files are all written with Little Endian byte order, { Excel files are all written with little endian byte order,
so it's necessary to swap the data to be able to build a so it's necessary to swap the data to be able to build a
correct file on big endian systems. correct file on big endian systems.
These routines are preferable to System unit routines because they The routines WordToLE, DWordToLE, IntegerToLE etc are preferable to
ensure that the correct overloaded version of the conversion routines System unit routines because they ensure that the correct overloaded version
will be used, avoiding typecasts which are less readable. of the conversion routines will be used, avoiding typecasts which are less readable.
They also guarantee delphi compatibility. For Delphi we just support They also guarantee delphi compatibility. For Delphi we just support
big-endian isn't support, because Delphi doesn't support it. big-endian isn't support, because Delphi doesn't support it.
} }
{@@
WordLEToLE converts a word value from big-endian to little-endian byte order.
@param AValue Big-endian word value
@return Little-endian word value
}
function WordToLE(AValue: Word): Word; function WordToLE(AValue: Word): Word;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -154,6 +172,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@
DWordLEToLE converts a DWord value from big-endian to little-endian byte-order.
@param AValue Big-endian DWord value
@return Little-endian DWord value
}
function DWordToLE(AValue: Cardinal): Cardinal; function DWordToLE(AValue: Cardinal): Cardinal;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -163,6 +187,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@
Converts an integer value from big-endian to little-endian byte-order.
@param AValue Big-endian integer value
@return Little-endian integer value
}
function IntegerToLE(AValue: Integer): Integer; function IntegerToLE(AValue: Integer): Integer;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -172,6 +202,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@
Converts a word value from little-endian to big-endian byte-order.
@param AValue Little-endian word value
@return Big-endian word value
}
function WordLEtoN(AValue: Word): Word; function WordLEtoN(AValue: Word): Word;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -181,6 +217,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@
Converts a DWord value from little-endian to big-endian byte-order.
@param AValue Little-endian DWord value
@return Big-endian DWord value
}
function DWordLEtoN(AValue: Cardinal): Cardinal; function DWordLEtoN(AValue: Cardinal): Cardinal;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -190,6 +232,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@
Converts a widestring from big-endian to little-endian byte-order.
@param AValue Big-endian widestring
@return Little-endian widestring
}
function WideStringToLE(const AValue: WideString): WideString; function WideStringToLE(const AValue: WideString): WideString;
{$IFNDEF FPC} {$IFNDEF FPC}
var var
@ -210,6 +258,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@
Converts a widestring from little-endian to big-endian byte-order.
@param AValue Little-endian widestring
@return Big-endian widestring
}
function WideStringLEToN(const AValue: WideString): WideString; function WideStringLEToN(const AValue: WideString): WideString;
{$IFNDEF FPC} {$IFNDEF FPC}
var var
@ -230,9 +284,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{ Converts RGB part of a LongRGB logical structure to its physical representation {@@
IOW: RGBA (where A is 0 and omitted in the function call) => ABGR Converts the RGB part of a LongRGB logical structure to its physical representation.
Needed for conversion of palette colors. } 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; function LongRGBToExcelPhysical(const RGB: DWord): DWord;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -250,6 +307,14 @@ end;
{@@ {@@
Parses strings like A5:A10 into an selection interval information Parses strings like A5:A10 into an selection interval information
@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
@return false if the string is not a valid cell range
} }
function ParseIntervalString(const AStr: string; function ParseIntervalString(const AStr: string;
out AFirstCellRow, AFirstCellCol, ACount: Integer; out AFirstCellRow, AFirstCellCol, ACount: Integer;
@ -305,6 +370,16 @@ end;
{@@ {@@
Parses strings like A5:C10 into a range selection information. Parses strings like A5:C10 into a range selection information.
Returns in AFlags also information on relative/absolute cells. Returns in AFlags also information on relative/absolute cells.
@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.
@return false if the string is not a valid cell range
} }
function ParseCellRangeString(const AStr: string; function ParseCellRangeString(const AStr: string;
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Integer; out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Integer;
@ -340,7 +415,14 @@ end;
Note that there can be several letters to address for more than 26 columns. Note that there can be several letters to address for more than 26 columns.
'AFlags' indicates relative addresses. 'AFlags' indicates relative addresses.
Example "AMP$200" --> (rel) column 1029 (= 26*26*1 + 26*16 + 26 - 1) @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) (abs) row = 199 (abs)
} }
function ParseCellString(const AStr: String; out ACellRow, ACellCol: Integer; function ParseCellString(const AStr: String; out ACellRow, ACellCol: Integer;
@ -411,8 +493,18 @@ begin
Result := Scan(1); Result := Scan(1);
end; end;
{ for compatibility with old version which does not return flags for relative {@@
cell addresses } 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
}
function ParseCellString(const AStr: string; function ParseCellString(const AStr: string;
out ACellRow, ACellCol: Integer): Boolean; out ACellRow, ACellCol: Integer): Boolean;
var var
@ -421,6 +513,13 @@ begin
Result := ParseCellString(AStr, ACellRow, ACellCol, flags); Result := ParseCellString(AStr, ACellRow, ACellCol, flags);
end; end;
{@@
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
}
function ParseCellRowString(const AStr: string; out AResult: Integer): Boolean; function ParseCellRowString(const AStr: string; out AResult: Integer): Boolean;
begin begin
try try
@ -431,6 +530,14 @@ begin
Result := True; Result := True;
end; end;
{@@
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
}
function ParseCellColString(const AStr: string; out AResult: Integer): Boolean; function ParseCellColString(const AStr: string; out AResult: Integer): Boolean;
const const
INT_NUM_LETTERS = 26; INT_NUM_LETTERS = 26;
@ -460,7 +567,13 @@ begin
Result := Char(AValue + ord('A')); Result := Char(AValue + ord('A'));
end; end;
{ Calculates an Excel column name ('A', 'B' etc) from the zero-based column index } {@@
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
}
function GetColString(AColIndex: Integer): String; function GetColString(AColIndex: Integer): String;
{ Code adapted from: http://stackoverflow.com/questions/12796973/vba-function-to-convert-column-number-to-letter } { Code adapted from: http://stackoverflow.com/questions/12796973/vba-function-to-convert-column-number-to-letter }
var var
@ -479,6 +592,18 @@ end;
const const
RELCHAR: Array[boolean] of String = ('$', ''); RELCHAR: Array[boolean] of String = ('$', '');
{@@
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
@param AFlags A set containing an entry for column and row if these
addresses are relative.
@return Excel-type of cell address containing $ characters for absolute
address parts.
@example ARowIndex = 0, AColIndex = 0, AFlags = [rfRow] --> $A1
}
function GetCellString(ARow, ACol: Cardinal; AFlags: TsRelFlags): String; function GetCellString(ARow, ACol: Cardinal; AFlags: TsRelFlags): String;
begin begin
Result := Format('%s%s%s%d', [ Result := Format('%s%s%s%d', [
@ -487,6 +612,22 @@ begin
]); ]);
end; end;
{@@
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.
@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
@example ARow1 = 0, ACol1 = 0, ARow = 2, ACol = 1, AFlags = [rfRow, rfRow2]
--> $A1:$B3
}
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): String; function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): String;
begin begin
Result := Format('%s%s%s%d:%s%s%s%d', [ Result := Format('%s%s%s%d:%s%s%s%d', [
@ -495,11 +636,15 @@ begin
RELCHAR[rfRelCol2 in AFlags], GetColString(ACol2), RELCHAR[rfRelCol2 in AFlags], GetColString(ACol2),
RELCHAR[rfRelRow2 in AFlags], ARow2 + 1 RELCHAR[rfRelRow2 in AFlags], ARow2 + 1
]); ]);
// Result := GetCellString(ARow1, ACol1, AFlags) + ':' + GetCellString(ARow2, ACol2, [rfRelRow2, rfRelCol2]);
end; end;
{ Returns the message text assigned to an error value } {@@
Returns the message text assigned to an error value
@param AErrorValue Error code as defined by TsErrorvalue
@return Text corresponding to the error code.
}
function GetErrorValueStr(AErrorValue: TsErrorValue): String; function GetErrorValueStr(AErrorValue: TsErrorValue): String;
begin begin
case AErrorValue of case AErrorValue of
@ -517,7 +662,13 @@ begin
end; end;
end; end;
{In XML files some chars must be translated} {@@
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.
}
function UTF8TextToXMLText(AText: ansistring): ansistring; function UTF8TextToXMLText(AText: ansistring): ansistring;
var var
Idx:Integer; Idx:Integer;
@ -554,27 +705,48 @@ begin
Result:=WrkStr; Result:=WrkStr;
end; end;
{ Returns either AValue1 or AValue2, depending on the condition. {@@
For reduciton of typing... } 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.
}
function IfThen(ACondition: Boolean; AValue1, AValue2: TsNumberFormat): TsNumberFormat; function IfThen(ACondition: Boolean; AValue1, AValue2: TsNumberFormat): TsNumberFormat;
begin begin
if ACondition then Result := AValue1 else Result := AValue2; if ACondition then Result := AValue1 else Result := AValue2;
end; end;
{ Checks whether the given number format code is for currency, {@@
i.e. requires currency symbol. } Checks whether the given number format code is for currency,
i.e. requires currency symbol.
@param AFormat Built-in number format identifier to be checked
@return True if AFormat is nfCurrency or nfCurrencyRed, false otherwise. }
function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean;
begin begin
Result := AFormat in [nfCurrency, nfCurrencyRed]; Result := AFormat in [nfCurrency, nfCurrencyRed];
end; end;
{ Checks whether the given number format code is for date/times. } {@@
Checks whether the given number format code is for date/time values.
@param AFormat Built-in number format identifier to be checked
@return True if AFormat is a date/time format (such as nfShortTime), false otherwise }
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
begin begin
Result := AFormat in [{nfFmtDateTime, }nfShortDateTime, nfShortDate, nfLongDate, Result := AFormat in [{nfFmtDateTime, }nfShortDateTime, nfShortDate, nfLongDate,
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval]; nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval];
end; end;
{@@
Checks whether the given string with formatting codes is for date/time values.
@param AFormatStr String with formatting codes to be checked.
@return True if AFormatStr is a date/time format string (such as 'hh:nn'),
false otherwise }
function IsDateTimeFormat(AFormatStr: string): Boolean; function IsDateTimeFormat(AFormatStr: string): Boolean;
var var
parser: TsNumFormatParser; parser: TsNumFormatParser;
@ -587,12 +759,22 @@ begin
end; end;
end; end;
{@@
Checks whether the given built-in number format code is for time values.
@param AFormat Built-in number format identifier to be checked
@return True if AFormat represents to a time-format, false otherwise }
function IsTimeFormat(AFormat: TsNumberFormat): boolean; function IsTimeFormat(AFormat: TsNumberFormat): boolean;
begin begin
Result := AFormat in [nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, Result := AFormat in [nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM,
nfTimeInterval]; nfTimeInterval];
end; end;
{@@
Checks whether the given string with formatting codes is for time values.
@param AFormatStr String with formatting codes to be checked
@return True if AFormatStr represents a time-format, false otherwise }
function IsTimeFormat(AFormatStr: String): Boolean; function IsTimeFormat(AFormatStr: String): Boolean;
var var
parser: TsNumFormatParser; parser: TsNumFormatParser;
@ -605,10 +787,18 @@ begin
end; end;
end; end;
{ Builds a date/time format string from the numberformat code. If the format code {@@
is nfFmtDateTime the given AFormatString is used. AFormatString can use the Builds a date/time format string from the number format code.
abbreviations "dm" (for "d/mmm"), "my" (for "mmm/yy"), "ms" (for "mm:ss")
and "msz" (for "mm:ss.z"). } @param ANumberFormat built-in number format identifier
@param AFormatSettings Format settings from which locale-dependent
information like day-month-year order is taken.
@param AFormatString Optional pre-built formatting string. It is used
only for the format nfInterval where square brackets
are added to the first time code field.
@return String of date/time formatting code constructed from the built-in
format information.
}
function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat; function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; AFormatString: String = '') : string; const AFormatSettings: TFormatSettings; AFormatString: String = '') : string;
begin begin
@ -788,6 +978,17 @@ begin
end; end;
end; end;
{@@
Adds an AM/PM format code to a pre-built time formatting string. The strings
replacing "AM" or "PM" in the final formatted number are taken from the
TimeAMString or TimePMString of the given FormatSettings.
@param ATimeFormatString String of time formatting codes (such as 'hh:nn')
@param AFormatSettings FormatSettings for locale-dependent information
@result Formatting string with AM/PM option activated.
Example: ATimeFormatString = 'hh:nn' ==> 'hh:nn AM/PM'
}
function AddAMPM(const ATimeFormatString: String; function AddAMPM(const ATimeFormatString: String;
const AFormatSettings: TFormatSettings): String; const AFormatSettings: TFormatSettings): String;
var var
@ -798,6 +999,14 @@ begin
Result := Format('%s %s/%s', [StripAMPM(ATimeFormatString), am, pm]); Result := Format('%s %s/%s', [StripAMPM(ATimeFormatString), am, pm]);
end; end;
{@@
Removes an AM/PM formatting code from a given time formatting string. Variants
of "AM/PM" are considered as well. The string is left unchanged if it does not
contain AM/PM codes.
@param ATimeFormatString String of time formatting codes (such as 'hh:nn AM/PM')
@return Formatting string with AM/PM being removed (--> 'hh:nn')
}
function StripAMPM(const ATimeFormatString: String): String; function StripAMPM(const ATimeFormatString: String): String;
var var
i: Integer; i: Integer;
@ -815,6 +1024,15 @@ begin
end; end;
end; end;
{@@
Counts how many decimal places are coded into a given formatting string.
@param AFormatString String with number format codes, such as '0.000'
@param ADecChars Characters which are considered as symbols for decimals.
For the fixed decimals, this is the '0'. Optional
decimals are encoced as '#'.
@return Count of decimal places found (3 in above example).
}
function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte;
var var
i: Integer; i: Integer;
@ -834,9 +1052,16 @@ begin
end; end;
end; end;
{ The given format string is assumed to be for time intervals, i.e. its first {@@
time symbol must be enclosed by square brackets. Checks if this is true, and The given format string is assumed to represent for time intervals, i.e. its
adds the brackes if not. } first time symbol must be enclosed by square brackets. Checks if this is true,
and adds the brackes if not.
@param AFormatString String with time formatting codes
@return Unchanged format string if its first time code is in square brackets
(as in '[h]:nn:ss'), if not, the first time code is enclosed in
square brackets.
}
function AddIntervalBrackets(AFormatString: String): String; function AddIntervalBrackets(AFormatString: String): String;
var var
p: Integer; p: Integer;
@ -855,66 +1080,88 @@ begin
end; end;
end; end;
{ Creates a long date format string out of a short one. Retains the order of {@@
year-month-day and the separators, but uses 4 digits for year and 3 digits of m } Creates a long date format string out of a short date format string.
function MakeLongDateFormat(AShortDateFormat: String): String; Retains the order of year-month-day and the separators, but uses 4 digits
for year and 3 digits of month.
@param ADateFormat String with date formatting code representing a
"short" date, such as 'dd/mm/yy'
@return Format string modified to represent a "long" date, such as 'dd/mmm/yyyy'
}
function MakeLongDateFormat(ADateFormat: String): String;
var var
i: Integer; i: Integer;
begin begin
Result := ''; Result := '';
i := 1; i := 1;
while i < Length(AShortDateFormat) do begin while i < Length(ADateFormat) do begin
case AShortDateFormat[i] of case ADateFormat[i] of
'y', 'Y': 'y', 'Y':
begin begin
Result := Result + DupeString(AShortDateFormat[i], 4); Result := Result + DupeString(ADateFormat[i], 4);
while (i < Length(AShortDateFormat)) and (AShortDateFormat[i] in ['y','Y']) do while (i < Length(ADateFormat)) and (ADateFormat[i] in ['y','Y']) do
inc(i); inc(i);
end; end;
'm', 'M': 'm', 'M':
begin begin
result := Result + DupeString(AShortDateFormat[i], 3); result := Result + DupeString(ADateFormat[i], 3);
while (i < Length(AShortDateFormat)) and (AShortDateFormat[i] in ['m','M']) do while (i < Length(ADateFormat)) and (ADateFormat[i] in ['m','M']) do
inc(i); inc(i);
end; end;
else else
Result := Result + AShortDateFormat[i]; Result := Result + ADateFormat[i];
inc(i); inc(i);
end; end;
end; end;
end; end;
{ Modifies the short date format such that it has a two-digit year and a two-digit {@@
month. Retains the order of year-month-day and the separators. } Modifies the short date format such that it has a two-digit year and a two-digit
function MakeShortDateFormat(AShortDateFormat: String): String; month. Retains the order of year-month-day and the separators.
@param ADateFormat String with date formatting codes representing a
"long" date, such as 'dd/mmm/yyyy'
@return Format string modified to represent a "short" date, such as 'dd/mm/yy'
}
function MakeShortDateFormat(ADateFormat: String): String;
var var
i: Integer; i: Integer;
begin begin
Result := ''; Result := '';
i := 1; i := 1;
while i < Length(AShortDateFormat) do begin while i < Length(ADateFormat) do begin
case AShortDateFormat[i] of case ADateFormat[i] of
'y', 'Y': 'y', 'Y':
begin begin
Result := Result + DupeString(AShortDateFormat[i], 2); Result := Result + DupeString(ADateFormat[i], 2);
while (i < Length(AShortDateFormat)) and (AShortDateFormat[i] in ['y','Y']) do while (i < Length(ADateFormat)) and (ADateFormat[i] in ['y','Y']) do
inc(i); inc(i);
end; end;
'm', 'M': 'm', 'M':
begin begin
result := Result + DupeString(AShortDateFormat[i], 2); result := Result + DupeString(ADateFormat[i], 2);
while (i < Length(AShortDateFormat)) and (AShortDateFormat[i] in ['m','M']) do while (i < Length(ADateFormat)) and (ADateFormat[i] in ['m','M']) do
inc(i); inc(i);
end; end;
else else
Result := Result + AShortDateFormat[i]; Result := Result + ADateFormat[i];
inc(i); inc(i);
end; end;
end; end;
end; end;
{ Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz" {@@
out of the formatsettings. } Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz"
out of the formatsettings.
@param ACode Quick formatting code for parts of date/time number formats;
"dm" = day + month
"my" = month + year
"ms" = minutes + seconds
"msz" = minutes + seconds + fractions of a second
@return String of formatting codes according to the parameter ACode
}
function SpecialDateTimeFormat(ACode: String; function SpecialDateTimeFormat(ACode: String;
const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; const AFormatSettings: TFormatSettings; ForWriting: Boolean): String;
var var
@ -949,6 +1196,24 @@ begin
Result := ACode; Result := ACode;
end; end;
{@@
Currency formatting strings consist of three parts, separated by
semicolons, which are valid for positive, negative or zero values.
Splits such a formatting string at the positions of the semicolons and
returns the sections. If semicolons are used for other purposed within
sections they have to be quoted by " or escaped by \. If the formatting
string contains less sections than three the missing strings are returned
as empty strings.
@param AFormatString String of number formatting codes.
@param APositivePart First section of the formatting string which is valid
for positive numbers (or positive and zero, if there
are only two sections)
@param ANegativePart Second section of the formatting string which is valid
for negative numbers
@param AZeroPart Third section of the formatting string for zero.
}
procedure SplitFormatString(const AFormatString: String; out APositivePart, procedure SplitFormatString(const AFormatString: String; out APositivePart,
ANegativePart, AZeroPart: String); ANegativePart, AZeroPart: String);
@ -1031,63 +1296,117 @@ begin
end; end;
end; end;
{ Excel's unit of row heights is "twips", i.e. 1/20 point. {@@
Converts Twips to points. } 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
}
function TwipsToPts(AValue: Integer): Single; function TwipsToPts(AValue: Integer): Single;
begin begin
Result := AValue / 20; Result := AValue / 20;
end; end;
{ Converts points to twips (1 twip = 1/20 point) } {@@
Converts points to twips (1 twip = 1/20 point)
@param AValue Length value in points
@return Value converted to twips
}
function PtsToTwips(AValue: Single): Integer; function PtsToTwips(AValue: Single): Integer;
begin begin
Result := round(AValue * 20); Result := round(AValue * 20);
end; end;
{ Converts centimeters to points (72 pts = 1 inch) } {@@
Converts centimeters to points (72 pts = 1 inch)
@param AValue Length value in centimeters
@return Value converted to points
}
function cmToPts(AValue: Double): Double; function cmToPts(AValue: Double): Double;
begin begin
Result := AValue * 72 / 2.54; Result := AValue * 72 / 2.54;
end; end;
{ Converts points to centimeters } {@@
Converts points to centimeters
@param AValue Length value in points
@return Value converted to centimeters
}
function PtsToCm(AValue: Double): Double; function PtsToCm(AValue: Double): Double;
begin begin
Result := AValue / 72 * 2.54; Result := AValue / 72 * 2.54;
end; end;
{ Converts inches to points (72 pts = 1 inch) } {@@
Converts inches to points (72 pts = 1 inch)
@param AValue Length value in inches
@return Value converted to points
}
function InToPts(AValue: Double): Double; function InToPts(AValue: Double): Double;
begin begin
Result := AValue * 72; Result := AValue * 72;
end; end;
{ Converts millimeters to points (72 pts = 1 inch) } {@@
Converts millimeters to points (72 pts = 1 inch)
@param AValue Length value in millimeters
@return Value converted to points
}
function mmToPts(AValue: Double): Double; function mmToPts(AValue: Double): Double;
begin begin
Result := AValue * 72 / 25.4; Result := AValue * 72 / 25.4;
end; end;
{ Converts points to millimeters } {@@
Converts points to millimeters
@param AValue Length value in points
@return Value converted to millimeters
}
function PtsToMM(AValue: Double): Double; function PtsToMM(AValue: Double): Double;
begin begin
Result := AValue / 72 * 25.4; Result := AValue / 72 * 25.4;
end; end;
{ Converts pixels to points. } {@@
Converts pixels to points.
@param AValue Length value given in pixels
@param AScreenPixelsPerInch Pixels per inch of the screen
@return Value converted to points
}
function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double; function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double;
begin begin
Result := (AValue / AScreenPixelsPerInch) * 72; Result := (AValue / AScreenPixelsPerInch) * 72;
end; end;
{ Converts points to pixels } {@@
Converts points to pixels
@param AValue Length value given in points
@param AScreenPixelsPerInch Pixels per inch of the screen
@return Value converted to pixels
}
function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer; function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer;
begin begin
Result := Round(AValue / 72 * AScreenPixelsPerInch); Result := Round(AValue / 72 * AScreenPixelsPerInch);
end; end;
{ converts a HTML length string to points. The units are assumed to be the last {@@
two digits of the string } 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).
@return Extracted length in points
}
function HTMLLengthStrToPts(AValue: String): Double; function HTMLLengthStrToPts(AValue: String): Double;
var var
units: String; units: String;
@ -1120,7 +1439,13 @@ begin
raise Exception.Create('Unknown length units'); raise Exception.Create('Unknown length units');
end; end;
{ converts a HTML color string to a TsColorValue. For ods } {@@
Converts a HTML color string to a TsColorValue. Need for the ODS file format.
@param AValue HTML color string, such as '#FF0000'
@return rgb color value in little endian byte-sequence. This value is
compatible with the TColor data type of the graphics unit.
}
function HTMLColorStrToColor(AValue: String): TsColorValue; function HTMLColorStrToColor(AValue: String): TsColorValue;
begin begin
if AValue = '' then if AValue = '' then
@ -1160,7 +1485,13 @@ begin
end; end;
end; end;
{ converts an rgb color value to a string as used in HTML code (for ods) } {@@
Converts an rgb color value to a string as used in HTML code (for ods)
@param AValue RGB color value (compatible with the TColor data type of the
graphics unit)
@return HTML-compatible string, like '#FF0000'
}
function ColorToHTMLColorStr(AValue: TsColorValue): String; function ColorToHTMLColorStr(AValue: TsColorValue): String;
type type
TRGB = record r,g,b,a: Byte end; TRGB = record r,g,b,a: Byte end;
@ -1180,10 +1511,16 @@ end;
{******************************************************************************} {******************************************************************************}
{******************************************************************************} {******************************************************************************}
// Copied from "fpc/rtl/objpas/sysutils/datei.inc" {@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime; procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime;
const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []); const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []);
// Copied from "fpc/rtl/objpas/sysutils/datei.inc"
var var
ResultLen: integer; ResultLen: integer;
ResultBuffer: array[0..255] of char; ResultBuffer: array[0..255] of char;
@ -1517,35 +1854,61 @@ begin (*
result := StrPas(@ResultBuffer[0]); result := StrPas(@ResultBuffer[0]);
end ; end ;
{@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
procedure DateTimeToString(out Result: string; const FormatStr: string; procedure DateTimeToString(out Result: string; const FormatStr: string;
const DateTime: TDateTime; Options : TFormatDateTimeOptions = []); const DateTime: TDateTime; Options : TFormatDateTimeOptions = []);
begin begin
DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings, Options); DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings, Options);
end; end;
{@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
function FormatDateTime(const FormatStr: string; DateTime: TDateTime; function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
Options : TFormatDateTimeOptions = []): string; Options : TFormatDateTimeOptions = []): string;
begin begin
DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings,Options); DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings,Options);
end; end;
{@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
function FormatDateTime(const FormatStr: string; DateTime: TDateTime; function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string; const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string;
begin begin
DateTimeToString(Result, FormatStr, DateTime, FormatSettings,Options); DateTimeToString(Result, FormatStr, DateTime, FormatSettings,Options);
end; end;
{ "Borrowed" from TAChart: silence warnings of unused parameters }
{$PUSH}{$HINTS OFF} {$PUSH}{$HINTS OFF}
{@@ Silence warnings due to an unused parameter }
procedure Unused(const A1); procedure Unused(const A1);
// code "borrowed" from TAChart
begin begin
end; end;
{@@ Silence warnings due to two unused parameters }
procedure Unused(const A1, A2); procedure Unused(const A1, A2);
// code "borrowed" from TAChart
begin begin
end; end;
{@@ Silence warnings due to three unused parameters }
procedure Unused(const A1, A2, A3); procedure Unused(const A1, A2, A3);
// code adapted from TAChart
begin begin
end; end;
{$POP} {$POP}