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; GsSpreadFormats[len].Format := AFormat;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Returns the name of the given spreadsheet 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',
'CSV, 'WikiTable Pipes', or 'WikiTable WikiMedia" 'CSV, 'WikiTable Pipes', or 'WikiTable WikiMedia"
} -------------------------------------------------------------------------------}
function GetFileFormatName(AFormat: TsSpreadsheetFormat): string; function GetFileFormatName(AFormat: TsSpreadsheetFormat): string;
begin begin
case AFormat of case AFormat of
@ -1301,7 +1301,7 @@ begin
end; end;
{@@ {@@ ----------------------------------------------------------------------------
If a palette is coded as big-endian (e.g. by copying the rgb values from 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 the OpenOffice doc) the palette values can be converted by means of this
procedure to little-endian which is required internally by TsWorkbook. 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, @param APalette Pointer to the palette to be converted. After conversion,
its color values are replaced. its color values are replaced.
@param APaletteSize Number of colors contained in the palette @param APaletteSize Number of colors contained in the palette
} -------------------------------------------------------------------------------}
procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer); procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
var var
i: Integer; i: Integer;
@ -1320,12 +1320,12 @@ begin
{$POP} {$POP}
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Copies the format of a cell to another one. Copies the format of a cell to another one.
@param AFromCell cell from which the format is to be copied @param AFromCell cell from which the format is to be copied
@param AToCell cell to which the format is to be copied @param AToCell cell to which the format is to be copied
} -------------------------------------------------------------------------------}
procedure CopyCellFormat(AFromCell, AToCell: PCell); procedure CopyCellFormat(AFromCell, AToCell: PCell);
begin begin
Assert(AFromCell <> nil); Assert(AFromCell <> nil);
@ -1343,8 +1343,9 @@ begin
AToCell^.NumberFormatStr := AFromCell^.NumberFormatStr; AToCell^.NumberFormatStr := AFromCell^.NumberFormatStr;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Checks whether two cells have same border attributes } Checks whether two cells have same border attributes
-------------------------------------------------------------------------------}
function SameCellBorders(ACell1, ACell2: PCell): Boolean; function SameCellBorders(ACell1, ACell2: PCell): Boolean;
function NoBorder(ACell: PCell): Boolean; function NoBorder(ACell: PCell): Boolean;
@ -1379,10 +1380,10 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Initalizes a new cell Initalizes a new cell
@return New cell record @return New cell record
} -------------------------------------------------------------------------------}
procedure InitCell(out ACell: TCell); procedure InitCell(out ACell: TCell);
begin begin
ACell.FormulaValue := ''; ACell.FormulaValue := '';
@ -1391,14 +1392,14 @@ begin
FillChar(ACell, SizeOf(ACell), 0); FillChar(ACell, SizeOf(ACell), 0);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Initalizes a new cell and presets the row and column fields of the cell record Initalizes a new cell and presets the row and column fields of the cell record
to the parameters passesd to the procedure. to the parameters passesd to the procedure.
@param ARow Row index of the new cell @param ARow Row index of the new cell
@param ACol Column 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. @return New cell record with row and column fields preset to passed parameters.
} -------------------------------------------------------------------------------}
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell);
begin begin
InitCell(ACell); InitCell(ACell);
@ -1406,9 +1407,9 @@ begin
ACell.Col := ACol; ACell.Col := ACol;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Returns TRUE if the cell contains a formula (direct or shared, does not matter). Returns TRUE if the cell contains a formula (direct or shared, does not matter).
} -------------------------------------------------------------------------------}
function HasFormula(ACell: PCell): Boolean; function HasFormula(ACell: PCell): Boolean;
begin begin
Result := Assigned(ACell) and ( Result := Assigned(ACell) and (
@ -4187,7 +4188,7 @@ begin
Result := WriteFont(ACell, fnt.FontName, fnt.Size, fnt.Style, AFontColor); Result := WriteFont(ACell, fnt.FontName, fnt.Size, fnt.Style, AFontColor);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Replaces the font used in formatting of a cell considering only the font face 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 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 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 ACol The column of the cell
@param AFontName Name of the new font to be used @param AFontName Name of the new font to be used
@return Index of the font in the workbook's font list. @return Index of the font in the workbook's font list.
} -------------------------------------------------------------------------------}
function TsWorksheet.WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer; function TsWorksheet.WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer;
begin begin
result := WriteFontName(GetCell(ARow, ACol), AFontName); result := WriteFontName(GetCell(ARow, ACol), AFontName);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Replaces the font used in formatting of a cell considering only the font face 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 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 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 ACell Pointer to the cell
@param AFontName Name of the new font to be used @param AFontName Name of the new font to be used
@return Index of the font in the workbook's font list. @return Index of the font in the workbook's font list.
} -------------------------------------------------------------------------------}
function TsWorksheet.WriteFontName(ACell: PCell; AFontName: String): Integer; function TsWorksheet.WriteFontName(ACell: PCell; AFontName: String): Integer;
var var
fnt: TsFont; fnt: TsFont;
@ -4225,7 +4226,7 @@ begin
result := WriteFont(ACell, AFontName, fnt.Size, fnt.Style, fnt.Color); result := WriteFont(ACell, AFontName, fnt.Size, fnt.Style, fnt.Color);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Replaces the font size in formatting of a cell. Looks in the workbook's 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 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. 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 ACol The column of the cell
@param ASize Size of the font to be used (in points). @param ASize Size of the font to be used (in points).
@return Index of the font in the workbook's font list. @return Index of the font in the workbook's font list.
} -------------------------------------------------------------------------------}
function TsWorksheet.WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer; function TsWorksheet.WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer;
begin begin
Result := WriteFontSize(GetCell(ARow, ACol), ASize); Result := WriteFontSize(GetCell(ARow, ACol), ASize);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Replaces the font size in formatting of a cell. Looks in the workbook's 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 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. is created. Returns the index of this font in the font list.
@ -4248,7 +4249,7 @@ end;
@param ACell Pointer to the cell @param ACell Pointer to the cell
@param ASize Size of the font to be used (in points). @param ASize Size of the font to be used (in points).
@return Index of the font in the workbook's font list. @return Index of the font in the workbook's font list.
} -------------------------------------------------------------------------------}
function TsWorksheet.WriteFontSize(ACell: PCell; ASize: Single): Integer; function TsWorksheet.WriteFontSize(ACell: PCell; ASize: Single): Integer;
var var
fnt: TsFont; fnt: TsFont;
@ -4261,7 +4262,7 @@ begin
Result := WriteFont(ACell, fnt.FontName, ASize, fnt.Style, fnt.Color); Result := WriteFont(ACell, fnt.FontName, ASize, fnt.Style, fnt.Color);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Replaces the font style (bold, italic, etc) in formatting of a cell. 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. Looks in the workbook's font list if this modified font has already been used.
If not a new font entry is created. If not a new font entry is created.
@ -4273,14 +4274,14 @@ end;
@return Index of the font in the workbook's font list. @return Index of the font in the workbook's font list.
@see TsFontStyle @see TsFontStyle
} -------------------------------------------------------------------------------}
function TsWorksheet.WriteFontStyle(ARow, ACol: Cardinal; function TsWorksheet.WriteFontStyle(ARow, ACol: Cardinal;
AStyle: TsFontStyles): Integer; AStyle: TsFontStyles): Integer;
begin begin
Result := WriteFontStyle(GetCell(ARow, ACol), AStyle); Result := WriteFontStyle(GetCell(ARow, ACol), AStyle);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Replaces the font style (bold, italic, etc) in formatting of a cell. 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. Looks in the workbook's font list if this modified font has already been used.
If not a new font entry is created. If not a new font entry is created.
@ -4291,7 +4292,7 @@ end;
@return Index of the font in the workbook's font list. @return Index of the font in the workbook's font list.
@see TsFontStyle @see TsFontStyle
} -------------------------------------------------------------------------------}
function TsWorksheet.WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer; function TsWorksheet.WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer;
var var
fnt: TsFont; fnt: TsFont;
@ -4305,7 +4306,7 @@ begin
Result := WriteFont(ACell, fnt.FontName, fnt.Size, AStyle, fnt.Color); Result := WriteFont(ACell, fnt.FontName, fnt.Size, AStyle, fnt.Color);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Adds text rotation to the formatting of a cell Adds text rotation to the formatting of a cell
@param ARow The row of the cell @param ARow The row of the cell
@ -4314,7 +4315,7 @@ end;
@return Pointer to cell @return Pointer to cell
@see TsTextRotation @see TsTextRotation
} -------------------------------------------------------------------------------}
function TsWorksheet.WriteTextRotation(ARow, ACol: Cardinal; function TsWorksheet.WriteTextRotation(ARow, ACol: Cardinal;
ARotation: TsTextRotation): PCell; ARotation: TsTextRotation): PCell;
begin begin
@ -4322,14 +4323,14 @@ begin
WriteTextRotation(Result, ARotation); WriteTextRotation(Result, ARotation);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Adds text rotation to the formatting of a cell Adds text rotation to the formatting of a cell
@param ACell Pointer to the cell @param ACell Pointer to the cell
@param ARotation How to rotate the text @param ARotation How to rotate the text
@see TsTextRotation @see TsTextRotation
} -------------------------------------------------------------------------------}
procedure TsWorksheet.WriteTextRotation(ACell: PCell; ARotation: TsTextRotation); procedure TsWorksheet.WriteTextRotation(ACell: PCell; ARotation: TsTextRotation);
begin begin
if ACell = nil then if ACell = nil then
@ -4339,7 +4340,7 @@ begin
ChangedFont(ACell^.Row, ACell^.Col); ChangedFont(ACell^.Row, ACell^.Col);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Directly modifies the used formatting fields of a cell. Directly modifies the used formatting fields of a cell.
Only formatting corresponding to items included in this set is executed. Only formatting corresponding to items included in this set is executed.
@ -4349,7 +4350,7 @@ end;
@see TsUsedFormattingFields @see TsUsedFormattingFields
@see TCell @see TCell
} -------------------------------------------------------------------------------}
procedure TsWorksheet.WriteUsedFormatting(ARow, ACol: Cardinal; procedure TsWorksheet.WriteUsedFormatting(ARow, ACol: Cardinal;
AUsedFormatting: TsUsedFormattingFields); AUsedFormatting: TsUsedFormattingFields);
var var
@ -4634,8 +4635,10 @@ end;
@param ARow Row index of the cell considered @param ARow Row index of the cell considered
@param ACol Column index of the cell considered @param ACol Column index of the cell considered
@param AValue Parameter for horizontal text alignment (haDefault, vaLeft, haCenter, haRight) @param AValue Parameter for horizontal text alignment
By default, texts are left-aligned, numbers and dates are right-aligned. (haDefault, vaLeft, haCenter, haRight)
By default, texts are left-aligned, numbers and dates are
right-aligned.
@return Pointer to cell @return Pointer to cell
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment): PCell; function TsWorksheet.WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment): PCell;
@ -4648,8 +4651,10 @@ end;
Defines the horizontal alignment of text in a cell. Defines the horizontal alignment of text in a cell.
@param ACell Pointer to the cell considered @param ACell Pointer to the cell considered
@param AValue Parameter for horizontal text alignment (haDefault, vaLeft, haCenter, haRight) @param AValue Parameter for horizontal text alignment
By default, texts are left-aligned, numbers and dates are right-aligned. (haDefault, vaLeft, haCenter, haRight)
By default, texts are left-aligned, numbers and dates are
right-aligned.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.WriteHorAlignment(ACell: PCell; AValue: TsHorAlignment); procedure TsWorksheet.WriteHorAlignment(ACell: PCell; AValue: TsHorAlignment);
begin begin
@ -4665,11 +4670,13 @@ end;
@param ARow Row index of the cell considered @param ARow Row index of the cell considered
@param ACol Column 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. By default, texts are bottom-aligned.
@return Pointer to cell @return Pointer to cell
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment): PCell; function TsWorksheet.WriteVertAlignment(ARow, ACol: Cardinal;
AValue: TsVertAlignment): PCell;
begin begin
Result := GetCell(ARow, ACol); Result := GetCell(ARow, ACol);
WriteVertAlignment(Result, AValue); WriteVertAlignment(Result, AValue);
@ -4679,7 +4686,8 @@ end;
Defines the vertical alignment of text in a cell. Defines the vertical alignment of text in a cell.
@param ACell Poiner to the cell considered @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. By default, texts are bottom-aligned.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.WriteVertAlignment(ACell: PCell; AValue: TsVertAlignment); procedure TsWorksheet.WriteVertAlignment(ACell: PCell; AValue: TsVertAlignment);
@ -4727,13 +4735,13 @@ begin
Result := FWorkbook.FormatSettings; Result := FWorkbook.FormatSettings;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Calculates the optimum height of a given row. Depends on the font size Calculates the optimum height of a given row. Depends on the font size
of the individual cells in the row. of the individual cells in the row.
@param ARow Index of the row to be considered @param ARow Index of the row to be considered
@return Row height in line count of the default font. @return Row height in line count of the default font.
} -------------------------------------------------------------------------------}
function TsWorksheet.CalcAutoRowHeight(ARow: Cardinal): Single; function TsWorksheet.CalcAutoRowHeight(ARow: Cardinal): Single;
var var
cell: PCell; cell: PCell;
@ -4749,12 +4757,14 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Checks if a row record exists for the given row index and returns a pointer Checks if a row record exists for the given row index and returns a pointer
to the row record, or nil if not found to the row record, or nil if not found
@param ARow Index of the row looked for @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; function TsWorksheet.FindRow(ARow: Cardinal): PRow;
var var
LElement: TRow; LElement: TRow;
@ -4767,12 +4777,14 @@ begin
result := PRow(AVLNode.Data); result := PRow(AVLNode.Data);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Checks if a column record exists for the given column index and returns a pointer Checks if a column record exists for the given column index and returns a
to the TCol record, or nil if not found pointer to the TCol record, or nil if not found
@param ACol Index of the column looked for @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; function TsWorksheet.FindCol(ACol: Cardinal): PCol;
var var
LElement: TCol; LElement: TCol;
@ -4785,12 +4797,14 @@ begin
result := PCol(AVLNode.Data); result := PCol(AVLNode.Data);
end; 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 @param ARow Index of the row looked for
@return Pointer to the row record with this row index. It can safely be @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; function TsWorksheet.GetRow(ARow: Cardinal): PRow;
begin begin
Result := FindRow(ARow); Result := FindRow(ARow);
@ -4806,13 +4820,14 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Checks if a column record exists for the given column index and creates it Checks if a column record exists for the given column index and creates it
if not found. if not found.
@param ACol Index of the column looked for @param ACol Index of the column looked for
@return Pointer to the TCol record with this column index. It can safely be @return Pointer to the TCol record with this column index. It can
assumed that this column record exists. } safely be assumed that this column record exists.
-------------------------------------------------------------------------------}
function TsWorksheet.GetCol(ACol: Cardinal): PCol; function TsWorksheet.GetCol(ACol: Cardinal): PCol;
begin begin
Result := FindCol(ACol); Result := FindCol(ACol);
@ -4830,12 +4845,13 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Counts how many cells exist in the given column. Blank cells do contribute Counts how many cells exist in the given column. Blank cells do contribute
to the sum, as well as formatted cells. to the sum, as well as formatted cells.
@param ACol Index of the column considered @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; function TsWorksheet.GetCellCountInCol(ACol: Cardinal): Cardinal;
var var
cell: PCell; cell: PCell;
@ -4854,13 +4870,13 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Counts how many cells exist in the given row. Blank cells do contribute Counts how many cells exist in the given row. Blank cells do contribute
to the sum, as well as formatted cell.s to the sum, as well as formatted cell.s
@param ARow Index of the row considered @param ARow Index of the row considered
@return Count of cells with value or format in this row @return Count of cells with value or format in this row
} -------------------------------------------------------------------------------}
function TsWorksheet.GetCellCountInRow(ARow: Cardinal): Cardinal; function TsWorksheet.GetCellCountInRow(ARow: Cardinal): Cardinal;
var var
cell: PCell; cell: PCell;
@ -4879,13 +4895,13 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Returns the width of the given column. If there is no column record then Returns the width of the given column. If there is no column record then
the default column width is returned. the default column width is returned.
@param ACol Index of the column considered @param ACol Index of the column considered
@return Width of the column (in count of "0" characters of the default font) @return Width of the column (in count of "0" characters of the default font)
} -------------------------------------------------------------------------------}
function TsWorksheet.GetColWidth(ACol: Cardinal): Single; function TsWorksheet.GetColWidth(ACol: Cardinal): Single;
var var
col: PCol; col: PCol;
@ -4897,13 +4913,13 @@ begin
Result := FDefaultColWidth; Result := FDefaultColWidth;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Returns the height of the given row. If there is no row record then the Returns the height of the given row. If there is no row record then the
default row height is returned default row height is returned
@param ARow Index of the row considered @param ARow Index of the row considered
@return Height of the row (in line count of the default font). @return Height of the row (in line count of the default font).
} -------------------------------------------------------------------------------}
function TsWorksheet.GetRowHeight(ARow: Cardinal): Single; function TsWorksheet.GetRowHeight(ARow: Cardinal): Single;
var var
row: PRow; row: PRow;
@ -4916,13 +4932,13 @@ begin
Result := FDefaultRowHeight; Result := FDefaultRowHeight;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Deletes the column at the index specified. Cells with greader column indexes are Deletes the column at the index specified. Cells with greader column indexes
moved one column to the left. Merged cell blocks and cell references in formulas are moved one column to the left. Merged cell blocks and cell references in
are considered as well. formulas are considered as well.
@param ACol Index of the column to be deleted @param ACol Index of the column to be deleted
} -------------------------------------------------------------------------------}
procedure TsWorksheet.DeleteCol(ACol: Cardinal); procedure TsWorksheet.DeleteCol(ACol: Cardinal);
var var
cellnode: TAVLTreeNode; cellnode: TAVLTreeNode;
@ -5004,13 +5020,13 @@ begin
ChangedCell(0, ACol); ChangedCell(0, ACol);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Deletes the row at the index specified. Cells with greader row indexes are 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 moved one row up. Merged cell blocks and cell references in formulas
are considered as well. are considered as well.
@param ARow Index of the row to be deleted @param ARow Index of the row to be deleted
} -------------------------------------------------------------------------------}
procedure TsWorksheet.DeleteRow(ARow: Cardinal); procedure TsWorksheet.DeleteRow(ARow: Cardinal);
var var
cellnode: TAVLTreeNode; cellnode: TAVLTreeNode;
@ -5090,13 +5106,13 @@ begin
ChangedCell(ARow, 0); ChangedCell(ARow, 0);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Inserts a column BEFORE the index specified. Cells with greater column indexes are Inserts a column BEFORE the index specified. Cells with greater column indexes
moved one column to the right. Merged cell blocks and cell references in formulas are moved one column to the right. Merged cell blocks and cell references in
are considered as well. formulas are considered as well.
@param ACol Index of the column before which a new column is inserted. @param ACol Index of the column before which a new column is inserted.
} -------------------------------------------------------------------------------}
procedure TsWorksheet.InsertCol(ACol: Cardinal); procedure TsWorksheet.InsertCol(ACol: Cardinal);
var var
cellnode: TAVLTreeNode; cellnode: TAVLTreeNode;
@ -5204,13 +5220,13 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Inserts a row BEFORE the row specified. Cells with greater row indexes are 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 moved one row down. Merged cell blocks and cell references in formulas are
considered as well. considered as well.
@param ARow Index of the row before which a new row is inserted. @param ARow Index of the row before which a new row is inserted.
} -------------------------------------------------------------------------------}
procedure TsWorksheet.InsertRow(ARow: Cardinal); procedure TsWorksheet.InsertRow(ARow: Cardinal);
var var
row: PRow; row: PRow;
@ -5313,10 +5329,10 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Removes all row records from the worksheet and frees the occupied memory. Removes all row records from the worksheet and frees the occupied memory.
Note: Cells are retained. Note: Cells are retained.
} -------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveAllRows; procedure TsWorksheet.RemoveAllRows;
var var
Node: Pointer; Node: Pointer;
@ -5346,8 +5362,9 @@ begin
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Removes a specified column record from the worksheet and frees the occupied memory. Removes a specified column record from the worksheet and frees the occupied
This resets the its column width to default. memory. This resets its column width to default.
Note: Cells in that column are retained. Note: Cells in that column are retained.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveCol(ACol: Cardinal); procedure TsWorksheet.RemoveCol(ACol: Cardinal);
@ -5385,7 +5402,8 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes a row record for the row at a given index to the spreadsheet. 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. 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 Constructor of the workbook class. Among others, it initializes the built-in
fonts, defines the default font, and sets up the FormatSettings for localization fonts, defines the default font, and sets up the FormatSettings for
of some number formats. localization of some number formats.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
constructor TsWorkbook.Create; constructor TsWorkbook.Create;
begin begin
@ -5846,7 +5864,8 @@ begin
valid := GetFormatFromFileName(AFileName, SheetType); valid := GetFormatFromFileName(AFileName, SheetType);
if valid then WriteToFile(AFileName, SheetType, AOverwriteExisting) if valid then WriteToFile(AFileName, SheetType, AOverwriteExisting)
else raise Exception.Create(Format( 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; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -6512,27 +6531,6 @@ begin
end end
else else
Result := $000000; // "black" as default 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; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -6597,8 +6595,8 @@ end;
@param APaletteCount Count of numbers in the source palette @param APaletteCount Count of numbers in the source palette
@param ABigEnding If true, indicates that the source palette is in @param ABigEnding If true, indicates that the source palette is in
big-endian notation. The methods inverts the rgb big-endian notation. The methods inverts the rgb
components to little-endian which is used by fpspreadsheet components to little-endian which is used by
internally. fpspreadsheet internally.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorkbook.UsePalette(APalette: PsPalette; APaletteCount: Word; procedure TsWorkbook.UsePalette(APalette: PsPalette; APaletteCount: Word;
ABigEndian: Boolean); ABigEndian: Boolean);
@ -6998,7 +6996,9 @@ end;
the format list (or -1, if not found) the format list (or -1, if not found)
To be used by OpenDocument file format. 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 @return Index of the format item in the list, or -1 if not found
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsCustomNumFormatList.FindByName(AFormatName: String): integer; 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 } { Simplified creation of RPN formulas }
{******************************************************************************} {******************************************************************************}
{@@ {@@ ----------------------------------------------------------------------------
Creates a pointer to a new RPN item. This represents an element in the array Creates a pointer to a new RPN item. This represents an element in the array
of token of an RPN formula. of token of an RPN formula.
@return Pointer to the RPN item @return Pointer to the RPN item
} -------------------------------------------------------------------------------}
function NewRPNItem: PRPNItem; function NewRPNItem: PRPNItem;
begin begin
New(Result); New(Result);
@ -71,21 +71,21 @@ begin
Result^.FE.StringValue := ''; Result^.FE.StringValue := '';
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Destroys an RPN item Destroys an RPN item
} -------------------------------------------------------------------------------}
procedure DisposeRPNItem(AItem: PRPNItem); procedure DisposeRPNItem(AItem: PRPNItem);
begin begin
if AItem <> nil then if AItem <> nil then
Dispose(AItem); Dispose(AItem);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates a boolean value entry in the RPN array. Creates a boolean value entry in the RPN array.
@param AValue Boolean value to be stored in the RPN item @param AValue Boolean value to be stored in the RPN item
@next ANext Pointer to the next RPN item in the list @next ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNBool(AValue: Boolean; ANext: PRPNItem): PRPNItem; function RPNBool(AValue: Boolean; ANext: PRPNItem): PRPNItem;
begin begin
Result := NewRPNItem; Result := NewRPNItem;
@ -94,13 +94,13 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a cell value, specifed by its 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. address, e.g. 'A1'. Takes care of absolute and relative cell addresses.
@param ACellAddress Adress of the cell given in Excel A1 notation @param ACellAddress Adress of the cell given in Excel A1 notation
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNCellValue(ACellAddress: String; ANext: PRPNItem): PRPNItem; function RPNCellValue(ACellAddress: String; ANext: PRPNItem): PRPNItem;
var var
r,c: Cardinal; r,c: Cardinal;
@ -111,7 +111,7 @@ begin
Result := RPNCellValue(r,c, flags, ANext); Result := RPNCellValue(r,c, flags, ANext);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a cell value, specifed by its 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. 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 ACol Column index of the cell
@param AFlags Flags specifying absolute or relative cell addresses @param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNCellValue(ARow, ACol: Integer; AFlags: TsRelFlags; function RPNCellValue(ARow, ACol: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem; ANext: PRPNItem): PRPNItem;
begin begin
@ -131,7 +131,7 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a cell reference, specifed by its 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. address, e.g. 'A1'. Takes care of absolute and relative cell addresses.
"Cell reference" means that all properties of the cell can be handled. "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 ACellAddress Adress of the cell given in Excel A1 notation
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNCellRef(ACellAddress: String; ANext: PRPNItem): PRPNItem; function RPNCellRef(ACellAddress: String; ANext: PRPNItem): PRPNItem;
var var
r,c: Cardinal; r,c: Cardinal;
@ -151,7 +151,7 @@ begin
Result := RPNCellRef(r,c, flags, ANext); Result := RPNCellRef(r,c, flags, ANext);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a cell reference, specifed by its 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. row and column index and flags containing information on relative addresses.
"Cell reference" means that all properties of the cell can be handled. "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 ACol Column index of the cell
@param AFlags Flags specifying absolute or relative cell addresses @param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNCellRef(ARow, ACol: Integer; AFlags: TsRelFlags; function RPNCellRef(ARow, ACol: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem; ANext: PRPNItem): PRPNItem;
begin begin
@ -174,14 +174,15 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a range of cells, specified by an 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 Excel-style address, e.g. A1:G5. As in Excel, use a $ sign to indicate
absolute addresses. 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 @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNCellRange(ACellRangeAddress: String; ANext: PRPNItem): PRPNItem; function RPNCellRange(ACellRangeAddress: String; ANext: PRPNItem): PRPNItem;
var var
r1,c1, r2,c2: Cardinal; r1,c1, r2,c2: Cardinal;
@ -192,7 +193,7 @@ begin
Result := RPNCellRange(r1,c1, r2,c2, flags, ANext); Result := RPNCellRange(r1,c1, r2,c2, flags, ANext);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a range of cells, specified by the 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. row/column indexes of the top/left and bottom/right corners of the block.
The flags indicate relative indexes. The flags indicate relative indexes.
@ -203,7 +204,7 @@ end;
@param ACol2 Column index of the bottom/right cell @param ACol2 Column index of the bottom/right cell
@param AFlags Flags specifying absolute or relative cell addresses @param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNCellRange(ARow, ACol, ARow2, ACol2: Integer; AFlags: TsRelFlags; function RPNCellRange(ARow, ACol, ARow2, ACol2: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem; ANext: PRPNItem): PRPNItem;
begin begin
@ -217,7 +218,7 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a relative cell reference as used in 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 shared formulas. The given parameters indicate the relativ offset between
the current cell coordinates and a reference rell. 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 AColOffset Offset between current column and the column of a reference cell
@param AFlags Flags specifying absolute or relative cell addresses @param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNCellOffset(ARowOffset, AColOffset: Integer; AFlags: TsRelFlags; function RPNCellOffset(ARowOffset, AColOffset: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem; ANext: PRPNItem): PRPNItem;
begin begin
@ -238,13 +239,13 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array with an error value. Creates an entry in the RPN array with an error value.
@param AErrCode Error code to be inserted (see TsErrorValue @param AErrCode Error code to be inserted (see TsErrorValue
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
@see TsErrorValue @see TsErrorValue
} -------------------------------------------------------------------------------}
function RPNErr(AErrCode: TsErrorValue; ANext: PRPNItem): PRPNItem; function RPNErr(AErrCode: TsErrorValue; ANext: PRPNItem): PRPNItem;
begin begin
Result := NewRPNItem; Result := NewRPNItem;
@ -253,12 +254,12 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a 2-byte unsigned integer Creates an entry in the RPN array for a 2-byte unsigned integer
@param AValue Integer value to be inserted into the formula @param AValue Integer value to be inserted into the formula
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNInteger(AValue: Word; ANext: PRPNItem): PRPNItem; function RPNInteger(AValue: Word; ANext: PRPNItem): PRPNItem;
begin begin
Result := NewRPNItem; Result := NewRPNItem;
@ -267,12 +268,12 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a missing argument in of function call. 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 Use this in a formula to indicate a missing argument
@param ANext Pointer to the next RPN item in the list. @param ANext Pointer to the next RPN item in the list.
} -------------------------------------------------------------------------------}
function RPNMissingArg(ANext: PRPNItem): PRPNItem; function RPNMissingArg(ANext: PRPNItem): PRPNItem;
begin begin
Result := NewRPNItem; Result := NewRPNItem;
@ -280,12 +281,12 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a floating point number. Creates an entry in the RPN array for a floating point number.
@param AValue Number value to be inserted into the formula @param AValue Number value to be inserted into the formula
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNNumber(AValue: Double; ANext: PRPNItem): PRPNItem; function RPNNumber(AValue: Double; ANext: PRPNItem): PRPNItem;
begin begin
Result := NewRPNItem; Result := NewRPNItem;
@ -294,12 +295,12 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array which puts the current operator in parenthesis. Creates an entry in the RPN array which puts the current operator in parenthesis.
For display purposes only, does not affect calculation. For display purposes only, does not affect calculation.
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNParenthesis(ANext: PRPNItem): PRPNItem; function RPNParenthesis(ANext: PRPNItem): PRPNItem;
begin begin
Result := NewRPNItem; Result := NewRPNItem;
@ -307,12 +308,12 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for a string. Creates an entry in the RPN array for a string.
@param AValue String to be inserted into the formula @param AValue String to be inserted into the formula
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
} -------------------------------------------------------------------------------}
function RPNString(AValue: String; ANext: PRPNItem): PRPNItem; function RPNString(AValue: String; ANext: PRPNItem): PRPNItem;
begin begin
Result := NewRPNItem; Result := NewRPNItem;
@ -321,92 +322,57 @@ begin
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for an Excel function or operation Creates an entry in the RPN array for an operation specified by its TokenID
specified by its TokenID (--> TFEKind). Note that array elements for all (--> TFEKind). Note that array elements for all needed parameters must have
needed parameters must have been created before. 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 TFEKind 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 TFEKind @see TFEKind
} -------------------------------------------------------------------------------}
function RPNFunc(AToken: TFEKind; ANext: PRPNItem): PRPNItem; function RPNFunc(AToken: TFEKind; ANext: PRPNItem): PRPNItem;
begin begin
{
if FEProps[AToken].MinParams <> FEProps[AToken].MaxParams then
raise Exception.CreateFmt(lpSpecifyNumberOfParams, [FEProps[AToken].Symbol]);
}
Result := NewRPNItem; Result := NewRPNItem;
Result^.FE.ElementKind := AToken; Result^.FE.ElementKind := AToken;
Result^.Fe.FuncName := ''; Result^.Fe.FuncName := '';
Result^.Next := ANext; Result^.Next := ANext;
end; end;
{@@ ----------------------------------------------------------------------------
{@@
Creates an entry in the RPN array for an Excel function or operation Creates an entry in the RPN array for an Excel function or operation
specified by its TokenID (--> TFEKind). Note that array elements for all specified by its name. Note that array elements for all needed parameters
needed parameters must have been created before. must have been created before.
@param AToken Formula element indicating the function to be executed, @param AFuncName Name of the spreadsheet function (as used by Excel)
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 TFEKind
}
function RPNFunc(AFuncName: String; ANext: PRPNItem): PRPNItem; function RPNFunc(AFuncName: String; ANext: PRPNItem): PRPNItem;
begin begin
{ Result := RPNFunc(AFuncName, 255, ANext);
if FEProps[AToken].MinParams <> FEProps[AToken].MaxParams then
raise Exception.CreateFmt(lpSpecifyNumberOfParams, [FEProps[AToken].Symbol]);
}
Result := RPNFunc(AFuncName, 255, ANext); //FEProps[AToken].MinParams, ANext);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates an entry in the RPN array for an Excel function or operation Creates an entry in the RPN array for an Excel spreadsheet function
specified by its TokenID (--> TFEKind). Specify the number of parameters used. specified by its name. Specify the number of parameters used.
They must have been created before. They must have been created before.
@param AToken Formula element indicating the function to be executed, @param AFuncName Name of the spreadsheet function (as used by Excel).
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. If -1 then the
fixed number of arguments known from the function definiton
is used.
@param ANext Pointer to the next RPN item in the list @param ANext Pointer to the next RPN item in the list
-------------------------------------------------------------------------------}
@see TFEKind
}
function RPNFunc(AFuncName: String; ANumParams: Byte; ANext: PRPNItem): PRPNItem; function RPNFunc(AFuncName: String; ANumParams: Byte; ANext: PRPNItem): PRPNItem;
begin 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 := NewRPNItem;
Result^.FE.ElementKind := fekFunc; Result^.FE.ElementKind := fekFunc;
Result^.Fe.FuncName := AFuncName; Result^.Fe.FuncName := AFuncName;
Result^.FE.ParamsNum := ANumParams; Result^.FE.ParamsNum := ANumParams;
Result^.Next := ANext; Result^.Next := ANext;
end; 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. Creates an RPN formula by a single call using nested RPN items.
For each formula element, use one of the RPNxxxx functions implemented here. For each formula element, use one of the RPNxxxx functions implemented here.
@ -431,7 +397,7 @@ end;
RPNFunc(fekAdd, RPNFunc(fekAdd,
nil)))); nil))));
</pre> </pre>
} -------------------------------------------------------------------------------}
function CreateRPNFormula(AItem: PRPNItem; AReverse: Boolean = false): TsRPNFormula; function CreateRPNFormula(AItem: PRPNItem; AReverse: Boolean = false): TsRPNFormula;
var var
item: PRPNItem; item: PRPNItem;
@ -461,13 +427,13 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Destroys the RPN formula starting with the given RPN item. Destroys the RPN formula starting with the given RPN item.
@param AItem Pointer to the first RPN items representing the formula. @param AItem Pointer to the first RPN items representing the formula.
Each item contains a pointer to the next item in the list. Each item contains a pointer to the next item in the list.
The list is terminated by nil. The list is terminated by nil.
} -------------------------------------------------------------------------------}
procedure DestroyRPNFormula(AItem: PRPNItem); procedure DestroyRPNFormula(AItem: PRPNItem);
var var
nextitem: PRPNItem; 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. big-endian isn't support, because Delphi doesn't support it.
} }
{@@ {@@ ----------------------------------------------------------------------------
WordLEToLE converts a word value from big-endian to little-endian byte order. WordLEToLE converts a word value from big-endian to little-endian byte order.
@param AValue Big-endian word value @param AValue Big-endian word value
@return Little-endian word value @return Little-endian word value
} -------------------------------------------------------------------------------}
function WordToLE(AValue: Word): Word; function WordToLE(AValue: Word): Word;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -194,12 +194,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@ {@@ ----------------------------------------------------------------------------
DWordLEToLE converts a DWord value from big-endian to little-endian byte-order. DWordLEToLE converts a DWord value from big-endian to little-endian byte-order.
@param AValue Big-endian DWord value @param AValue Big-endian DWord value
@return Little-endian DWord value @return Little-endian DWord value
} -------------------------------------------------------------------------------}
function DWordToLE(AValue: Cardinal): Cardinal; function DWordToLE(AValue: Cardinal): Cardinal;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -209,12 +209,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Converts an integer value from big-endian to little-endian byte-order. Converts an integer value from big-endian to little-endian byte-order.
@param AValue Big-endian integer value @param AValue Big-endian integer value
@return Little-endian integer value @return Little-endian integer value
} -------------------------------------------------------------------------------}
function IntegerToLE(AValue: Integer): Integer; function IntegerToLE(AValue: Integer): Integer;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -224,12 +224,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Converts a word value from little-endian to big-endian byte-order. Converts a word value from little-endian to big-endian byte-order.
@param AValue Little-endian word value @param AValue Little-endian word value
@return Big-endian word value @return Big-endian word value
} -------------------------------------------------------------------------------}
function WordLEtoN(AValue: Word): Word; function WordLEtoN(AValue: Word): Word;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -239,12 +239,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Converts a DWord value from little-endian to big-endian byte-order. Converts a DWord value from little-endian to big-endian byte-order.
@param AValue Little-endian DWord value @param AValue Little-endian DWord value
@return Big-endian DWord value @return Big-endian DWord value
} -------------------------------------------------------------------------------}
function DWordLEtoN(AValue: Cardinal): Cardinal; function DWordLEtoN(AValue: Cardinal): Cardinal;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -254,12 +254,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Converts a widestring from big-endian to little-endian byte-order. Converts a widestring from big-endian to little-endian byte-order.
@param AValue Big-endian widestring @param AValue Big-endian widestring
@return Little-endian widestring @return Little-endian widestring
} -------------------------------------------------------------------------------}
function WideStringToLE(const AValue: WideString): WideString; function WideStringToLE(const AValue: WideString): WideString;
{$IFNDEF FPC} {$IFNDEF FPC}
var var
@ -280,12 +280,12 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Converts a widestring from little-endian to big-endian byte-order. Converts a widestring from little-endian to big-endian byte-order.
@param AValue Little-endian widestring @param AValue Little-endian widestring
@return Big-endian widestring @return Big-endian widestring
} -------------------------------------------------------------------------------}
function WideStringLEToN(const AValue: WideString): WideString; function WideStringLEToN(const AValue: WideString): WideString;
{$IFNDEF FPC} {$IFNDEF FPC}
var var
@ -306,12 +306,14 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Converts the RGB part of a LongRGB logical structure to its physical representation. 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 In other words: RGBA (where A is 0 and omitted in the function call) => ABGR
Needed for conversion of palette colors. Needed for conversion of palette colors.
@param RGB DWord value containing RGBA bytes in big endian byte-order @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; function LongRGBToExcelPhysical(const RGB: DWord): DWord;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -327,7 +329,7 @@ begin
{$ENDIF} {$ENDIF}
end; 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 AStr Cell range string, such as A5:A10
@ -336,8 +338,9 @@ end;
@param ACount Number of cells included in the range (output) @param ACount Number of cells included in the range (output)
@param ADirection fpsVerticalSelection if the range is along a column, @param ADirection fpsVerticalSelection if the range is along a column,
fpsHorizontalSelection if the range is along a row fpsHorizontalSelection if the range is along a row
@return false if the string is not a valid cell range @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: Cardinal; out AFirstCellRow, AFirstCellCol, ACount: Cardinal;
out ADirection: TsSelectionDirection): Boolean; out ADirection: TsSelectionDirection): Boolean;
@ -389,7 +392,7 @@ begin
else Exit(False); else Exit(False);
end; 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.
@ -401,8 +404,9 @@ end;
@param AFlags a set containing an element for AFirstCellRow, AFirstCellCol, @param AFlags a set containing an element for AFirstCellRow, AFirstCellCol,
ALastCellRow, ALastCellCol if they represent relative ALastCellRow, ALastCellCol if they represent relative
cell addresses. cell addresses.
@return false if the string is not a valid cell range @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: Cardinal; out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal;
out AFlags: TsRelFlags): Boolean; out AFlags: TsRelFlags): Boolean;
@ -432,7 +436,7 @@ begin
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Parses strings like A5:C10 into a range selection information. Parses strings like A5:C10 into a range selection information.
Information on relative/absolute cells is ignored. 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 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 ALastCellCol Column index of the bottom/right cell of the range (output)
@return false if the string is not a valid cell range @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: Cardinal): Boolean; out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal): Boolean;
var var
flags: TsRelFlags; flags: TsRelFlags;
begin begin
Result := ParseCellRangeString(AStr, AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol, flags); Result := ParseCellRangeString(AStr,
AFirstCellRow, AFirstCellCol,
ALastCellRow, ALastCellCol,
flags
);
end; end;
{@@ ----------------------------------------------------------------------------
{@@
Parses a cell string, like 'A1' into zero-based column and row numbers 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. Note that there can be several letters to address for more than 26 columns.
'AFlags' indicates relative addresses. 'AFlags' indicates relative addresses.
@ -466,7 +473,7 @@ end;
@example "AMP$200" --> (rel) column 1029 (= 26*26*1 + 26*16 + 26 - 1) @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: Cardinal; function ParseCellString(const AStr: String; out ACellRow, ACellCol: Cardinal;
out AFlags: TsRelFlags): Boolean; out AFlags: TsRelFlags): Boolean;
@ -485,7 +492,9 @@ function ParseCellString(const AStr: String; out ACellRow, ACellCol: Cardinal;
while (i <= Length(AStr)) do begin while (i <= Length(AStr)) do begin
if (UpCase(AStr[i]) in LETTERS) then begin if (UpCase(AStr[i]) in LETTERS) then begin
ACellCol := Cardinal(ord(UpCase(AStr[i])) - ord('A')) + 1 + ACellCol * 26; 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; exit;
inc(i); inc(i);
end end
@ -543,7 +552,7 @@ begin
Result := Scan(1); Result := Scan(1);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Parses a cell string, like 'A1' into zero-based column and row numbers 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. 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 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 ACellCol Column index of the top/left cell of the range (output)
@return False if the string is not a valid cell range @return False if the string is not a valid cell range
} -------------------------------------------------------------------------------}
function ParseCellString(const AStr: string; function ParseCellString(const AStr: string;
out ACellRow, ACellCol: Cardinal): Boolean; out ACellRow, ACellCol: Cardinal): Boolean;
var var
@ -563,13 +572,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. Parses a cell row string to a zero-based row number.
@param AStr Cell row string, such as '1', 1-based! @param AStr Cell row string, such as '1', 1-based!
@param AResult Index of the row (zero-based!) (putput) @param AResult Index of the row (zero-based!) (putput)
@return False if the string is not a valid cell row string @return False if the string is not a valid cell row string
} -------------------------------------------------------------------------------}
function ParseCellRowString(const AStr: string; out AResult: Cardinal): Boolean; function ParseCellRowString(const AStr: string; out AResult: Cardinal): Boolean;
begin begin
try try
@ -580,14 +589,14 @@ begin
Result := True; Result := True;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Parses a cell column string, like 'A' or 'CZ', into a zero-based column number. 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. Note that there can be several letters to address more than 26 columns.
@param AStr Cell range string, such as A1 @param AStr Cell range string, such as A1
@param AResult Zero-based index of the column (output) @param AResult Zero-based index of the column (output)
@return False if the string is not a valid cell column string @return False if the string is not a valid cell column string
} -------------------------------------------------------------------------------}
function ParseCellColString(const AStr: string; out AResult: Cardinal): Boolean; function ParseCellColString(const AStr: string; out AResult: Cardinal): Boolean;
const const
INT_NUM_LETTERS = 26; INT_NUM_LETTERS = 26;
@ -617,15 +626,16 @@ 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 @param AColIndex Zero-based column index
@return Letter-based column name string. Can contain several letter in case of @return Letter-based column name string. Can contain several letter in case of
more than 26 columns 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
n: Integer; n: Integer;
c: byte; c: byte;
@ -642,7 +652,7 @@ 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 Calculates a cell address string from zero-based column and row indexes and
the relative address state flags. the relative address state flags.
@ -654,7 +664,7 @@ const
@return Excel type of cell address containing $ characters for absolute @return Excel type of cell address containing $ characters for absolute
address parts. address parts.
@example ARowIndex = 0, AColIndex = 0, AFlags = [rfRelRow] --> $A1 @example ARowIndex = 0, AColIndex = 0, AFlags = [rfRelRow] --> $A1
} -------------------------------------------------------------------------------}
function GetCellString(ARow, ACol: Cardinal; function GetCellString(ARow, ACol: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String; AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
begin begin
@ -664,7 +674,7 @@ begin
]); ]);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Calculates a cell range address string from zero-based column and row indexes Calculates a cell range address string from zero-based column and row indexes
and the relative address state flags. and the relative address state flags.
@ -679,7 +689,7 @@ end;
range range
@example ARow1 = 0, ACol1 = 0, ARow = 2, ACol = 1, AFlags = [rfRelRow, rfRelRow2] @example ARow1 = 0, ACol1 = 0, ARow = 2, ACol = 1, AFlags = [rfRelRow, rfRelRow2]
--> $A1:$B3 --> $A1:$B3
} -------------------------------------------------------------------------------}
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol, rfRelRow2, rfRelCol2]): String; AFlags: TsRelFlags = [rfRelRow, rfRelCol, rfRelRow2, rfRelCol2]): String;
begin begin
@ -691,13 +701,12 @@ begin
]); ]);
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 @param AErrorValue Error code as defined by TsErrorvalue
@return Text corresponding to the error code. @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
@ -715,7 +724,7 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Helper function to reduce typing: "if a conditions is true return the first Helper function to reduce typing: "if a conditions is true return the first
number format, otherwise return the second format" number format, otherwise return the second format"
@ -723,40 +732,45 @@ end;
@param AValue1 First built-in number format code @param AValue1 First built-in number format code
@param AValue2 Second built-in number format code @param AValue2 Second built-in number format code
@return AValue1 if ACondition is true, AValue2 otherwise. @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, Checks whether the given number format code is for currency,
i.e. requires currency symbol. i.e. requires currency symbol.
@param AFormat Built-in number format identifier to be checked @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; 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/time values. Checks whether the given number format code is for date/time values.
@param AFormat Built-in number format identifier to be checked @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; 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. Checks whether the given string with formatting codes is for date/time values.
@param AFormatStr String with formatting codes to be checked. @param AFormatStr String with formatting codes to be checked.
@return True if AFormatStr is a date/time format string (such as 'hh:nn'), @return True if AFormatStr is a date/time format string (such as 'hh:nn'),
false otherwise } false otherwise
-------------------------------------------------------------------------------}
function IsDateTimeFormat(AFormatStr: string): Boolean; function IsDateTimeFormat(AFormatStr: string): Boolean;
var var
parser: TsNumFormatParser; parser: TsNumFormatParser;
@ -769,22 +783,24 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Checks whether the given built-in number format code is for time values. Checks whether the given built-in number format code is for time values.
@param AFormat Built-in number format identifier to be checked @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; 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. Checks whether the given string with formatting codes is for time values.
@param AFormatStr String with formatting codes to be checked @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; function IsTimeFormat(AFormatStr: String): Boolean;
var var
parser: TsNumFormatParser; parser: TsNumFormatParser;
@ -797,7 +813,7 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Builds a date/time format string from the number format code. Builds a date/time format string from the number format code.
@param ANumberFormat built-in number format identifier @param ANumberFormat built-in number format identifier
@ -808,7 +824,7 @@ end;
are added to the first time code field. are added to the first time code field.
@return String of date/time formatting code constructed from the built-in @return String of date/time formatting code constructed from the built-in
format information. format information.
} -------------------------------------------------------------------------------}
function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat; function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; AFormatString: String = '') : string; const AFormatSettings: TFormatSettings; AFormatString: String = '') : string;
begin begin
@ -844,7 +860,7 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Builds a currency format string. The presentation of negative values (brackets, Builds a currency format string. The presentation of negative values (brackets,
or minus signs) is taken from the provided format settings. The format string or minus signs) is taken from the provided format settings. The format string
consists of three sections, separated by semicolons. consists of three sections, separated by semicolons.
@ -869,7 +885,7 @@ end;
If ? the CurrencyString of the FormatSettings is used. If ? the CurrencyString of the FormatSettings is used.
@return String of formatting codes, such as '"$"#,##0.00;("$"#,##0.00);"EUR"0.00' @return String of formatting codes, such as '"$"#,##0.00;("$"#,##0.00);"EUR"0.00'
} -------------------------------------------------------------------------------}
function BuildCurrencyFormatString(ADialect: TsNumFormatDialect; function BuildCurrencyFormatString(ADialect: TsNumFormatDialect;
ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings; ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings;
ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ACurrencySymbol: String): String; ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ACurrencySymbol: String): String;
@ -947,7 +963,7 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Builds a number format string from the number format code and the count of Builds a number format string from the number format code and the count of
decimal places. decimal places.
@ -958,7 +974,7 @@ end;
value of the FormatSettings is used. value of the FormatSettings is used.
@return String of formatting codes, such as '#,##0.00' for nfFixedTh and 2 decimals @return String of formatting codes, such as '#,##0.00' for nfFixedTh and 2 decimals
} -------------------------------------------------------------------------------}
function BuildNumberFormatString(ANumberFormat: TsNumberFormat; function BuildNumberFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; ADecimals: Integer = -1): String; const AFormatSettings: TFormatSettings; ADecimals: Integer = -1): String;
var var
@ -988,7 +1004,7 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Adds an AM/PM format code to a pre-built time formatting string. The strings 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 replacing "AM" or "PM" in the final formatted number are taken from the
TimeAMString or TimePMString of the given FormatSettings. TimeAMString or TimePMString of the given FormatSettings.
@ -998,7 +1014,7 @@ end;
@result Formatting string with AM/PM option activated. @result Formatting string with AM/PM option activated.
Example: ATimeFormatString = 'hh:nn' ==> 'hh:nn AM/PM' 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
@ -1009,14 +1025,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 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 of "AM/PM" are considered as well. The string is left unchanged if it does not
contain AM/PM codes. contain AM/PM codes.
@param ATimeFormatString String of time formatting codes (such as 'hh:nn AM/PM') @param ATimeFormatString String of time formatting codes (such as 'hh:nn AM/PM')
@return Formatting string with AM/PM being removed (--> 'hh:nn') @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;
@ -1034,7 +1050,7 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Counts how many decimal places are coded into a given formatting string. Counts how many decimal places are coded into a given formatting string.
@param AFormatString String with number format codes, such as '0.000' @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 For the fixed decimals, this is the '0'. Optional
decimals are encoced as '#'. decimals are encoced as '#'.
@return Count of decimal places found (3 in above example). @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;
@ -1062,8 +1078,8 @@ begin
end; end;
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, first time symbol must be enclosed by square brackets. Checks if this is true,
and adds the brackes if not. and adds the brackes if not.
@ -1071,7 +1087,7 @@ end;
@return Unchanged format string if its first time code is in square brackets @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 (as in '[h]:nn:ss'), if not, the first time code is enclosed in
square brackets. square brackets.
} -------------------------------------------------------------------------------}
function AddIntervalBrackets(AFormatString: String): String; function AddIntervalBrackets(AFormatString: String): String;
var var
p: Integer; p: Integer;
@ -1090,7 +1106,7 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates a long date format string out of a short date format string. 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 Retains the order of year-month-day and the separators, but uses 4 digits
for year and 3 digits of month. for year and 3 digits of month.
@ -1098,7 +1114,7 @@ end;
@param ADateFormat String with date formatting code representing a @param ADateFormat String with date formatting code representing a
"short" date, such as 'dd/mm/yy' "short" date, such as 'dd/mm/yy'
@return Format string modified to represent a "long" date, such as 'dd/mmm/yyyy' @return Format string modified to represent a "long" date, such as 'dd/mmm/yyyy'
} -------------------------------------------------------------------------------}
function MakeLongDateFormat(ADateFormat: String): String; function MakeLongDateFormat(ADateFormat: String): String;
var var
i: Integer; i: Integer;
@ -1126,14 +1142,14 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Modifies the short date format such that it has a two-digit year and a two-digit 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. month. Retains the order of year-month-day and the separators.
@param ADateFormat String with date formatting codes representing a @param ADateFormat String with date formatting codes representing a
"long" date, such as 'dd/mmm/yyyy' "long" date, such as 'dd/mmm/yyyy'
@return Format string modified to represent a "short" date, such as 'dd/mm/yy' @return Format string modified to represent a "short" date, such as 'dd/mm/yy'
} -------------------------------------------------------------------------------}
function MakeShortDateFormat(ADateFormat: String): String; function MakeShortDateFormat(ADateFormat: String): String;
var var
i: Integer; i: Integer;
@ -1161,7 +1177,7 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz" Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz"
out of the formatsettings. out of the formatsettings.
@ -1171,7 +1187,7 @@ end;
"ms" = minutes + seconds "ms" = minutes + seconds
"msz" = minutes + seconds + fractions of a second "msz" = minutes + seconds + fractions of a second
@return String of formatting codes according to the parameter ACode @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
@ -1206,7 +1222,7 @@ begin
Result := ACode; Result := ACode;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Currency formatting strings consist of three parts, separated by Currency formatting strings consist of three parts, separated by
semicolons, which are valid for positive, negative or zero values. semicolons, which are valid for positive, negative or zero values.
Splits such a formatting string at the positions of the semicolons and 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 @param ANegativePart Second section of the formatting string which is valid
for negative numbers for negative numbers
@param AZeroPart Third section of the formatting string for zero. @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);
@ -1281,14 +1296,14 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Creates a "time interval" format string having the first time code identifier Creates a "time interval" format string having the first time code identifier
in square brackets. in square brackets.
@param Src Source format string, must be a time format string, like 'hh:nn' @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 @param Dest Destination format string, will have the first time code element
of the src format string in square brackets, like '[hh]:nn'. of the src format string in square brackets, like '[hh]:nn'.
} -------------------------------------------------------------------------------}
procedure MakeTimeIntervalMask(Src: String; var Dest: String); procedure MakeTimeIntervalMask(Src: String; var Dest: String);
var var
L: TStrings; L: TStrings;
@ -1306,108 +1321,108 @@ begin
end; end;
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Excel's unit of row heights is "twips", i.e. 1/20 point. Excel's unit of row heights is "twips", i.e. 1/20 point.
Converts Twips to points. Converts Twips to points.
@param AValue Length value in twips @param AValue Length value in twips
@return Value converted to points @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 @param AValue Length value in points
@return Value converted to twips @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 @param AValue Length value in centimeters
@return Value converted to points @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 @param AValue Length value in points
@return Value converted to centimeters @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 @param AValue Length value in inches
@return Value converted to points @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 @param AValue Length value in millimeters
@return Value converted to points @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 @param AValue Length value in points
@return Value converted to millimeters @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 AValue Length value given in pixels
@param AScreenPixelsPerInch Pixels per inch of the screen @param AScreenPixelsPerInch Pixels per inch of the screen
@return Value converted to points @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 AValue Length value given in points
@param AScreenPixelsPerInch Pixels per inch of the screen @param AScreenPixelsPerInch Pixels per inch of the screen
@return Value converted to pixels @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 Converts a HTML length string to points. The units are assumed to be the last
two digits of the string, such as '1.25in' two digits of the string, such as '1.25in'
@ -1416,7 +1431,7 @@ end;
'px' (pixels), 'pt' (points), 'in' (inches), 'mm' (millimeters), 'px' (pixels), 'pt' (points), 'in' (inches), 'mm' (millimeters),
'cm' (centimeters). 'cm' (centimeters).
@return Extracted length in points @return Extracted length in points
} -------------------------------------------------------------------------------}
function HTMLLengthStrToPts(AValue: String): Double; function HTMLLengthStrToPts(AValue: String): Double;
var var
units: String; units: String;
@ -1449,13 +1464,13 @@ begin
raise Exception.Create('Unknown length units'); raise Exception.Create('Unknown length units');
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Converts a HTML color string to a TsColorValue. Need for the ODS file format. Converts a HTML color string to a TsColorValue. Need for the ODS file format.
@param AValue HTML color string, such as '#FF0000' @param AValue HTML color string, such as '#FF0000'
@return rgb color value in little endian byte-sequence. This value is @return rgb color value in little endian byte-sequence. This value is
compatible with the TColor data type of the graphics unit. 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
@ -1495,7 +1510,7 @@ 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 @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, @param AExcelDialect If TRUE, returned string is in Excels format for xlsx,
i.e. in AARRGGBB notation, like '00FF0000' for "red" i.e. in AARRGGBB notation, like '00FF0000' for "red"
@return HTML-compatible string, like '#FF0000' (AExcelDialect = false) @return HTML-compatible string, like '#FF0000' (AExcelDialect = false)
} -------------------------------------------------------------------------------}
function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String; function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String;
type type
TRGB = record r,g,b,a: Byte end; TRGB = record r,g,b,a: Byte end;
@ -1517,13 +1532,13 @@ begin
Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]); Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]);
end; end;
{@@ {@@ ----------------------------------------------------------------------------
Converts a string encoded in UTF8 to a string usable in XML. For this purpose, Converts a string encoded in UTF8 to a string usable in XML. For this purpose,
some characters must be translated. some characters must be translated.
@param AText input string encoded as UTF8 @param AText input string encoded as UTF8
@return String usable in XML with some characters replaced by the HTML codes. @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;