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

fpspreadsheet: More cosmetics

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3585 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-21 16:50:56 +00:00
parent 270a215261
commit d796b836cd
5 changed files with 1395 additions and 1351 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
components/fpspreadsheet/fpspreadsheet.chm
View File

Binary file not shown.

214
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1274,13 +1274,13 @@ begin
GsSpreadFormats[len].Format := AFormat;
end;
{@@
{@@ ----------------------------------------------------------------------------
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
@ -1301,7 +1301,7 @@ begin
end;
{@@
{@@ ----------------------------------------------------------------------------
If a palette is coded as big-endian (e.g. by copying the rgb values from
the OpenOffice doc) the palette values can be converted by means of this
procedure to little-endian which is required internally by TsWorkbook.
@ -1309,7 +1309,7 @@ end;
@param APalette Pointer to the palette to be converted. After conversion,
its color values are replaced.
@param APaletteSize Number of colors contained in the palette
}
-------------------------------------------------------------------------------}
procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
var
i: Integer;
@ -1320,12 +1320,12 @@ begin
{$POP}
end;
{@@
{@@ ----------------------------------------------------------------------------
Copies the format of a cell to another one.
@param AFromCell cell from which the format is to be copied
@param AToCell cell to which the format is to be copied
}
-------------------------------------------------------------------------------}
procedure CopyCellFormat(AFromCell, AToCell: PCell);
begin
Assert(AFromCell <> nil);
@ -1343,8 +1343,9 @@ begin
AToCell^.NumberFormatStr := AFromCell^.NumberFormatStr;
end;
{@@
Checks whether two cells have same border attributes }
{@@ ----------------------------------------------------------------------------
Checks whether two cells have same border attributes
-------------------------------------------------------------------------------}
function SameCellBorders(ACell1, ACell2: PCell): Boolean;
function NoBorder(ACell: PCell): Boolean;
@ -1379,10 +1380,10 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Initalizes a new cell
@return New cell record
}
-------------------------------------------------------------------------------}
procedure InitCell(out ACell: TCell);
begin
ACell.FormulaValue := '';
@ -1391,14 +1392,14 @@ begin
FillChar(ACell, SizeOf(ACell), 0);
end;
{@@
{@@ ----------------------------------------------------------------------------
Initalizes a new cell and presets the row and column fields of the cell record
to the parameters passesd 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 parameters.
}
-------------------------------------------------------------------------------}
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell);
begin
InitCell(ACell);
@ -1406,9 +1407,9 @@ begin
ACell.Col := ACol;
end;
{@@
{@@ ----------------------------------------------------------------------------
Returns TRUE if the cell contains a formula (direct or shared, does not matter).
}
-------------------------------------------------------------------------------}
function HasFormula(ACell: PCell): Boolean;
begin
Result := Assigned(ACell) and (
@ -4187,7 +4188,7 @@ begin
Result := WriteFont(ACell, fnt.FontName, fnt.Size, fnt.Style, AFontColor);
end;
{@@
{@@ ----------------------------------------------------------------------------
Replaces the font used in formatting of a cell considering only the font face
and leaving font size, style and color unchanged. Looks in the workbook's
font list if this modified font has already been used. If not a new font entry
@ -4197,13 +4198,13 @@ end;
@param ACol The column of the cell
@param AFontName Name of the new font to be used
@return Index of the font in the workbook's font list.
}
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer;
begin
result := WriteFontName(GetCell(ARow, ACol), AFontName);
end;
{@@
{@@ ----------------------------------------------------------------------------
Replaces the font used in formatting of a cell considering only the font face
and leaving font size, style and color unchanged. Looks in the workbook's
font list if this modified font has already been used. If not a new font entry
@ -4212,7 +4213,7 @@ end;
@param ACell Pointer to the cell
@param AFontName Name of the new font to be used
@return Index of the font in the workbook's font list.
}
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFontName(ACell: PCell; AFontName: String): Integer;
var
fnt: TsFont;
@ -4225,7 +4226,7 @@ begin
result := WriteFont(ACell, AFontName, fnt.Size, fnt.Style, fnt.Color);
end;
{@@
{@@ ----------------------------------------------------------------------------
Replaces the font size in formatting of a cell. Looks in the workbook's
font list if this modified font has already been used. If not a new font entry
is created. Returns the index of this font in the font list.
@ -4234,13 +4235,13 @@ end;
@param ACol The column of the cell
@param ASize Size of the font to be used (in points).
@return Index of the font in the workbook's font list.
}
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer;
begin
Result := WriteFontSize(GetCell(ARow, ACol), ASize);
end;
{@@
{@@ ----------------------------------------------------------------------------
Replaces the font size in formatting of a cell. Looks in the workbook's
font list if this modified font has already been used. If not a new font entry
is created. Returns the index of this font in the font list.
@ -4248,7 +4249,7 @@ end;
@param ACell Pointer to the cell
@param ASize Size of the font to be used (in points).
@return Index of the font in the workbook's font list.
}
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFontSize(ACell: PCell; ASize: Single): Integer;
var
fnt: TsFont;
@ -4261,7 +4262,7 @@ begin
Result := WriteFont(ACell, fnt.FontName, ASize, fnt.Style, fnt.Color);
end;
{@@
{@@ ----------------------------------------------------------------------------
Replaces the font style (bold, italic, etc) in formatting of a cell.
Looks in the workbook's font list if this modified font has already been used.
If not a new font entry is created.
@ -4273,14 +4274,14 @@ end;
@return Index of the font in the workbook's font list.
@see TsFontStyle
}
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFontStyle(ARow, ACol: Cardinal;
AStyle: TsFontStyles): Integer;
begin
Result := WriteFontStyle(GetCell(ARow, ACol), AStyle);
end;
{@@
{@@ ----------------------------------------------------------------------------
Replaces the font style (bold, italic, etc) in formatting of a cell.
Looks in the workbook's font list if this modified font has already been used.
If not a new font entry is created.
@ -4291,7 +4292,7 @@ end;
@return Index of the font in the workbook's font list.
@see TsFontStyle
}
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer;
var
fnt: TsFont;
@ -4305,7 +4306,7 @@ begin
Result := WriteFont(ACell, fnt.FontName, fnt.Size, AStyle, fnt.Color);
end;
{@@
{@@ ----------------------------------------------------------------------------
Adds text rotation to the formatting of a cell
@param ARow The row of the cell
@ -4314,7 +4315,7 @@ end;
@return Pointer to cell
@see TsTextRotation
}
-------------------------------------------------------------------------------}
function TsWorksheet.WriteTextRotation(ARow, ACol: Cardinal;
ARotation: TsTextRotation): PCell;
begin
@ -4322,14 +4323,14 @@ begin
WriteTextRotation(Result, ARotation);
end;
{@@
{@@ ----------------------------------------------------------------------------
Adds text rotation to the formatting of a cell
@param ACell Pointer to the cell
@param ARotation How to rotate the text
@see TsTextRotation
}
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteTextRotation(ACell: PCell; ARotation: TsTextRotation);
begin
if ACell = nil then
@ -4339,7 +4340,7 @@ begin
ChangedFont(ACell^.Row, ACell^.Col);
end;
{@@
{@@ ----------------------------------------------------------------------------
Directly modifies the used formatting fields of a cell.
Only formatting corresponding to items included in this set is executed.
@ -4349,7 +4350,7 @@ end;
@see TsUsedFormattingFields
@see TCell
}
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteUsedFormatting(ARow, ACol: Cardinal;
AUsedFormatting: TsUsedFormattingFields);
var
@ -4634,8 +4635,10 @@ end;
@param ARow Row index of the cell considered
@param ACol Column index of the cell considered
@param AValue Parameter for horizontal text alignment (haDefault, vaLeft, haCenter, haRight)
By default, texts are left-aligned, numbers and dates are right-aligned.
@param AValue Parameter for horizontal text alignment
(haDefault, vaLeft, haCenter, haRight)
By default, texts are left-aligned, numbers and dates are
right-aligned.
@return Pointer to cell
-------------------------------------------------------------------------------}
function TsWorksheet.WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment): PCell;
@ -4648,8 +4651,10 @@ end;
Defines the horizontal alignment of text in a cell.
@param ACell Pointer to the cell considered
@param AValue Parameter for horizontal text alignment (haDefault, vaLeft, haCenter, haRight)
By default, texts are left-aligned, numbers and dates are right-aligned.
@param AValue Parameter for horizontal text alignment
(haDefault, vaLeft, haCenter, haRight)
By default, texts are left-aligned, numbers and dates are
right-aligned.
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteHorAlignment(ACell: PCell; AValue: TsHorAlignment);
begin
@ -4665,11 +4670,13 @@ end;
@param ARow Row index of the cell considered
@param ACol Column index of the cell considered
@param AValue Parameter for vertical text alignment (vaDefault, vaTop, vaCenter, vaBottom)
@param AValue Parameter for vertical text alignment
(vaDefault, vaTop, vaCenter, vaBottom)
By default, texts are bottom-aligned.
@return Pointer to cell
-------------------------------------------------------------------------------}
function TsWorksheet.WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment): PCell;
function TsWorksheet.WriteVertAlignment(ARow, ACol: Cardinal;
AValue: TsVertAlignment): PCell;
begin
Result := GetCell(ARow, ACol);
WriteVertAlignment(Result, AValue);
@ -4679,7 +4686,8 @@ end;
Defines the vertical alignment of text in a cell.
@param ACell Poiner to the cell considered
@param AValue Parameter for vertical text alignment (vaDefault, vaTop, vaCenter, vaBottom)
@param AValue Parameter for vertical text alignment
(vaDefault, vaTop, vaCenter, vaBottom)
By default, texts are bottom-aligned.
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteVertAlignment(ACell: PCell; AValue: TsVertAlignment);
@ -4727,13 +4735,13 @@ begin
Result := FWorkbook.FormatSettings;
end;
{@@
{@@ ----------------------------------------------------------------------------
Calculates the optimum height of a given row. Depends on the font size
of the individual cells in the row.
@param ARow Index of the row to be considered
@return Row height in line count of the default font.
}
-------------------------------------------------------------------------------}
function TsWorksheet.CalcAutoRowHeight(ARow: Cardinal): Single;
var
cell: PCell;
@ -4749,12 +4757,14 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Checks if a row record exists for the given row index and returns a pointer
to the row record, or nil if not found
@param ARow Index of the row looked for
@return Pointer to the row record with this row index, or nil if not found }
@return Pointer to the row record with this row index, or nil if not
found
-------------------------------------------------------------------------------}
function TsWorksheet.FindRow(ARow: Cardinal): PRow;
var
LElement: TRow;
@ -4767,12 +4777,14 @@ begin
result := PRow(AVLNode.Data);
end;
{@@
Checks if a column record exists for the given column index and returns a pointer
to the TCol record, or nil if not found
{@@ ----------------------------------------------------------------------------
Checks if a column record exists for the given column index and returns a
pointer to the TCol record, or nil if not found
@param ACol Index of the column looked for
@return Pointer to the column record with this column index, or nil if not found }
@return Pointer to the column record with this column index, or
nil if not found
-------------------------------------------------------------------------------}
function TsWorksheet.FindCol(ACol: Cardinal): PCol;
var
LElement: TCol;
@ -4785,12 +4797,14 @@ begin
result := PCol(AVLNode.Data);
end;
{@@
Checks if a row record exists for the given row index and creates it if not found.
{@@ ----------------------------------------------------------------------------
Checks if a row record exists for the given row index and creates it if not
found.
@param ARow Index of the row looked for
@return Pointer to the row record with this row index. It can safely be
assumed that this row record exists. }
assumed that this row record exists.
-------------------------------------------------------------------------------}
function TsWorksheet.GetRow(ARow: Cardinal): PRow;
begin
Result := FindRow(ARow);
@ -4806,13 +4820,14 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Checks if a column record exists for the given column index and creates it
if not found.
@param ACol Index of the column looked for
@return Pointer to the TCol record with this column index. It can safely be
assumed that this column record exists. }
@return Pointer to the TCol record with this column index. It can
safely be assumed that this column record exists.
-------------------------------------------------------------------------------}
function TsWorksheet.GetCol(ACol: Cardinal): PCol;
begin
Result := FindCol(ACol);
@ -4830,12 +4845,13 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Counts how many cells exist in the given column. Blank cells do contribute
to the sum, as well as formatted cells.
@param ACol Index of the column considered
@return Count of cells with value or format in this column }
@return Count of cells with value or format in this column
-------------------------------------------------------------------------------}
function TsWorksheet.GetCellCountInCol(ACol: Cardinal): Cardinal;
var
cell: PCell;
@ -4854,13 +4870,13 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Counts how many cells exist in the given row. Blank cells do contribute
to the sum, as well as formatted cell.s
@param ARow Index of the row considered
@return Count of cells with value or format in this row
}
-------------------------------------------------------------------------------}
function TsWorksheet.GetCellCountInRow(ARow: Cardinal): Cardinal;
var
cell: PCell;
@ -4879,13 +4895,13 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Returns the width of the given column. If there is no column record then
the default column width is returned.
@param ACol Index of the column considered
@return Width of the column (in count of "0" characters of the default font)
}
-------------------------------------------------------------------------------}
function TsWorksheet.GetColWidth(ACol: Cardinal): Single;
var
col: PCol;
@ -4897,13 +4913,13 @@ begin
Result := FDefaultColWidth;
end;
{@@
{@@ ----------------------------------------------------------------------------
Returns the height of the given row. If there is no row record then the
default row height is returned
@param ARow Index of the row considered
@return Height of the row (in line count of the default font).
}
-------------------------------------------------------------------------------}
function TsWorksheet.GetRowHeight(ARow: Cardinal): Single;
var
row: PRow;
@ -4916,13 +4932,13 @@ begin
Result := FDefaultRowHeight;
end;
{@@
Deletes the column at the index specified. Cells with greader column indexes are
moved one column to the left. Merged cell blocks and cell references in formulas
are considered as well.
{@@ ----------------------------------------------------------------------------
Deletes the column at the index specified. Cells with greader column indexes
are moved one column to the left. Merged cell blocks and cell references in
formulas are considered as well.
@param ACol Index of the column to be deleted
}
-------------------------------------------------------------------------------}
procedure TsWorksheet.DeleteCol(ACol: Cardinal);
var
cellnode: TAVLTreeNode;
@ -5004,13 +5020,13 @@ begin
ChangedCell(0, ACol);
end;
{@@
{@@ ----------------------------------------------------------------------------
Deletes the row at the index specified. Cells with greader row indexes are
moved one row up. Merged cell blocks and cell references in formulas
are considered as well.
@param ARow Index of the row to be deleted
}
-------------------------------------------------------------------------------}
procedure TsWorksheet.DeleteRow(ARow: Cardinal);
var
cellnode: TAVLTreeNode;
@ -5090,13 +5106,13 @@ begin
ChangedCell(ARow, 0);
end;
{@@
Inserts a column BEFORE the index specified. Cells with greater column indexes are
moved one column to the right. Merged cell blocks and cell references in formulas
are considered as well.
{@@ ----------------------------------------------------------------------------
Inserts a column BEFORE the index specified. Cells with greater column indexes
are moved one column to the right. Merged cell blocks and cell references in
formulas are considered as well.
@param ACol Index of the column before which a new column is inserted.
}
-------------------------------------------------------------------------------}
procedure TsWorksheet.InsertCol(ACol: Cardinal);
var
cellnode: TAVLTreeNode;
@ -5204,13 +5220,13 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Inserts a row BEFORE the row specified. Cells with greater row indexes are
moved one row down. Merged cell blocks and cell references in formulas are
considered as well.
@param ARow Index of the row before which a new row is inserted.
}
-------------------------------------------------------------------------------}
procedure TsWorksheet.InsertRow(ARow: Cardinal);
var
row: PRow;
@ -5313,10 +5329,10 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Removes all row records from the worksheet and frees the occupied memory.
Note: Cells are retained.
}
-------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveAllRows;
var
Node: Pointer;
@ -5346,8 +5362,9 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Removes a specified column record from the worksheet and frees the occupied memory.
This resets the its column width to default.
Removes a specified column record from the worksheet and frees the occupied
memory. This resets its column width to default.
Note: Cells in that column are retained.
-------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveCol(ACol: Cardinal);
@ -5385,7 +5402,8 @@ end;
{@@ ----------------------------------------------------------------------------
Writes a row record for the row at a given index to the spreadsheet.
Currently the row record contains only the row height (and the row index, of course).
Currently the row record contains only the row height (and the row index,
of course).
Creates a new row record if it does not yet exist.
@ -5521,8 +5539,8 @@ end;
{@@ ----------------------------------------------------------------------------
Constructor of the workbook class. Among others, it initializes the built-in
fonts, defines the default font, and sets up the FormatSettings for localization
of some number formats.
fonts, defines the default font, and sets up the FormatSettings for
localization of some number formats.
-------------------------------------------------------------------------------}
constructor TsWorkbook.Create;
begin
@ -5846,7 +5864,8 @@ begin
valid := GetFormatFromFileName(AFileName, SheetType);
if valid then WriteToFile(AFileName, SheetType, AOverwriteExisting)
else raise Exception.Create(Format(
'[TsWorkbook.WriteToFile] Attempted to save a spreadsheet by extension, but the extension %s is invalid.', [ExtractFileExt(AFileName)]));
'[TsWorkbook.WriteToFile] Attempt to save a spreadsheet by extension, ' +
'but the extension %s is not valid.', [ExtractFileExt(AFileName)]));
end;
{@@ ----------------------------------------------------------------------------
@ -6512,27 +6531,6 @@ begin
end
else
Result := $000000; // "black" as default
{
case AColorIndex of
$0040: Result := DEF_FOREGROUND_COLORVALUE;
$0041: Result := DEF_BACKGROUND_COLORVALUE;
$004D: Result := DEF_CHART_FOREGROUND_COLORVALUE;
$004E: Result := DEF_CHART_BACKGROUND_COLORVALUE;
$004F: Result := DEF_CHART_NEUTRAL_COLORVALUE;
$0051: Result := DEF_TOOLTIP_TEXT_COLORVALUE;
$7FFF: Result := DEF_FONT_AUTOMATIC_COLORVALUE;
else if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then
begin
if ((FPalette = nil) or (Length(FPalette) = 0)) then
Result := DEFAULT_PALETTE[AColorIndex]
else
Result := FPalette[AColorIndex];
end
else
Result := $000000; // "black" as default
end;
}
end;
{@@ ----------------------------------------------------------------------------
@ -6597,8 +6595,8 @@ end;
@param APaletteCount Count of numbers in the source palette
@param ABigEnding If true, indicates that the source palette is in
big-endian notation. The methods inverts the rgb
components to little-endian which is used by fpspreadsheet
internally.
components to little-endian which is used by
fpspreadsheet internally.
-------------------------------------------------------------------------------}
procedure TsWorkbook.UsePalette(APalette: PsPalette; APaletteCount: Word;
ABigEndian: Boolean);
@ -6998,7 +6996,9 @@ end;
the format list (or -1, if not found)
To be used by OpenDocument file format.
@param AFormatName Format name as used by OpenDocument to identify a number format
@param AFormatName Format name as used by OpenDocument to identify a
number format
@return Index of the format item in the list, or -1 if not found
-------------------------------------------------------------------------------}
function TsCustomNumFormatList.FindByName(AFormatName: String): integer;

2155
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

File diff suppressed because it is too large Load Diff

146
components/fpspreadsheet/fpsrpn.pas
View File

@ -58,12 +58,12 @@ uses
{ Simplified creation of RPN formulas }
{******************************************************************************}
{@@
{@@ ----------------------------------------------------------------------------
Creates a pointer to a new RPN item. This represents an element in the array
of token of an RPN formula.
@return Pointer to the RPN item
}
-------------------------------------------------------------------------------}
function NewRPNItem: PRPNItem;
begin
New(Result);
@ -71,21 +71,21 @@ begin
Result^.FE.StringValue := '';
end;
{@@
{@@ ----------------------------------------------------------------------------
Destroys an RPN item
}
-------------------------------------------------------------------------------}
procedure DisposeRPNItem(AItem: PRPNItem);
begin
if AItem <> nil then
Dispose(AItem);
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates a boolean value entry in the RPN array.
@param AValue Boolean value to be stored in the RPN item
@next ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNBool(AValue: Boolean; ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
@ -94,13 +94,13 @@ begin
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a cell value, specifed by its
address, e.g. 'A1'. Takes care of absolute and relative cell addresses.
@param ACellAddress Adress of the cell given in Excel A1 notation
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNCellValue(ACellAddress: String; ANext: PRPNItem): PRPNItem;
var
r,c: Cardinal;
@ -111,7 +111,7 @@ begin
Result := RPNCellValue(r,c, flags, ANext);
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a cell value, specifed by its
row and column index and a flag containing information on relative addresses.
@ -119,7 +119,7 @@ end;
@param ACol Column index of the cell
@param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNCellValue(ARow, ACol: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem;
begin
@ -131,7 +131,7 @@ begin
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a cell reference, specifed by its
address, e.g. 'A1'. Takes care of absolute and relative cell addresses.
"Cell reference" means that all properties of the cell can be handled.
@ -140,7 +140,7 @@ end;
@param ACellAddress Adress of the cell given in Excel A1 notation
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNCellRef(ACellAddress: String; ANext: PRPNItem): PRPNItem;
var
r,c: Cardinal;
@ -151,7 +151,7 @@ begin
Result := RPNCellRef(r,c, flags, ANext);
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a cell reference, specifed by its
row and column index and flags containing information on relative addresses.
"Cell reference" means that all properties of the cell can be handled.
@ -162,7 +162,7 @@ end;
@param ACol Column index of the cell
@param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNCellRef(ARow, ACol: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem;
begin
@ -174,14 +174,15 @@ begin
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a range of cells, specified by an
Excel-style address, e.g. A1:G5. As in Excel, use a $ sign to indicate
absolute addresses.
@param ACellRangeAddress Adress of the cell range given in Excel notation, such as A1:G5
@param ACellRangeAddress Adress of the cell range given in Excel notation,
such as A1:G5
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNCellRange(ACellRangeAddress: String; ANext: PRPNItem): PRPNItem;
var
r1,c1, r2,c2: Cardinal;
@ -192,7 +193,7 @@ begin
Result := RPNCellRange(r1,c1, r2,c2, flags, ANext);
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a range of cells, specified by the
row/column indexes of the top/left and bottom/right corners of the block.
The flags indicate relative indexes.
@ -203,7 +204,7 @@ end;
@param ACol2 Column index of the bottom/right cell
@param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNCellRange(ARow, ACol, ARow2, ACol2: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem;
begin
@ -217,7 +218,7 @@ begin
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a relative cell reference as used in
shared formulas. The given parameters indicate the relativ offset between
the current cell coordinates and a reference rell.
@ -226,7 +227,7 @@ end;
@param AColOffset Offset between current column and the column of a reference cell
@param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNCellOffset(ARowOffset, AColOffset: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem;
begin
@ -238,13 +239,13 @@ begin
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array with an error value.
@param AErrCode Error code to be inserted (see TsErrorValue
@param ANext Pointer to the next RPN item in the list
@see TsErrorValue
}
-------------------------------------------------------------------------------}
function RPNErr(AErrCode: TsErrorValue; ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
@ -253,12 +254,12 @@ begin
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a 2-byte unsigned integer
@param AValue Integer value to be inserted into the formula
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNInteger(AValue: Word; ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
@ -267,12 +268,12 @@ begin
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a missing argument in of function call.
Use this in a formula to indicate a missing argument
@param ANext Pointer to the next RPN item in the list.
}
-------------------------------------------------------------------------------}
function RPNMissingArg(ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
@ -280,12 +281,12 @@ begin
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a floating point number.
@param AValue Number value to be inserted into the formula
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNNumber(AValue: Double; ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
@ -294,12 +295,12 @@ begin
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array which puts the current operator in parenthesis.
For display purposes only, does not affect calculation.
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNParenthesis(ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
@ -307,12 +308,12 @@ begin
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a string.
@param AValue String to be inserted into the formula
@param ANext Pointer to the next RPN item in the list
}
-------------------------------------------------------------------------------}
function RPNString(AValue: String; ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
@ -321,92 +322,57 @@ begin
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for an Excel function or operation
specified by its TokenID (--> TFEKind). Note that array elements for all
needed parameters must have been created before.
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for an operation specified by its TokenID
(--> TFEKind). Note that array elements for all needed parameters must have
been created before.
@param AToken Formula element indicating the function to be executed,
see the TFEKind enumeration for possible values.
@param ANext Pointer to the next RPN item in the list
@see TFEKind
}
-------------------------------------------------------------------------------}
function RPNFunc(AToken: TFEKind; ANext: PRPNItem): PRPNItem;
begin
{
if FEProps[AToken].MinParams <> FEProps[AToken].MaxParams then
raise Exception.CreateFmt(lpSpecifyNumberOfParams, [FEProps[AToken].Symbol]);
}
Result := NewRPNItem;
Result^.FE.ElementKind := AToken;
Result^.Fe.FuncName := '';
Result^.Next := ANext;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for an Excel function or operation
specified by its TokenID (--> TFEKind). Note that array elements for all
needed parameters must have been created before.
specified by its name. Note that array elements for all needed parameters
must have been created before.
@param AToken Formula element indicating the function to be executed,
see the TFEKind enumeration for possible values.
@param ANext Pointer to the next RPN item in the list
@see TFEKind
}
@param AFuncName Name of the spreadsheet function (as used by Excel)
@param ANext Pointer to the next RPN item in the list
-------------------------------------------------------------------------------}
function RPNFunc(AFuncName: String; ANext: PRPNItem): PRPNItem;
begin
{
if FEProps[AToken].MinParams <> FEProps[AToken].MaxParams then
raise Exception.CreateFmt(lpSpecifyNumberOfParams, [FEProps[AToken].Symbol]);
}
Result := RPNFunc(AFuncName, 255, ANext); //FEProps[AToken].MinParams, ANext);
Result := RPNFunc(AFuncName, 255, ANext);
end;
{@@
Creates an entry in the RPN array for an Excel function or operation
specified by its TokenID (--> TFEKind). Specify the number of parameters used.
{@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for an Excel spreadsheet function
specified by its name. Specify the number of parameters used.
They must have been created before.
@param AToken Formula element indicating the function to be executed,
see the TFEKind enumeration for possible values.
@param ANumParams Number of arguments used in the formula. If -1 then the
fixed number of arguments known from the function definiton
is used.
@param AFuncName Name of the spreadsheet function (as used by Excel).
@param ANumParams Number of arguments used in the formula.
@param ANext Pointer to the next RPN item in the list
@see TFEKind
}
-------------------------------------------------------------------------------}
function RPNFunc(AFuncName: String; ANumParams: Byte; ANext: PRPNItem): PRPNItem;
begin
{
if (ANumParams > -1) then
if (ANumParams < FEProps[AToken].MinParams) or (ANumParams > FEProps[AToken].MaxParams) then
raise Exception.CreateFmt(lpIncorrectParamCount, [
FEProps[AToken].Symbol, FEProps[AToken].MinParams, FEProps[AToken].MaxParams
]);
}
Result := NewRPNItem;
Result^.FE.ElementKind := fekFunc;
Result^.Fe.FuncName := AFuncName;
Result^.FE.ParamsNum := ANumParams;
Result^.Next := ANext;
end;
(*
{@@
Returns if the function defined by the token requires a fixed number of parameter.
@param AElementKind Identifier of the formula function considered
}
function FixedParamCount(AElementKind: TFEKind): Boolean;
begin
Result := (FEProps[AElementKind].MinParams = FEProps[AElementKind].MaxParams)
and (FEProps[AElementKind].MinParams >= 0);
end;
*)
{@@
{@@ ----------------------------------------------------------------------------
Creates an RPN formula by a single call using nested RPN items.
For each formula element, use one of the RPNxxxx functions implemented here.
@ -431,7 +397,7 @@ end;
RPNFunc(fekAdd,
nil))));
</pre>
}
-------------------------------------------------------------------------------}
function CreateRPNFormula(AItem: PRPNItem; AReverse: Boolean = false): TsRPNFormula;
var
item: PRPNItem;
@ -461,13 +427,13 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Destroys the RPN formula starting with the given RPN item.
@param AItem Pointer to the first RPN items representing the formula.
Each item contains a pointer to the next item in the list.
The list is terminated by nil.
}
-------------------------------------------------------------------------------}
procedure DestroyRPNFormula(AItem: PRPNItem);
var
nextitem: PRPNItem;

231
components/fpspreadsheet/fpsutils.pas
View File

@ -179,12 +179,12 @@ type
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;
begin
{$IFDEF FPC}
@ -194,12 +194,12 @@ begin
{$ENDIF}
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;
begin
{$IFDEF FPC}
@ -209,12 +209,12 @@ begin
{$ENDIF}
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;
begin
{$IFDEF FPC}
@ -224,12 +224,12 @@ begin
{$ENDIF}
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;
begin
{$IFDEF FPC}
@ -239,12 +239,12 @@ begin
{$ENDIF}
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;
begin
{$IFDEF FPC}
@ -254,12 +254,12 @@ begin
{$ENDIF}
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;
{$IFNDEF FPC}
var
@ -280,12 +280,12 @@ begin
{$ENDIF}
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;
{$IFNDEF FPC}
var
@ -306,12 +306,14 @@ begin
{$ENDIF}
end;
{@@
{@@ ----------------------------------------------------------------------------
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) }
@return DWord containing RGB bytes in little-endian byte-order (A = 0)
-------------------------------------------------------------------------------}
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
begin
{$IFDEF FPC}
@ -327,7 +329,7 @@ begin
{$ENDIF}
end;
{@@
{@@ ----------------------------------------------------------------------------
Parses strings like A5:A10 into an selection interval information
@param AStr Cell range string, such as A5:A10
@ -336,8 +338,9 @@ end;
@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;
out AFirstCellRow, AFirstCellCol, ACount: Cardinal;
out ADirection: TsSelectionDirection): Boolean;
@ -389,7 +392,7 @@ begin
else Exit(False);
end;
{@@
{@@ ----------------------------------------------------------------------------
Parses strings like A5:C10 into a range selection information.
Returns in AFlags also information on relative/absolute cells.
@ -401,8 +404,9 @@ end;
@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;
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal;
out AFlags: TsRelFlags): Boolean;
@ -432,7 +436,7 @@ begin
end;
{@@
{@@ ----------------------------------------------------------------------------
Parses strings like A5:C10 into a range selection information.
Information on relative/absolute cells is ignored.
@ -442,17 +446,20 @@ end;
@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
}
--------------------------------------------------------------------------------}
function ParseCellRangeString(const AStr: string;
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal): Boolean;
var
flags: TsRelFlags;
begin
Result := ParseCellRangeString(AStr, AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol, flags);
Result := ParseCellRangeString(AStr,
AFirstCellRow, AFirstCellCol,
ALastCellRow, ALastCellCol,
flags
);
end;
{@@
{@@ ----------------------------------------------------------------------------
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.
'AFlags' indicates relative addresses.
@ -466,7 +473,7 @@ end;
@example "AMP$200" --> (rel) column 1029 (= 26*26*1 + 26*16 + 26 - 1)
(abs) row = 199 (abs)
}
-------------------------------------------------------------------------------}
function ParseCellString(const AStr: String; out ACellRow, ACellCol: Cardinal;
out AFlags: TsRelFlags): Boolean;
@ -485,7 +492,9 @@ function ParseCellString(const AStr: String; out ACellRow, ACellCol: Cardinal;
while (i <= Length(AStr)) do begin
if (UpCase(AStr[i]) in LETTERS) then begin
ACellCol := Cardinal(ord(UpCase(AStr[i])) - ord('A')) + 1 + ACellCol * 26;
if ACellCol >= MAX_COL_COUNT then // too many columns (dropping this limitation could cause overflow if a too long string is passed
if ACellCol >= MAX_COL_COUNT then
// too many columns (dropping this limitation could cause overflow
// if a too long string is passed
exit;
inc(i);
end
@ -543,7 +552,7 @@ begin
Result := Scan(1);
end;
{@@
{@@ ----------------------------------------------------------------------------
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.
@ -554,7 +563,7 @@ end;
@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;
out ACellRow, ACellCol: Cardinal): Boolean;
var
@ -563,13 +572,13 @@ begin
Result := ParseCellString(AStr, ACellRow, ACellCol, flags);
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: Cardinal): Boolean;
begin
try
@ -580,14 +589,14 @@ begin
Result := True;
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: Cardinal): Boolean;
const
INT_NUM_LETTERS = 26;
@ -617,15 +626,16 @@ begin
Result := Char(AValue + ord('A'));
end;
{@@
{@@ ----------------------------------------------------------------------------
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;
{ 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
n: Integer;
c: byte;
@ -642,7 +652,7 @@ end;
const
RELCHAR: Array[boolean] of String = ('$', '');
{@@
{@@ ----------------------------------------------------------------------------
Calculates a cell address string from zero-based column and row indexes and
the relative address state flags.
@ -654,7 +664,7 @@ const
@return Excel type of cell address containing $ characters for absolute
address parts.
@example ARowIndex = 0, AColIndex = 0, AFlags = [rfRelRow] --> $A1
}
-------------------------------------------------------------------------------}
function GetCellString(ARow, ACol: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
begin
@ -664,7 +674,7 @@ begin
]);
end;
{@@
{@@ ----------------------------------------------------------------------------
Calculates a cell range address string from zero-based column and row indexes
and the relative address state flags.
@ -679,7 +689,7 @@ end;
range
@example ARow1 = 0, ACol1 = 0, ARow = 2, ACol = 1, AFlags = [rfRelRow, rfRelRow2]
--> $A1:$B3
}
-------------------------------------------------------------------------------}
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol, rfRelRow2, rfRelCol2]): String;
begin
@ -691,13 +701,12 @@ begin
]);
end;
{@@
{@@ ----------------------------------------------------------------------------
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;
begin
case AErrorValue of
@ -715,7 +724,7 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Helper function to reduce typing: "if a conditions is true return the first
number format, otherwise return the second format"
@ -723,40 +732,45 @@ end;
@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
if ACondition then Result := AValue1 else Result := AValue2;
end;
{@@
{@@ ----------------------------------------------------------------------------
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. }
@return True if AFormat is nfCurrency or nfCurrencyRed, false otherwise.
-------------------------------------------------------------------------------}
function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean;
begin
Result := AFormat in [nfCurrency, nfCurrencyRed];
end;
{@@
{@@ ----------------------------------------------------------------------------
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 }
@return True if AFormat is a date/time format (such as nfShortTime),
false otherwise
-------------------------------------------------------------------------------}
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
begin
Result := AFormat in [{nfFmtDateTime, }nfShortDateTime, nfShortDate, nfLongDate,
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval];
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 }
false otherwise
-------------------------------------------------------------------------------}
function IsDateTimeFormat(AFormatStr: string): Boolean;
var
parser: TsNumFormatParser;
@ -769,22 +783,24 @@ begin
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 }
@return True if AFormat represents to a time-format, false otherwise
-------------------------------------------------------------------------------}
function IsTimeFormat(AFormat: TsNumberFormat): boolean;
begin
Result := AFormat in [nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM,
nfTimeInterval];
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 }
@return True if AFormatStr represents a time-format, false otherwise
-------------------------------------------------------------------------------}
function IsTimeFormat(AFormatStr: String): Boolean;
var
parser: TsNumFormatParser;
@ -797,7 +813,7 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Builds a date/time format string from the number format code.
@param ANumberFormat built-in number format identifier
@ -808,7 +824,7 @@ end;
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;
const AFormatSettings: TFormatSettings; AFormatString: String = '') : string;
begin
@ -844,7 +860,7 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Builds a currency format string. The presentation of negative values (brackets,
or minus signs) is taken from the provided format settings. The format string
consists of three sections, separated by semicolons.
@ -869,7 +885,7 @@ end;
If ? the CurrencyString of the FormatSettings is used.
@return String of formatting codes, such as '"$"#,##0.00;("$"#,##0.00);"EUR"0.00'
}
-------------------------------------------------------------------------------}
function BuildCurrencyFormatString(ADialect: TsNumFormatDialect;
ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings;
ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ACurrencySymbol: String): String;
@ -947,7 +963,7 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Builds a number format string from the number format code and the count of
decimal places.
@ -958,7 +974,7 @@ end;
value of the FormatSettings is used.
@return String of formatting codes, such as '#,##0.00' for nfFixedTh and 2 decimals
}
-------------------------------------------------------------------------------}
function BuildNumberFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; ADecimals: Integer = -1): String;
var
@ -988,7 +1004,7 @@ begin
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.
@ -998,7 +1014,7 @@ end;
@result Formatting string with AM/PM option activated.
Example: ATimeFormatString = 'hh:nn' ==> 'hh:nn AM/PM'
}
-------------------------------------------------------------------------------}
function AddAMPM(const ATimeFormatString: String;
const AFormatSettings: TFormatSettings): String;
var
@ -1009,14 +1025,14 @@ begin
Result := Format('%s %s/%s', [StripAMPM(ATimeFormatString), am, pm]);
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;
var
i: Integer;
@ -1034,7 +1050,7 @@ begin
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'
@ -1042,7 +1058,7 @@ end;
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;
var
i: Integer;
@ -1062,8 +1078,8 @@ begin
end;
end;
{@@
The given format string is assumed to represent for time intervals, i.e. its
{@@ ----------------------------------------------------------------------------
The given format string is assumed to represent a time interval, i.e. its
first time symbol must be enclosed by square brackets. Checks if this is true,
and adds the brackes if not.
@ -1071,7 +1087,7 @@ end;
@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;
var
p: Integer;
@ -1090,7 +1106,7 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates a long date format string out of a short date format string.
Retains the order of year-month-day and the separators, but uses 4 digits
for year and 3 digits of month.
@ -1098,7 +1114,7 @@ end;
@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
i: Integer;
@ -1126,14 +1142,14 @@ begin
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.
@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
i: Integer;
@ -1161,7 +1177,7 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz"
out of the formatsettings.
@ -1171,7 +1187,7 @@ end;
"ms" = minutes + seconds
"msz" = minutes + seconds + fractions of a second
@return String of formatting codes according to the parameter ACode
}
-------------------------------------------------------------------------------}
function SpecialDateTimeFormat(ACode: String;
const AFormatSettings: TFormatSettings; ForWriting: Boolean): String;
var
@ -1206,7 +1222,7 @@ begin
Result := ACode;
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
@ -1222,8 +1238,7 @@ end;
@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,
ANegativePart, AZeroPart: String);
@ -1281,14 +1296,14 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
Creates a "time interval" format string having the first time code identifier
in square brackets.
@param Src Source format string, must be a time format string, like 'hh:nn'
@param Dest Destination format string, will have the first time code element
of the src format string in square brackets, like '[hh]:nn'.
}
-------------------------------------------------------------------------------}
procedure MakeTimeIntervalMask(Src: String; var Dest: String);
var
L: TStrings;
@ -1306,108 +1321,108 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
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;
begin
Result := AValue / 20;
end;
{@@
{@@ ----------------------------------------------------------------------------
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;
begin
Result := round(AValue * 20);
end;
{@@
{@@ ----------------------------------------------------------------------------
Converts centimeters to points (72 pts = 1 inch)
@param AValue Length value in centimeters
@return Value converted to points
}
-------------------------------------------------------------------------------}
function cmToPts(AValue: Double): Double;
begin
Result := AValue * 72 / 2.54;
end;
{@@
{@@ ----------------------------------------------------------------------------
Converts points to centimeters
@param AValue Length value in points
@return Value converted to centimeters
}
-------------------------------------------------------------------------------}
function PtsToCm(AValue: Double): Double;
begin
Result := AValue / 72 * 2.54;
end;
{@@
{@@ ----------------------------------------------------------------------------
Converts inches to points (72 pts = 1 inch)
@param AValue Length value in inches
@return Value converted to points
}
-------------------------------------------------------------------------------}
function InToPts(AValue: Double): Double;
begin
Result := AValue * 72;
end;
{@@
{@@ ----------------------------------------------------------------------------
Converts millimeters to points (72 pts = 1 inch)
@param AValue Length value in millimeters
@return Value converted to points
}
-------------------------------------------------------------------------------}
function mmToPts(AValue: Double): Double;
begin
Result := AValue * 72 / 25.4;
end;
{@@
{@@ ----------------------------------------------------------------------------
Converts points to millimeters
@param AValue Length value in points
@return Value converted to millimeters
}
-------------------------------------------------------------------------------}
function PtsToMM(AValue: Double): Double;
begin
Result := AValue / 72 * 25.4;
end;
{@@
{@@ ----------------------------------------------------------------------------
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;
begin
Result := (AValue / AScreenPixelsPerInch) * 72;
end;
{@@
{@@ ----------------------------------------------------------------------------
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;
begin
Result := Round(AValue / 72 * AScreenPixelsPerInch);
end;
{@@
{@@ ----------------------------------------------------------------------------
Converts a HTML length string to points. The units are assumed to be the last
two digits of the string, such as '1.25in'
@ -1416,7 +1431,7 @@ end;
'px' (pixels), 'pt' (points), 'in' (inches), 'mm' (millimeters),
'cm' (centimeters).
@return Extracted length in points
}
-------------------------------------------------------------------------------}
function HTMLLengthStrToPts(AValue: String): Double;
var
units: String;
@ -1449,13 +1464,13 @@ begin
raise Exception.Create('Unknown length units');
end;
{@@
{@@ ----------------------------------------------------------------------------
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;
begin
if AValue = '' then
@ -1495,7 +1510,7 @@ begin
end;
end;
{@@
{@@ ----------------------------------------------------------------------------
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
@ -1503,7 +1518,7 @@ end;
@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)
}
-------------------------------------------------------------------------------}
function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String;
type
TRGB = record r,g,b,a: Byte end;
@ -1517,13 +1532,13 @@ begin
Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]);
end;
{@@
{@@ ----------------------------------------------------------------------------
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;
var
Idx:Integer;