diff --git a/components/fpspreadsheet/fpspreadsheet.chm b/components/fpspreadsheet/fpspreadsheet.chm index 026c4cc41..fa5ec4545 100755 Binary files a/components/fpspreadsheet/fpspreadsheet.chm and b/components/fpspreadsheet/fpspreadsheet.chm differ diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 399f4a713..d50ebecd1 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -1274,13 +1274,13 @@ begin GsSpreadFormats[len].Format := AFormat; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the name of the given spreadsheet file format. @param AFormat Identifier of the file format @return 'BIFF2', 'BIFF3', 'BIFF4', 'BIFF5', 'BIFF8', 'OOXML', 'Open Document', 'CSV, 'WikiTable Pipes', or 'WikiTable WikiMedia" -} +-------------------------------------------------------------------------------} function GetFileFormatName(AFormat: TsSpreadsheetFormat): string; begin case AFormat of @@ -1301,7 +1301,7 @@ begin end; -{@@ +{@@ ---------------------------------------------------------------------------- If a palette is coded as big-endian (e.g. by copying the rgb values from the OpenOffice doc) the palette values can be converted by means of this procedure to little-endian which is required internally by TsWorkbook. @@ -1309,7 +1309,7 @@ end; @param APalette Pointer to the palette to be converted. After conversion, its color values are replaced. @param APaletteSize Number of colors contained in the palette -} +-------------------------------------------------------------------------------} procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer); var i: Integer; @@ -1320,12 +1320,12 @@ begin {$POP} end; -{@@ +{@@ ---------------------------------------------------------------------------- Copies the format of a cell to another one. @param AFromCell cell from which the format is to be copied @param AToCell cell to which the format is to be copied -} +-------------------------------------------------------------------------------} procedure CopyCellFormat(AFromCell, AToCell: PCell); begin Assert(AFromCell <> nil); @@ -1343,8 +1343,9 @@ begin AToCell^.NumberFormatStr := AFromCell^.NumberFormatStr; end; -{@@ - Checks whether two cells have same border attributes } +{@@ ---------------------------------------------------------------------------- + Checks whether two cells have same border attributes +-------------------------------------------------------------------------------} function SameCellBorders(ACell1, ACell2: PCell): Boolean; function NoBorder(ACell: PCell): Boolean; @@ -1379,10 +1380,10 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Initalizes a new cell @return New cell record -} +-------------------------------------------------------------------------------} procedure InitCell(out ACell: TCell); begin ACell.FormulaValue := ''; @@ -1391,14 +1392,14 @@ begin FillChar(ACell, SizeOf(ACell), 0); end; -{@@ +{@@ ---------------------------------------------------------------------------- Initalizes a new cell and presets the row and column fields of the cell record to the parameters passesd to the procedure. @param ARow Row index of the new cell @param ACol Column index of the new cell @return New cell record with row and column fields preset to passed parameters. -} +-------------------------------------------------------------------------------} procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); begin InitCell(ACell); @@ -1406,9 +1407,9 @@ begin ACell.Col := ACol; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns TRUE if the cell contains a formula (direct or shared, does not matter). -} +-------------------------------------------------------------------------------} function HasFormula(ACell: PCell): Boolean; begin Result := Assigned(ACell) and ( @@ -4187,7 +4188,7 @@ begin Result := WriteFont(ACell, fnt.FontName, fnt.Size, fnt.Style, AFontColor); end; -{@@ +{@@ ---------------------------------------------------------------------------- Replaces the font used in formatting of a cell considering only the font face and leaving font size, style and color unchanged. Looks in the workbook's font list if this modified font has already been used. If not a new font entry @@ -4197,13 +4198,13 @@ end; @param ACol The column of the cell @param AFontName Name of the new font to be used @return Index of the font in the workbook's font list. -} +-------------------------------------------------------------------------------} function TsWorksheet.WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer; begin result := WriteFontName(GetCell(ARow, ACol), AFontName); end; -{@@ +{@@ ---------------------------------------------------------------------------- Replaces the font used in formatting of a cell considering only the font face and leaving font size, style and color unchanged. Looks in the workbook's font list if this modified font has already been used. If not a new font entry @@ -4212,7 +4213,7 @@ end; @param ACell Pointer to the cell @param AFontName Name of the new font to be used @return Index of the font in the workbook's font list. -} +-------------------------------------------------------------------------------} function TsWorksheet.WriteFontName(ACell: PCell; AFontName: String): Integer; var fnt: TsFont; @@ -4225,7 +4226,7 @@ begin result := WriteFont(ACell, AFontName, fnt.Size, fnt.Style, fnt.Color); end; -{@@ +{@@ ---------------------------------------------------------------------------- Replaces the font size in formatting of a cell. Looks in the workbook's font list if this modified font has already been used. If not a new font entry is created. Returns the index of this font in the font list. @@ -4234,13 +4235,13 @@ end; @param ACol The column of the cell @param ASize Size of the font to be used (in points). @return Index of the font in the workbook's font list. -} +-------------------------------------------------------------------------------} function TsWorksheet.WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer; begin Result := WriteFontSize(GetCell(ARow, ACol), ASize); end; -{@@ +{@@ ---------------------------------------------------------------------------- Replaces the font size in formatting of a cell. Looks in the workbook's font list if this modified font has already been used. If not a new font entry is created. Returns the index of this font in the font list. @@ -4248,7 +4249,7 @@ end; @param ACell Pointer to the cell @param ASize Size of the font to be used (in points). @return Index of the font in the workbook's font list. -} +-------------------------------------------------------------------------------} function TsWorksheet.WriteFontSize(ACell: PCell; ASize: Single): Integer; var fnt: TsFont; @@ -4261,7 +4262,7 @@ begin Result := WriteFont(ACell, fnt.FontName, ASize, fnt.Style, fnt.Color); end; -{@@ +{@@ ---------------------------------------------------------------------------- Replaces the font style (bold, italic, etc) in formatting of a cell. Looks in the workbook's font list if this modified font has already been used. If not a new font entry is created. @@ -4273,14 +4274,14 @@ end; @return Index of the font in the workbook's font list. @see TsFontStyle -} +-------------------------------------------------------------------------------} function TsWorksheet.WriteFontStyle(ARow, ACol: Cardinal; AStyle: TsFontStyles): Integer; begin Result := WriteFontStyle(GetCell(ARow, ACol), AStyle); end; -{@@ +{@@ ---------------------------------------------------------------------------- Replaces the font style (bold, italic, etc) in formatting of a cell. Looks in the workbook's font list if this modified font has already been used. If not a new font entry is created. @@ -4291,7 +4292,7 @@ end; @return Index of the font in the workbook's font list. @see TsFontStyle -} +-------------------------------------------------------------------------------} function TsWorksheet.WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer; var fnt: TsFont; @@ -4305,7 +4306,7 @@ begin Result := WriteFont(ACell, fnt.FontName, fnt.Size, AStyle, fnt.Color); end; -{@@ +{@@ ---------------------------------------------------------------------------- Adds text rotation to the formatting of a cell @param ARow The row of the cell @@ -4314,7 +4315,7 @@ end; @return Pointer to cell @see TsTextRotation -} +-------------------------------------------------------------------------------} function TsWorksheet.WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation): PCell; begin @@ -4322,14 +4323,14 @@ begin WriteTextRotation(Result, ARotation); end; -{@@ +{@@ ---------------------------------------------------------------------------- Adds text rotation to the formatting of a cell @param ACell Pointer to the cell @param ARotation How to rotate the text @see TsTextRotation -} +-------------------------------------------------------------------------------} procedure TsWorksheet.WriteTextRotation(ACell: PCell; ARotation: TsTextRotation); begin if ACell = nil then @@ -4339,7 +4340,7 @@ begin ChangedFont(ACell^.Row, ACell^.Col); end; -{@@ +{@@ ---------------------------------------------------------------------------- Directly modifies the used formatting fields of a cell. Only formatting corresponding to items included in this set is executed. @@ -4349,7 +4350,7 @@ end; @see TsUsedFormattingFields @see TCell -} +-------------------------------------------------------------------------------} procedure TsWorksheet.WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields); var @@ -4634,8 +4635,10 @@ end; @param ARow Row index of the cell considered @param ACol Column index of the cell considered - @param AValue Parameter for horizontal text alignment (haDefault, vaLeft, haCenter, haRight) - By default, texts are left-aligned, numbers and dates are right-aligned. + @param AValue Parameter for horizontal text alignment + (haDefault, vaLeft, haCenter, haRight) + By default, texts are left-aligned, numbers and dates are + right-aligned. @return Pointer to cell -------------------------------------------------------------------------------} function TsWorksheet.WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment): PCell; @@ -4648,8 +4651,10 @@ end; Defines the horizontal alignment of text in a cell. @param ACell Pointer to the cell considered - @param AValue Parameter for horizontal text alignment (haDefault, vaLeft, haCenter, haRight) - By default, texts are left-aligned, numbers and dates are right-aligned. + @param AValue Parameter for horizontal text alignment + (haDefault, vaLeft, haCenter, haRight) + By default, texts are left-aligned, numbers and dates are + right-aligned. -------------------------------------------------------------------------------} procedure TsWorksheet.WriteHorAlignment(ACell: PCell; AValue: TsHorAlignment); begin @@ -4665,11 +4670,13 @@ end; @param ARow Row index of the cell considered @param ACol Column index of the cell considered - @param AValue Parameter for vertical text alignment (vaDefault, vaTop, vaCenter, vaBottom) + @param AValue Parameter for vertical text alignment + (vaDefault, vaTop, vaCenter, vaBottom) By default, texts are bottom-aligned. @return Pointer to cell -------------------------------------------------------------------------------} -function TsWorksheet.WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment): PCell; +function TsWorksheet.WriteVertAlignment(ARow, ACol: Cardinal; + AValue: TsVertAlignment): PCell; begin Result := GetCell(ARow, ACol); WriteVertAlignment(Result, AValue); @@ -4679,7 +4686,8 @@ end; Defines the vertical alignment of text in a cell. @param ACell Poiner to the cell considered - @param AValue Parameter for vertical text alignment (vaDefault, vaTop, vaCenter, vaBottom) + @param AValue Parameter for vertical text alignment + (vaDefault, vaTop, vaCenter, vaBottom) By default, texts are bottom-aligned. -------------------------------------------------------------------------------} procedure TsWorksheet.WriteVertAlignment(ACell: PCell; AValue: TsVertAlignment); @@ -4727,13 +4735,13 @@ begin Result := FWorkbook.FormatSettings; end; -{@@ +{@@ ---------------------------------------------------------------------------- Calculates the optimum height of a given row. Depends on the font size of the individual cells in the row. @param ARow Index of the row to be considered @return Row height in line count of the default font. -} +-------------------------------------------------------------------------------} function TsWorksheet.CalcAutoRowHeight(ARow: Cardinal): Single; var cell: PCell; @@ -4749,12 +4757,14 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Checks if a row record exists for the given row index and returns a pointer to the row record, or nil if not found @param ARow Index of the row looked for - @return Pointer to the row record with this row index, or nil if not found } + @return Pointer to the row record with this row index, or nil if not + found +-------------------------------------------------------------------------------} function TsWorksheet.FindRow(ARow: Cardinal): PRow; var LElement: TRow; @@ -4767,12 +4777,14 @@ begin result := PRow(AVLNode.Data); end; -{@@ - Checks if a column record exists for the given column index and returns a pointer - to the TCol record, or nil if not found +{@@ ---------------------------------------------------------------------------- + Checks if a column record exists for the given column index and returns a + pointer to the TCol record, or nil if not found @param ACol Index of the column looked for - @return Pointer to the column record with this column index, or nil if not found } + @return Pointer to the column record with this column index, or + nil if not found +-------------------------------------------------------------------------------} function TsWorksheet.FindCol(ACol: Cardinal): PCol; var LElement: TCol; @@ -4785,12 +4797,14 @@ begin result := PCol(AVLNode.Data); end; -{@@ - Checks if a row record exists for the given row index and creates it if not found. +{@@ ---------------------------------------------------------------------------- + Checks if a row record exists for the given row index and creates it if not + found. @param ARow Index of the row looked for @return Pointer to the row record with this row index. It can safely be - assumed that this row record exists. } + assumed that this row record exists. +-------------------------------------------------------------------------------} function TsWorksheet.GetRow(ARow: Cardinal): PRow; begin Result := FindRow(ARow); @@ -4806,13 +4820,14 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Checks if a column record exists for the given column index and creates it if not found. @param ACol Index of the column looked for - @return Pointer to the TCol record with this column index. It can safely be - assumed that this column record exists. } + @return Pointer to the TCol record with this column index. It can + safely be assumed that this column record exists. +-------------------------------------------------------------------------------} function TsWorksheet.GetCol(ACol: Cardinal): PCol; begin Result := FindCol(ACol); @@ -4830,12 +4845,13 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Counts how many cells exist in the given column. Blank cells do contribute to the sum, as well as formatted cells. @param ACol Index of the column considered - @return Count of cells with value or format in this column } + @return Count of cells with value or format in this column +-------------------------------------------------------------------------------} function TsWorksheet.GetCellCountInCol(ACol: Cardinal): Cardinal; var cell: PCell; @@ -4854,13 +4870,13 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Counts how many cells exist in the given row. Blank cells do contribute to the sum, as well as formatted cell.s @param ARow Index of the row considered @return Count of cells with value or format in this row -} +-------------------------------------------------------------------------------} function TsWorksheet.GetCellCountInRow(ARow: Cardinal): Cardinal; var cell: PCell; @@ -4879,13 +4895,13 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the width of the given column. If there is no column record then the default column width is returned. @param ACol Index of the column considered @return Width of the column (in count of "0" characters of the default font) -} +-------------------------------------------------------------------------------} function TsWorksheet.GetColWidth(ACol: Cardinal): Single; var col: PCol; @@ -4897,13 +4913,13 @@ begin Result := FDefaultColWidth; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the height of the given row. If there is no row record then the default row height is returned @param ARow Index of the row considered @return Height of the row (in line count of the default font). -} +-------------------------------------------------------------------------------} function TsWorksheet.GetRowHeight(ARow: Cardinal): Single; var row: PRow; @@ -4916,13 +4932,13 @@ begin Result := FDefaultRowHeight; end; -{@@ - Deletes the column at the index specified. Cells with greader column indexes are - moved one column to the left. Merged cell blocks and cell references in formulas - are considered as well. +{@@ ---------------------------------------------------------------------------- + Deletes the column at the index specified. Cells with greader column indexes + are moved one column to the left. Merged cell blocks and cell references in + formulas are considered as well. @param ACol Index of the column to be deleted -} +-------------------------------------------------------------------------------} procedure TsWorksheet.DeleteCol(ACol: Cardinal); var cellnode: TAVLTreeNode; @@ -5004,13 +5020,13 @@ begin ChangedCell(0, ACol); end; -{@@ +{@@ ---------------------------------------------------------------------------- Deletes the row at the index specified. Cells with greader row indexes are moved one row up. Merged cell blocks and cell references in formulas are considered as well. @param ARow Index of the row to be deleted -} +-------------------------------------------------------------------------------} procedure TsWorksheet.DeleteRow(ARow: Cardinal); var cellnode: TAVLTreeNode; @@ -5090,13 +5106,13 @@ begin ChangedCell(ARow, 0); end; -{@@ - Inserts a column BEFORE the index specified. Cells with greater column indexes are - moved one column to the right. Merged cell blocks and cell references in formulas - are considered as well. +{@@ ---------------------------------------------------------------------------- + Inserts a column BEFORE the index specified. Cells with greater column indexes + are moved one column to the right. Merged cell blocks and cell references in + formulas are considered as well. @param ACol Index of the column before which a new column is inserted. -} +-------------------------------------------------------------------------------} procedure TsWorksheet.InsertCol(ACol: Cardinal); var cellnode: TAVLTreeNode; @@ -5204,13 +5220,13 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Inserts a row BEFORE the row specified. Cells with greater row indexes are moved one row down. Merged cell blocks and cell references in formulas are considered as well. @param ARow Index of the row before which a new row is inserted. -} +-------------------------------------------------------------------------------} procedure TsWorksheet.InsertRow(ARow: Cardinal); var row: PRow; @@ -5313,10 +5329,10 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Removes all row records from the worksheet and frees the occupied memory. Note: Cells are retained. -} +-------------------------------------------------------------------------------} procedure TsWorksheet.RemoveAllRows; var Node: Pointer; @@ -5346,8 +5362,9 @@ begin end; {@@ ---------------------------------------------------------------------------- - Removes a specified column record from the worksheet and frees the occupied memory. - This resets the its column width to default. + Removes a specified column record from the worksheet and frees the occupied + memory. This resets its column width to default. + Note: Cells in that column are retained. -------------------------------------------------------------------------------} procedure TsWorksheet.RemoveCol(ACol: Cardinal); @@ -5385,7 +5402,8 @@ end; {@@ ---------------------------------------------------------------------------- Writes a row record for the row at a given index to the spreadsheet. - Currently the row record contains only the row height (and the row index, of course). + Currently the row record contains only the row height (and the row index, + of course). Creates a new row record if it does not yet exist. @@ -5521,8 +5539,8 @@ end; {@@ ---------------------------------------------------------------------------- Constructor of the workbook class. Among others, it initializes the built-in - fonts, defines the default font, and sets up the FormatSettings for localization - of some number formats. + fonts, defines the default font, and sets up the FormatSettings for + localization of some number formats. -------------------------------------------------------------------------------} constructor TsWorkbook.Create; begin @@ -5846,7 +5864,8 @@ begin valid := GetFormatFromFileName(AFileName, SheetType); if valid then WriteToFile(AFileName, SheetType, AOverwriteExisting) else raise Exception.Create(Format( - '[TsWorkbook.WriteToFile] Attempted to save a spreadsheet by extension, but the extension %s is invalid.', [ExtractFileExt(AFileName)])); + '[TsWorkbook.WriteToFile] Attempt to save a spreadsheet by extension, ' + + 'but the extension %s is not valid.', [ExtractFileExt(AFileName)])); end; {@@ ---------------------------------------------------------------------------- @@ -6512,27 +6531,6 @@ begin end else Result := $000000; // "black" as default - { - - case AColorIndex of - $0040: Result := DEF_FOREGROUND_COLORVALUE; - $0041: Result := DEF_BACKGROUND_COLORVALUE; - $004D: Result := DEF_CHART_FOREGROUND_COLORVALUE; - $004E: Result := DEF_CHART_BACKGROUND_COLORVALUE; - $004F: Result := DEF_CHART_NEUTRAL_COLORVALUE; - $0051: Result := DEF_TOOLTIP_TEXT_COLORVALUE; - $7FFF: Result := DEF_FONT_AUTOMATIC_COLORVALUE; - else if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then - begin - if ((FPalette = nil) or (Length(FPalette) = 0)) then - Result := DEFAULT_PALETTE[AColorIndex] - else - Result := FPalette[AColorIndex]; - end - else - Result := $000000; // "black" as default - end; - } end; {@@ ---------------------------------------------------------------------------- @@ -6597,8 +6595,8 @@ end; @param APaletteCount Count of numbers in the source palette @param ABigEnding If true, indicates that the source palette is in big-endian notation. The methods inverts the rgb - components to little-endian which is used by fpspreadsheet - internally. + components to little-endian which is used by + fpspreadsheet internally. -------------------------------------------------------------------------------} procedure TsWorkbook.UsePalette(APalette: PsPalette; APaletteCount: Word; ABigEndian: Boolean); @@ -6998,7 +6996,9 @@ end; the format list (or -1, if not found) To be used by OpenDocument file format. - @param AFormatName Format name as used by OpenDocument to identify a number format + @param AFormatName Format name as used by OpenDocument to identify a + number format + @return Index of the format item in the list, or -1 if not found -------------------------------------------------------------------------------} function TsCustomNumFormatList.FindByName(AFormatName: String): integer; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index c938c0530..96c5ff98a 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -541,7 +541,9 @@ var {@@ Auxiliary bitmap containing the fill pattern used by biff2 cell backgrounds. } FillPattern_BIFF2: TBitmap = nil; -{@@ Helper procedure which creates the fill pattern used by biff2 cell backgrounds. } +{@@ ---------------------------------------------------------------------------- + Helper procedure which creates the fill pattern used by biff2 cell backgrounds. +-------------------------------------------------------------------------------} procedure Create_FillPattern_BIFF2(ABkColor: TColor); begin FreeAndNil(FillPattern_BIFF2); @@ -555,13 +557,13 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Helper procedure which draws a densely dotted horizontal line. In Excel this is called a "hair line". @param x1, x2 x coordinates of the end points of the line @param y y coordinate of the horizontal line -} +-------------------------------------------------------------------------------} procedure DrawHairLineHor(ACanvas: TCanvas; x1, x2, y: Integer); var clr: TColor; @@ -576,13 +578,13 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Helper procedure which draws a densely dotted vertical line. In Excel this is called a "hair line". @param x x coordinate of the vertical line @param y1, y2 y coordinates of the end points of the line -} +-------------------------------------------------------------------------------} procedure DrawHairLineVert(ACanvas: TCanvas; x, y1, y2: Integer); var clr: TColor; @@ -597,7 +599,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Wraps text by inserting line ending characters so that the lines are not longer than AMaxWidth. @@ -609,7 +611,7 @@ end; @note Based on ocde posted by user "taazz" in the Lazarus forum http://forum.lazarus.freepascal.org/index.php/topic,21305.msg124743.html#msg124743 -} +-------------------------------------------------------------------------------} function WrapText(ACanvas: TCanvas; const AText: string; AMaxWidth: integer): string; var DC: HDC; @@ -674,7 +676,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Calculates a background color for selected cells. The procedures takes the original background color and dims or brightens it by adding the value ADelta to the RGB components. @@ -682,7 +684,7 @@ end; @param c Color to be modified @param ADelta Value to be added to the RGB components of the inpur color @result Modified color. -} +-------------------------------------------------------------------------------} function CalcSelectionColor(c: TColor; ADelta: Byte) : TColor; type TRGBA = record R,G,B,A: Byte end; @@ -700,22 +702,27 @@ begin else TRGBA(Result).B := TRGBA(c).B - ADelta; end; -{@@ Registers the worksheet grid in the Lazarus component palette, page "Additional". } +{@@ ---------------------------------------------------------------------------- + Registers the worksheet grid in the Lazarus component palette, + page "Additional". +-------------------------------------------------------------------------------} procedure Register; begin RegisterComponents('Additional',[TsWorksheetGrid]); end; -{ TsCustomWorksheetGrid } +{******************************************************************************* +* TsCustomWorksheetGrid * +*******************************************************************************} -{@@ +{@@ ---------------------------------------------------------------------------- Constructor of the grid. Activates the display of column and row headers and creates an internal "CellFont". Creates a pre-defined number of empty rows and columns. @param AOwner Owner of the grid -} +-------------------------------------------------------------------------------} constructor TsCustomWorksheetGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -727,9 +734,9 @@ begin FCellFont := TFont.Create; end; -{@@ +{@@ ---------------------------------------------------------------------------- Destructor of the grid: Destroys the workbook and the internal CellFont. -} +-------------------------------------------------------------------------------} destructor TsCustomWorksheetGrid.Destroy; begin FreeAndNil(FWorkbook); @@ -737,24 +744,24 @@ begin inherited Destroy; end; -{@@ +{@@ ---------------------------------------------------------------------------- The BeginUpdate/EndUpdate pair suppresses unnecessary painting of the grid. Call BeginUpdate to stop refreshing the grid, and call EndUpdate to release the lock and to repaint the grid again. -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.BeginUpdate; begin inc(FLockCount); end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts the column width, given in "characters" of the default font, to pixels. All chars are assumed to have the same width defined by the width of the "0" character. Therefore, this calculation is only approximate. @param AWidth Width of a column given as "character count". @return Column width in pixels. -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.CalcColWidth(AWidth: Single): Integer; var w0: Integer; @@ -764,7 +771,7 @@ begin Result := Round(AWidth * w0); end; -{@@ +{@@ ---------------------------------------------------------------------------- Finds the maximum cell height per row and uses this to define the RowHeights[]. Returns DefaultRowHeight if the row does not contain any cells, or if the worksheet does not have a TRow record for this particular row. @@ -772,7 +779,7 @@ end; @param ARow Index of the row, in grid units @return Row height -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.CalcAutoRowHeight(ARow: Integer): Integer; var c: Integer; @@ -787,14 +794,14 @@ begin Result := h; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts the row height (from a worksheet row record), given in lines, to pixels as needed by the grid @param AHeight Row height expressed as default font line count from the worksheet @result Row height in pixels. -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.CalcRowHeight(AHeight: Single): Integer; var h_pts: Single; @@ -803,12 +810,13 @@ begin Result := PtsToPX(h_pts, Screen.PixelsPerInch) + 4; end; -{@@ Looks for overflowing cells: if the text of the given cell is longer than +{@@ ---------------------------------------------------------------------------- + Looks for overflowing cells: if the text of the given cell is longer than the cell width the function calculates the column indexes and the rectangle to show the complete text. Ony for non-wordwrapped label cells and for horizontal orientation. Function returns false if text overflow needs not to be considered. -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.CellOverflow(ACol, ARow: Integer; AState: TGridDrawState; out ACol1, ACol2: Integer; var ARect: TRect): Boolean; var @@ -907,7 +915,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Handler for the event OnChangeCell fired by the worksheet when the contents or formatting of a cell have changed. As a consequence, the grid may have to update the cell. @@ -916,14 +924,14 @@ end; @param ASender Sender of the event OnChangeFont (the worksheet) @param ARow Row index of the changed cell, in worksheet units! @param ACol Column index of the changed cell, in worksheet units! -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.ChangedCellHandler(ASender: TObject; ARow, ACol:Cardinal); begin Unused(ASender, ARow, ACol); if FLockCount = 0 then Invalidate; end; -{@@ +{@@ ---------------------------------------------------------------------------- Handler for the event OnChangeFont fired by the worksheet when the font has changed in a cell. As a consequence, the grid may have to update the row height. @@ -932,8 +940,9 @@ end; @param ASender Sender of the event OnChangeFont (the worksheet) @param ARow Row index of the cell with the changed font, in worksheet units! @param ACol Column index of the cell with the changed font, in worksheet units! -} -procedure TsCustomWorksheetGrid.ChangedFontHandler(ASender: TObject; ARow, ACol: Cardinal); +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.ChangedFontHandler(ASender: TObject; + ARow, ACol: Cardinal); var lRow: PRow; begin @@ -950,12 +959,12 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts a spreadsheet font to a font used for painting (TCanvas.Font). @param sFont Font as used by fpspreadsheet (input) @param AFont Font as used by TCanvas for painting (output) -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.Convert_sFont_to_Font(sFont: TsFont; AFont: TFont); begin if Assigned(AFont) and Assigned(sFont) then begin @@ -970,13 +979,14 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts a font used for painting (TCanvas.Font) to a spreadsheet font. @param AFont Font as used by TCanvas for painting (input) @param sFont Font as used by fpspreadsheet (output) -} -procedure TsCustomWorksheetGrid.Convert_Font_to_sFont(AFont: TFont; sFont: TsFont); +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.Convert_Font_to_sFont(AFont: TFont; + sFont: TsFont); begin if Assigned(AFont) and Assigned(sFont) then begin sFont.FontName := AFont.Name; @@ -990,7 +1000,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- This is one of the main painting methods inherited from TsCustomGrid. It is overridden here to achieve the feature of "frozen" cells which should be painted in the same style as normal cells. @@ -1003,9 +1013,9 @@ end; @param ARow Row index of the cell beging drawn @param ARect Rectangle, in grid pixels, covered by the cell @param AState Grid drawing state, as defined by TsCustomGrid -} -procedure TsCustomWorksheetGrid.DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect; - AState: TGridDrawState); +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.DefaultDrawCell(aCol, aRow: Integer; + var aRect: TRect; AState: TGridDrawState); var wasFixed: Boolean; begin @@ -1035,9 +1045,11 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Deletes the column specified. -} + + @param AGridCol Grid index of the column to be deleted +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DeleteCol(AGridCol: Integer); begin if AGridCol < FHeaderCount then @@ -1047,9 +1059,11 @@ begin UpdateColWidths(AGridCol); end; -{@@ +{@@ ---------------------------------------------------------------------------- Deletes the row specified. -} + + @param AGridRow Grid index of the row to be deleted +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DeleteRow(AGridRow: Integer); begin if AGridRow < FHeaderCount then @@ -1060,10 +1074,10 @@ begin end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates a new empty workbook into which a file will be loaded. Destroys the previously used workbook. -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.CreateNewWorkbook; begin FreeAndNil(FWorkbook); @@ -1075,14 +1089,14 @@ begin SetAutoCalc(FAutoCalc); end; -{@@ +{@@ ---------------------------------------------------------------------------- Adjusts the grid's canvas before painting a given cell. Considers background color, horizontal alignment, vertical alignment, etc. @param ACol Column index of the cell being painted @param ARow Row index of the cell being painted @param AState Grid drawing state -- see TsCustomGrid. -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); var @@ -1098,48 +1112,58 @@ begin Canvas.Brush.Bitmap := nil; Canvas.Brush.Color := Color; ts := Canvas.TextStyle; - if ShowHeaders then begin + if ShowHeaders then + begin // Formatting of row and column headers - if ARow = 0 then begin + if ARow = 0 then + begin ts.Alignment := taCenter; ts.Layout := tlCenter; end else - if ACol = 0 then begin + if ACol = 0 then + begin ts.Alignment := taRightJustify; ts.Layout := tlCenter; end; if ShowHeaders and ((ACol = 0) or (ARow = 0)) then Canvas.Brush.Color := FixedColor end; - if (FWorksheet <> nil) and (ARow >= FHeaderCount) and (ACol >= FHeaderCount) - then begin + if (FWorksheet <> nil) and (ARow >= FHeaderCount) and (ACol >= FHeaderCount) then + begin r := ARow - FHeaderCount; c := ACol - FHeaderCount; //lCell := FDrawingCell; lCell := FWorksheet.FindCell(r, c); - if lCell <> nil then begin + if lCell <> nil then + begin // Background color - if (uffBackgroundColor in lCell^.UsedFormattingFields) then begin - if FWorkbook.FileFormat = sfExcel2 then begin + if (uffBackgroundColor in lCell^.UsedFormattingFields) then + begin + if FWorkbook.FileFormat = sfExcel2 then + begin if (FillPattern_BIFF2 = nil) and (ComponentState = []) then Create_FillPattern_BIFF2(Color); Canvas.Brush.Style := bsImage; Canvas.Brush.Bitmap := FillPattern_BIFF2; - end else begin + end else + begin Canvas.Brush.Style := bsSolid; if lCell^.BackgroundColor < FWorkbook.GetPaletteSize then Canvas.Brush.Color := FWorkbook.GetPaletteColor(lCell^.BackgroundColor) else Canvas.Brush.Color := Color; end; - end else begin + end else + begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := Color; end; // Font - if (uffFont in lCell^.UsedFormattingFields) then begin + if (uffFont in lCell^.UsedFormattingFields) then + begin fnt := FWorkbook.GetFont(lCell^.FontIndex); - if fnt <> nil then begin + if fnt <> nil then + begin Canvas.Font.Name := fnt.FontName; Canvas.Font.Color := FWorkbook.GetPaletteColor(fnt.Color); style := []; @@ -1167,13 +1191,13 @@ begin inherited DoPrepareCanvas(ACol, ARow, AState); end; -{@@ +{@@ ---------------------------------------------------------------------------- This method is inherited from TsCustomGrid, but is overridden here in order to paint the cell borders and the selection rectangle. Both features can extend into the neighboring cells and thus would be clipped at the cell borders by the standard painting mechanism. At the time when DrawAllRows is called, however, clipping at cell borders is no longer active. -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawAllRows; var cliprect: TRect; @@ -1205,20 +1229,23 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Draws the borders of all cells. Calls DrawCellBorder for each individual cell. -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawCellBorders; var cell: PCell; c, r: Integer; rect: TRect; begin - if FWorksheet = nil then exit; + if FWorksheet = nil then + exit; cell := FWorksheet.GetFirstCell; - while cell <> nil do begin - if (uffBorder in cell^.UsedFormattingFields) then begin + while cell <> nil do + begin + if (uffBorder in cell^.UsedFormattingFields) then + begin c := cell^.Col + FHeaderCount; r := cell^.Row + FHeaderCount; rect := CellRect(c, r); @@ -1228,7 +1255,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Draws the border lines around a given cell. Note that when this procedure is called the output is clipped by the cell rectangle, but thick and double border styles extend into the neighboring cell. Therefore, these border lines @@ -1237,7 +1264,7 @@ end; @param ACol Column Index @param ARow Row index @param ARect Rectangle in pixels occupied by the cell. -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawCellBorders(ACol, ARow: Integer; ARect: TRect); const drawHor = 0; @@ -1273,18 +1300,21 @@ const // Tuning the rectangle to avoid issues at the grid borders and to get nice corners if (ABorderStyle.LineStyle in [lsMedium, lsThick, lsDouble]) then begin - if ACol = ColCount-1 then begin + if ACol = ColCount-1 then + begin if (ADrawDirection = drawVert) and (ACoord = ARect.Right-1) and width3 then dec(ACoord); dec(ARect.Right); end; - if ARow = RowCount-1 then begin + if ARow = RowCount-1 then + begin if (ADrawDirection = drawHor) and (ACoord = ARect.Bottom-1) and width3 then dec(ACoord); dec(ARect.Bottom); end; end; - if ABorderStyle.LineStyle in [lsMedium, lsThick] then begin + if ABorderStyle.LineStyle in [lsMedium, lsThick] then + begin if (ADrawDirection = drawHor) then dec(ARect.Right, 1) else if (ADrawDirection = drawVert) then @@ -1385,7 +1415,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- This procedure is responsible for painting the focus rectangle. We don't want the red dashed rectangle here, but prefer the thick Excel-like black border line. @@ -1395,21 +1425,21 @@ end; @param ACol Grid column index of the focused cell @param ARow Grid row index of the focused cell @param ARect Rectangle in pixels covered by the focused cell -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect); begin Unused(ACol, ARow, ARect); // Nothing do to end; -{@@ +{@@ ---------------------------------------------------------------------------- Draws a solid line along the borders of frozen panes. @param ARect This rectangle indicates the area containing movable cells. If the grid has frozen panes, a black line is drawn along the upper and/or left edge of this rectangle (depending on the value of FrozenRows and FrozenCols). -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawFrozenPaneBorders(ARect: TRect); begin if FWorkSheet = nil then @@ -1425,14 +1455,14 @@ begin end; end; -{@@ - Draws a complete row of cells. Is mostly duplicated from Grids.pas in order - to be able to add code for merged cells and overflow text. -} +{@@ ---------------------------------------------------------------------------- + Draws a complete row of cells. Is mostly duplicated from Grids.pas, but adds + code for merged cells and overflow text. +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawRow(ARow: Integer); var gds: TGridDrawState; - sr, sc, sr1,sc1,sr2,sc2: Cardinal; // sheet row/column + sr, sc, sr1,sc1,sr2,sc2: Cardinal; // sheet row/column gr, gc, gcNext, gcLast, gc1, gc2, gcLastUsed: Integer; // grid row/column Rs: Boolean; rct, saved_rct: TRect; @@ -1641,9 +1671,9 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Draws the selection rectangle around selected cells, 3 pixels wide as in Excel. -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawSelection; var P1, P2: TPoint; @@ -1669,7 +1699,7 @@ begin Canvas.Rectangle(P1.X, P1.Y, P2.X, P2.Y); end; -{@@ +{@@ ---------------------------------------------------------------------------- Draws the cell text. Calls "GetCellText" to determine the text for the cell. Takes care of horizontal and vertical text alignment, text rotation and text wrapping. @@ -1678,7 +1708,7 @@ end; @param ARow Grid row index of the cell @param ARect Rectangle in pixels occupied by the cell @param AState Drawing state of the grid -- see TCustomGrid -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawTextInCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); var @@ -1709,8 +1739,10 @@ begin lCell := nil; } // Header - if lCell = nil then begin - if ShowHeaders and ((ACol = 0) or (ARow = 0)) then begin + if lCell = nil then + begin + if ShowHeaders and ((ACol = 0) or (ARow = 0)) then + begin ts.Alignment := taCenter; ts.Layout := tlCenter; ts.Opaque := false; @@ -1727,7 +1759,8 @@ begin if vertAlign = vaDefault then vertAlign := vaBottom; if lCell^.HorAlignment <> haDefault then horAlign := lCell^.HorAlignment - else begin + else + begin if (lCell^.ContentType in [cctNumber, cctDateTime]) then horAlign := haRight else @@ -1766,20 +1799,22 @@ begin txtRot, wrapped, false); end; -{@@ +{@@ ---------------------------------------------------------------------------- This procedure is called when editing of a cell is completed. It determines the worksheet cell and writes the text into the worksheet. Tries to keep the format of the cell, but if it is a new cell, or the content type has changed, tries to figure out the content type (number, date/time, text). -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.EditingDone; var oldText: String; cell: PCell; begin - if (not EditorShowing) and FEditing then begin + if (not EditorShowing) and FEditing then + begin oldText := GetCellText(Col, Row); - if oldText <> FEditText then begin + if oldText <> FEditText then + begin if FWorksheet = nil then FWorksheet := TsWorksheet.Create; cell := FWorksheet.GetCell(Row-FHeaderCount, Col-FHeaderCount); @@ -1791,24 +1826,24 @@ begin FEditing := false; end; -{@@ +{@@ ---------------------------------------------------------------------------- The BeginUpdate/EndUpdate pair suppresses unnecessary painting of the grid. Call BeginUpdate to stop refreshing the grid, and call EndUpdate to release the lock and to repaint the grid again. -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.EndUpdate; begin dec(FLockCount); if FLockCount = 0 then Invalidate; end; -{@@ +{@@ ---------------------------------------------------------------------------- Copies the borders of a cell to its neighbors. This avoids the nightmare of changing borders due to border conflicts of adjacent cells. @param ACol Grid column index of the cell @param ARow Grid row index of the cell -} +-------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.FixNeighborCellBorders(ACol, ARow: Integer); procedure SetNeighborBorder(NewRow, NewCol: Integer; @@ -1819,9 +1854,11 @@ procedure TsCustomWorksheetGrid.FixNeighborCellBorders(ACol, ARow: Integer); border: TsCellBorders; begin neighbor := FWorksheet.FindCell(NewRow, NewCol); - if neighbor <> nil then begin + if neighbor <> nil then + begin border := neighbor^.Border; - if AInclude then begin + if AInclude then + begin Include(border, ANewBorder); FWorksheet.WriteBorderStyle(NewRow, NewCol, ANewBorder, ANewBorderStyle); end else @@ -1833,10 +1870,13 @@ procedure TsCustomWorksheetGrid.FixNeighborCellBorders(ACol, ARow: Integer); var cell: PCell; begin - if FWorksheet = nil then exit; + if FWorksheet = nil then + exit; + cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); if (FWorksheet <> nil) and (cell <> nil) then - with cell^ do begin + with cell^ do + begin SetNeighborBorder(Row, Col-1, cbEast, BorderStyles[cbWest], cbWest in Border); SetNeighborBorder(Row, Col+1, cbWest, BorderStyles[cbEast], cbEast in Border); SetNeighborBorder(Row-1, Col, cbSouth, BorderStyles[cbNorth], cbNorth in Border); @@ -1844,14 +1884,14 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- The "colors" used by the spreadsheet are indexes into the workbook's color palette. If the user wants to set a color to a particular RGB value this is not possible in general. The method FindNearestPaletteIndex finds the bast matching color in the palette. @param AColor Color index into the workbook's palette -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.FindNearestPaletteIndex(AColor: TColor): TsColor; procedure ColorToHSL(RGB: TColor; out H, S, L : double); @@ -1872,7 +1912,8 @@ function TsCustomWorksheetGrid.FindNearestPaletteIndex(AColor: TColor): TsColor; if Cmax = Cmin then begin // it's grey H := 0; // it's actually undefined S := 0 - end else begin + end else + begin D := Cmax - Cmin; // calculate Saturation @@ -1925,11 +1966,14 @@ var dist, mindist: Double; begin Result := 0; - if Workbook <> nil then begin + if Workbook <> nil then + begin mindist := 1E308; - for i:=0 to Workbook.GetPaletteSize-1 do begin + for i:=0 to Workbook.GetPaletteSize-1 do + begin dist := ColorDistance(AColor, TColor(Workbook.GetPaletteColor(i))); - if dist < mindist then begin + if dist < mindist then + begin mindist := dist; Result := i; end; @@ -1937,27 +1981,28 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the background color of a cell. The color is given as an index into the workbook's color palette. @param ACol Grid column index of the cell @param ARow Grid row index of the cell @result Color index of the cell's background color. -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetBackgroundColor(ACol, ARow: Integer): TsColor; var cell: PCell; begin Result := scNotDefined; - if Assigned(FWorksheet) then begin + if Assigned(FWorksheet) then + begin cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); if (cell <> nil) and (uffBackgroundColor in cell^.UsedFormattingFields) then Result := cell^.BackgroundColor; end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the background color of a cell range defined by a rectangle. The color is given as an index into the workbook's color palette. If the colors are different from cell to cell the value scUndefined is returned. @@ -1967,7 +2012,7 @@ end; right/bottom corner. @return Color index common to all cells within the selection. If the cells' background colors are different the value scUndefined is returned. -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetBackgroundColors(ARect: TGridRect): TsColor; var c, r: Integer; @@ -1976,42 +2021,45 @@ begin Result := GetBackgroundColor(ARect.Left, ARect.Top); clr := Result; for c := ARect.Left to ARect.Right do - for r := ARect.Top to ARect.Bottom do begin + for r := ARect.Top to ARect.Bottom do + begin Result := GetBackgroundColor(c, r); - if Result <> clr then begin + if Result <> clr then + begin Result := scNotDefined; exit; end; end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the cell borders which are drawn around a given cell. @param ACol Grid column index of the cell @param ARow Grid row index of the cell @return Set with flags indicating where borders are drawn (top/left/right/bottom) -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellBorder(ACol, ARow: Integer): TsCellBorders; var cell: PCell; begin Result := []; - if Assigned(FWorksheet) then begin + if Assigned(FWorksheet) then + begin cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); if (cell <> nil) and (uffBorder in cell^.UsedFormattingFields) then Result := cell^.Border; end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the cell borders which are drawn around a given rectangular cell range. @param ARect Rectangle defining the range of cell. @return Set with flags indicating where borders are drawn (top/left/right/bottom) If the individual cells within the range have different borders an empty set is returned. -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellBorders(ARect: TGridRect): TsCellBorders; var c, r: Integer; @@ -2020,16 +2068,18 @@ begin Result := GetCellBorder(ARect.Left, ARect.Top); b := Result; for c := ARect.Left to ARect.Right do - for r := ARect.Top to ARect.Bottom do begin + for r := ARect.Top to ARect.Bottom do + begin Result := GetCellBorder(c, r); - if Result <> b then begin + if Result <> b then + begin Result := []; exit; end; end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the style of the cell border line drawn along the edge specified by the parameter ABorder of a cell. The style is defined by line style and line color. @@ -2040,21 +2090,22 @@ end; (see TsCellBorder) @return CellBorderStyle record containing information on line style and line color. -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder): TsCellBorderStyle; var cell: PCell; begin Result := DEFAULT_BORDERSTYLES[ABorder]; - if Assigned(FWorksheet) then begin + if Assigned(FWorksheet) then + begin cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); if (cell <> nil) then Result := cell^.BorderStyles[ABorder]; end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the style of the cell border line drawn along the edge specified by the parameter ABorder of a range of cells defined by the rectangle of column and row indexes. The style is defined by linestyle and line color. @@ -2065,7 +2116,7 @@ end; (see TsCellBorder) @return CellBorderStyle record containing information on line style and line color. -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellBorderStyles(ARect: TGridRect; ABorder: TsCellBorder): TsCellBorderStyle; var @@ -2075,31 +2126,35 @@ begin Result := GetCellBorderStyle(ARect.Left, ARect.Top, ABorder); bs := Result; for c := ARect.Left to ARect.Right do - for r := ARect.Top to ARect.Bottom do begin + for r := ARect.Top to ARect.Bottom do + begin Result := GetCellBorderStyle(c, r, ABorder); - if (Result.LineStyle <> bs.LineStyle) or (Result.Color <> bs.Color) then begin + if (Result.LineStyle <> bs.LineStyle) or (Result.Color <> bs.Color) then + begin Result := DEFAULT_BORDERSTYLES[ABorder]; exit; end; end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the font to be used when painting text in a cell. @param ACol Grid column index of the cell @param ARow Grid row index of the cell @return Font usable when painting on a canvas. -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellFont(ACol, ARow: Integer): TFont; var cell: PCell; fnt: TsFont; begin Result := nil; - if (FWorkbook <> nil) and (FWorksheet <> nil) then begin + if (FWorkbook <> nil) and (FWorksheet <> nil) then + begin cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); - if (cell <> nil) then begin + if (cell <> nil) then + begin fnt := FWorkbook.GetFont(cell^.FontIndex); Convert_sFont_to_Font(fnt, FCellFont); Result := FCellFont; @@ -2107,14 +2162,14 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Returns the font to be used when painting text in the cells defined by the rectangle of row/column indexes. @param ARect Rectangle whose edges define the limits of the grid row and column indexes of the cells. @return Font usable when painting on a canvas. -} +-------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellFonts(ARect: TGridRect): TFont; var c, r: Integer; @@ -2124,13 +2179,16 @@ begin Result := GetCellFont(ARect.Left, ARect.Top); sDefFont := FWorkbook.GetFont(0); // Default font for c := ARect.Left to ARect.Right do - for r := ARect.Top to ARect.Bottom do begin + for r := ARect.Top to ARect.Bottom do + begin cell := FWorksheet.FindCell(GetWorksheetRow(r), GetWorksheetCol(c)); - if cell <> nil then begin + if cell <> nil then + begin sFont := FWorkbook.GetFont(cell^.FontIndex); if (sFont.FontName <> sDefFont.FontName) and (sFont.Size <> sDefFont.Size) and (sFont.Style <> sDefFont.Style) and (sFont.Color <> sDefFont.Color) - then begin + then + begin Convert_sFont_to_Font(sDefFont, FCellFont); Result := FCellFont; exit; @@ -2139,6 +2197,922 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Returns the height (in pixels) of the cell at ACol/ARow (of the grid). + + @param ACol Grid column index of the cell + @param ARow Grid row index of the cell + @result Height of the cell in pixels. Wrapped text is handled correctly. +-------------------------------------------------------------------------------} +function TsCustomWorksheetGrid.GetCellHeight(ACol, ARow: Integer): Integer; +var + lCell: PCell; + s: String; + wrapped: Boolean; + txtR: TRect; + cellR: TRect; + flags: Cardinal; + r1,c1,r2,c2: Cardinal; +begin + Result := 0; + if ShowHeaders and ((ACol = 0) or (ARow = 0)) then + exit; + if FWorksheet = nil then + exit; + + lCell := FWorksheet.FindCell(ARow-FHeaderCount, ACol-FHeaderCount); + if lCell <> nil then + begin + //if lCell^.MergedNeighbors <> [] then begin + if (lCell^.Mergebase <> nil) then + begin + FWorksheet.FindMergedRange(lCell, r1, c1, r2, c2); + if r1 <> r2 then + // If the merged range encloses several rows we skip automatic row height + // determination since only the height of the first row of the block + // (containing the merge base cell) would change which is very confusing. + exit; + end; + s := GetCellText(ACol, ARow); + if s = '' then + exit; + DoPrepareCanvas(ACol, ARow, []); + wrapped := (uffWordWrap in lCell^.UsedFormattingFields) + or (lCell^.TextRotation = rtStacked); + // *** multi-line text *** + if wrapped then + begin + // horizontal + if ( (uffTextRotation in lCell^.UsedFormattingFields) and + (lCell^.TextRotation in [trHorizontal, rtStacked])) + or not (uffTextRotation in lCell^.UsedFormattingFields) + then + begin + cellR := CellRect(ACol, ARow); + InflateRect(cellR, -constCellPadding, -constCellPadding); + txtR := Bounds(cellR.Left, cellR.Top, cellR.Right-cellR.Left, cellR.Bottom-cellR.Top); + flags := DT_WORDBREAK and not DT_SINGLELINE; + LCLIntf.DrawText(Canvas.Handle, PChar(s), Length(s), txtR, + DT_CALCRECT or flags); + Result := txtR.Bottom - txtR.Top + 2*constCellPadding; + end; + // rotated wrapped text: + // do not consider this because wrapping affects cell height. + end else + // *** single-line text *** + begin + // not rotated + if ( not (uffTextRotation in lCell^.UsedFormattingFields) or + (lCell^.TextRotation = trHorizontal) ) + then + Result := Canvas.TextHeight(s) + 2*constCellPadding + else + // rotated by +/- 90° + if (uffTextRotation in lCell^.UsedFormattingFields) and + (lCell^.TextRotation in [rt90DegreeClockwiseRotation, rt90DegreeCounterClockwiseRotation]) + then + Result := Canvas.TextWidth(s) + 2*constCellPadding; + end; + end; +end; + +{@@ ---------------------------------------------------------------------------- + This function returns the text to be shown in a grid cell. The text is looked + up in the corresponding cell of the worksheet by calling its ReadAsUTF8Text + method. In case of "stacked" text rotation, line endings are inserted after + each character. + + @param ACol Grid column index of the cell + @param ARow Grid row index of the cell + @return Text to be displayed in the cell. +-------------------------------------------------------------------------------} +function TsCustomWorksheetGrid.GetCellText(ACol, ARow: Integer): String; +var + lCell: PCell; + r, c, i: Integer; + s: String; +begin + Result := ''; + + if ShowHeaders then + begin + // Headers + if (ARow = 0) and (ACol = 0) then + exit; + if (ARow = 0) then + begin + Result := GetColString(ACol-FHeaderCount); + exit; + end + else + if (ACol = 0) then + begin + Result := IntToStr(ARow); + exit; + end; + end; + + if FWorksheet <> nil then + begin + r := ARow - FHeaderCount; + c := ACol - FHeaderCount; + lCell := FWorksheet.FindCell(r, c); + if lCell <> nil then + begin + Result := FWorksheet.ReadAsUTF8Text(lCell); + if lCell^.TextRotation = rtStacked then + begin + s := Result; + Result := ''; + for i:=1 to Length(s) do + begin + Result := Result + s[i]; + if i < Length(s) then Result := Result + LineEnding; + end; + end; + end; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Determines the text to be passed to the cell editor. The text is determined + from the underlying worksheet cell, but it is possible to intercept this by + adding a handler for the OnGetEditText event. + + @param ACol Grid column index of the cell being edited + @param ARow Grid row index of the grid cell being edited + @return Text to be passed to the cell editor. +-------------------------------------------------------------------------------} +function TsCustomWorksheetGrid.GetEditText(aCol, aRow: Integer): string; +begin + Result := GetCellText(aCol, aRow); + if Assigned(OnGetEditText) then OnGetEditText(Self, aCol, aRow, result); +end; + +{@@ ---------------------------------------------------------------------------- + Determines the style of the border between a cell and its neighbor given by + ADeltaCol and ADeltaRow (one of them must be 0, the other one can only be +/-1). + ACol and ARow are in grid units. + Result is FALSE if there is no border line. +-------------------------------------------------------------------------------} +function TsCustomWorksheetGrid.GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer; + out ABorderStyle: TsCellBorderStyle): Boolean; +var + cell, neighborcell: PCell; + border, neighborborder: TsCellBorder; + r, c: Cardinal; +begin + Result := true; + if (ADeltaCol = -1) and (ADeltaRow = 0) then + begin + border := cbWest; + neighborborder := cbEast; + end else + if (ADeltaCol = +1) and (ADeltaRow = 0) then + begin + border := cbEast; + neighborborder := cbWest; + end else + if (ADeltaCol = 0) and (ADeltaRow = -1) then + begin + border := cbNorth; + neighborborder := cbSouth; + end else + if (ADeltaCol = 0) and (ADeltaRow = +1) then + begin + border := cbSouth; + neighborBorder := cbNorth; + end else + raise Exception.Create('[TsCustomWorksheetGrid] Incorrect col/row for GetBorderStyle.'); + + r := GetWorksheetRow(ARow); + c := GetWorksheetCol(ACol); + cell := FWorksheet.FindCell(r, c); + if (ARow - FHeaderCount + ADeltaRow < 0) or (ACol - FHeaderCount + ADeltaCol < 0) then + neighborcell := nil + else + neighborcell := FWorksheet.FindCell(ARow - FHeaderCount + ADeltaRow, ACol - FHeaderCount + ADeltaCol); + + // Only cell has border, but neighbor has not + if HasBorder(cell, border) and not HasBorder(neighborCell, neighborBorder) then + begin + if FWorksheet.IsMerged(cell) and FWorksheet.IsMerged(neighborcell) and + (cell^.MergeBase = neighborcell^.Mergebase) + then + result := false + else + ABorderStyle := cell^.BorderStyles[border] + end + else + // Only neighbor has border, cell has not + if not HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then + begin + if FWorksheet.IsMerged(cell) and FWorksheet.IsMerged(neighborcell) and + (cell^.MergeBase = neighborcell^.Mergebase) + then + result := false + else + ABorderStyle := neighborcell^.BorderStyles[neighborborder] + end + else + // Both cells have shared border -> use top or left border + if HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then + begin + if FWorksheet.IsMerged(cell) and FWorksheet.IsMerged(neighborcell) and + (cell^.MergeBase = neighborcell^.Mergebase) + then + result := false + else + if (border in [cbNorth, cbWest]) then + ABorderStyle := neighborcell^.BorderStyles[neighborborder] + else + ABorderStyle := cell^.BorderStyles[border]; + end else + Result := false; +end; + +{@@ ---------------------------------------------------------------------------- + Converts a column index of the worksheet to a column index usable in the grid. + This is required because worksheet indexes always start at zero while + grid indexes also have to account for the column/row headers. + + @param ASheetCol Worksheet column index + @return Grid column index +-------------------------------------------------------------------------------} +function TsCustomWorksheetGrid.GetGridCol(ASheetCol: Cardinal): Integer; +begin + Result := Integer(ASheetCol) + FHeaderCount +end; + +{@@ ---------------------------------------------------------------------------- + Converts a row index of the worksheet to a row index usable in the grid. + This is required because worksheet indexes always start at zero while + grid indexes also have to account for the column/row headers. + + @param ASheetRow Worksheet row index + @return Grid row index +-------------------------------------------------------------------------------} +function TsCustomWorksheetGrid.GetGridRow(ASheetRow: Cardinal): Integer; +begin + Result := Integer(ASheetRow) + FHeaderCount; +end; + +{@@ ---------------------------------------------------------------------------- + Returns a list of worksheets contained in the file. Useful for assigning to + user controls like TabControl, Combobox etc. in order to select a sheet. + + @param ASheets List of strings containing the names of the worksheets of + the workbook +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.GetSheets(const ASheets: TStrings); +var + i: Integer; +begin + ASheets.Clear; + if Assigned(FWorkbook) then + for i:=0 to FWorkbook.GetWorksheetCount-1 do + ASheets.Add(FWorkbook.GetWorksheetByIndex(i).Name); +end; + +{@@ ---------------------------------------------------------------------------- + Calculates the index of the worksheet column that is displayed in the + given column of the grid. If the sheet headers are turned on, both numbers + differ by 1, otherwise they are equal. Saves an "if" in cases. + + @param AGridCol Index of a grid column + @return Index of a the corresponding worksheet column +-------------------------------------------------------------------------------} +function TsCustomWorksheetGrid.GetWorksheetCol(AGridCol: Integer): cardinal; +begin + if (FHeaderCount > 0) and (AGridCol = 0) then + Result := Cardinal(-1) + else + Result := AGridCol - FHeaderCount; +end; + +{@@ ---------------------------------------------------------------------------- + Calculates the index of the worksheet row that is displayed in the + given row of the grid. If the sheet headers are turned on, both numbers + differ by 1, otherwise they are equal. Saves an "if" in some cases. + + @param AGridRow Index of a grid row + @resturn Index of the corresponding worksheet row. +-------------------------------------------------------------------------------} +function TsCustomWorksheetGrid.GetWorksheetRow(AGridRow: Integer): Cardinal; +begin + if (FHeaderCount > 0) and (AGridRow = 0) then + Result := Cardinal(-1) + else + Result := AGridRow - FHeaderCount; +end; + +{@@ ---------------------------------------------------------------------------- + Returns true if the cell has the given border. + + @param ACell Pointer to cell considered + @param ABorder Indicator for border to be checked for visibility +-------------------------------------------------------------------------------} +function TsCustomWorksheetGrid.HasBorder(ACell: PCell; ABorder: TsCellBorder): Boolean; +begin + Result := (ACell <> nil) and (uffBorder in ACell^.UsedFormattingfields) and + (ABorder in ACell^.Border); +end; + +{@@ ---------------------------------------------------------------------------- + Inherited from TCustomGrid. Is called when column widths or row heights + have changed. Stores the new column width or row height in the worksheet. + + @param IsColumn Specifies whether the changed parameter is a column width + (true) or a row height (false) + @param Index Index of the changed column or row +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.HeaderSized(IsColumn: Boolean; index: Integer); +var + w0: Integer; + h, h_pts: Single; +begin + if FWorksheet = nil then + exit; + + Convert_sFont_to_Font(FWorkbook.GetFont(0), Canvas.Font); + if IsColumn then begin + // The grid's column width is in "pixels", the worksheet's column width is + // in "characters". + w0 := Canvas.TextWidth('0'); + FWorksheet.WriteColWidth(GetWorksheetCol(Index), ColWidths[Index] div w0); + end else begin + // The grid's row heights are in "pixels", the worksheet's row heights are + // in "lines" + h_pts := PxToPts(RowHeights[Index] - 4, Screen.PixelsPerInch); // in points + h := h_pts / (FWorkbook.GetFont(0).Size + ROW_HEIGHT_CORRECTION); + FWorksheet.WriteRowHeight(GetWorksheetRow(Index), h); + end; +end; + +{@@ ---------------------------------------------------------------------------- + Inserts an empty column before the column specified +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.InsertCol(AGridCol: Integer); +var + c: Cardinal; +begin + if AGridCol < FHeaderCount then + exit; + + if FWorksheet.GetLastColIndex + 1 + FHeaderCount >= FInitColCount then + ColCount := ColCount + 1; + c := AGridCol - FHeaderCount; + FWorksheet.InsertCol(c); + + UpdateColWidths(AGridCol); +end; + +{@@ ---------------------------------------------------------------------------- + Inserts an empty row before the row specified +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.InsertRow(AGridRow: Integer); +var + r: Cardinal; +begin + if AGridRow < FHeaderCount then + exit; + + if FWorksheet.GetlastRowIndex+1 + FHeaderCount >= FInitRowCount then + RowCount := RowCount + 1; + r := AGridRow - FHeaderCount; + FWorksheet.InsertRow(r); + + UpdateRowHeights(AGridRow); +end; + +{@@ ---------------------------------------------------------------------------- + Internal general text drawing method. + + @param AText Text to be drawn + @param AMeasureText Text used for checking if the text fits into the + text rectangle. If too large and ReplaceTooLong = true, + a series of # is drawn. + @param ARect Rectangle in which the text is drawn + @param AJustification Determines whether the text is drawn at the "start" (0), + "center" (1) or "end" (2) of the drawing rectangle. + Start/center/end are seen along the text drawing + direction. + @param ACellHorAlign Is the HorAlignment property stored in the cell + @param ACellVertAlign Is the VertAlignment property stored in the cell + @param ATextRot Determines the rotation angle of the text. + @param ATextWrap Determines if the text can wrap into multiple lines + @param ReplaceTooLang If true too-long texts are replaced by a series of + # chars filling the cell. + + @Note The reason to separate AJustification from ACellHorAlign and ACelVertAlign is + the output of nfAccounting formatted numbers where the numbers are always + right-aligned, and the currency symbol is left-aligned. + THIS FEATURE IS CURRENTLY NO LONGER SUPPORTED. +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.InternalDrawTextInCell(AText, AMeasureText: String; + ARect: TRect; AJustification: Byte; ACellHorAlign: TsHorAlignment; + ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation; + ATextWrap, ReplaceTooLong: Boolean); +var + ts: TTextStyle; + flags: Cardinal; + txt: String; + txtRect: TRect; + P: TPoint; + w, h, h0, hline: Integer; + i: Integer; + L: TStrings; + wrapped: Boolean; + pLeft, pRight: Integer; +begin + wrapped := ATextWrap or (ATextRot = rtStacked); + if AMeasureText = '' then txt := AText else txt := AMeasureText; + flags := DT_WORDBREAK and not DT_SINGLELINE or DT_CALCRECT; + txtRect := ARect; + + if (ATextRot in [trHorizontal, rtStacked]) then begin + // HORIZONAL TEXT DRAWING DIRECTION + Canvas.Font.Orientation := 0; + ts := Canvas.TextStyle; + ts.Opaque := false; + if wrapped then begin + ts.Wordbreak := true; + ts.SingleLine := false; + LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags); + w := txtRect.Right - txtRect.Left; + h := txtRect.Bottom - txtRect.Top; + end else begin + ts.WordBreak := false; + ts.SingleLine := false; + w := Canvas.TextWidth(AMeasureText); + h := Canvas.TextHeight('Tg'); + end; + + if ATextRot = rtStacked then begin + // Stacked + ts.Alignment := HOR_ALIGNMENTS[ACellHorAlign]; + if h > ARect.Bottom - ARect.Top then begin + if ReplaceTooLong then begin + txt := '#'; + repeat + txt := txt + '#'; + LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags); + until txtRect.Bottom - txtRect.Top > ARect.Bottom - ARect.Top; + AText := copy(txt, 1, Length(txt)-1); + end; + ts.Layout := tlTop; + end else + case AJustification of + 0: ts.Layout := tlTop; + 1: ts.Layout := tlCenter; + 2: ts.Layout := tlBottom; + end; + Canvas.TextStyle := ts; + Canvas.TextRect(ARect, ARect.Left, ARect.Top, AText); + end else begin + // Horizontal + if h > ARect.Bottom - ARect.Top then + ts.Layout := tlTop + else + ts.Layout := VERT_ALIGNMENTS[ACellVertAlign]; + + // too long text + if w > ARect.Right - ARect.Left then + if ReplaceTooLong then + begin + txt := ''; + repeat + txt := txt + '#'; + LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags); + until txtRect.Right - txtRect.Left > ARect.Right - ARect.Left; + AText := Copy(txt, 1, Length(txt)-1); + w := Canvas.TextWidth(AText); + end; + + P := ARect.TopLeft; + case AJustification of + 0: ts.Alignment := taLeftJustify; + 1: if (FDrawingCell <> nil) and (FDrawingCell^.MergeBase = nil) then //(FDrawingCell^.MergedNeighbors = []) then + begin + // Special treatment for overflowing cells: they must be centered + // at their original column, not in the total enclosing rectangle. + ColRowToOffset(true, true, FDrawingCell^.Col + FHeaderCount, pLeft, pRight); + P.X := (pLeft + pRight - w) div 2; + P.y := ARect.Top; + ts.Alignment := taLeftJustify; + end + else + ts.Alignment := taCenter; + 2: ts.Alignment := taRightJustify; + end; + Canvas.TextStyle := ts; + Canvas.TextRect(ARect, P.X, P.Y, AText); + end; + end + else + begin + // ROTATED TEXT DRAWING DIRECTION + // Since there is no good API for multiline rotated text, we draw the text + // line by line. + L := TStringList.Create; + try + txtRect := Bounds(ARect.Left, ARect.Top, ARect.Bottom - ARect.Top, ARect.Right - ARect.Left); + hline := Canvas.TextHeight('Tg'); + if wrapped then begin + // Extract wrapped lines + L.Text := WrapText(Canvas, txt, txtRect.Right - txtRect.Left); + // Calculate size of wrapped text + flags := DT_WORDBREAK and not DT_SINGLELINE or DT_CALCRECT; + LCLIntf.DrawText(Canvas.Handle, PChar(L.Text), Length(L.Text), txtRect, flags); + w := txtRect.Right - txtRect.Left; + h := txtRect.Bottom - txtRect.Top; + h0 := hline; + end + else begin + L.Text := txt; + w := Canvas.TextWidth(txt); + h := hline; + h0 := 0; + end; + // w and h are seen along the text direction, not x/y! + + if w > ARect.Bottom - ARect.Top then begin + if ReplaceTooLong then begin + txt := '#'; + repeat + txt := txt + '#'; + until Canvas.TextWidth(txt) > ARect.Bottom - ARect.Top; + L.Text := Copy(txt, 1, Length(txt)-1); + end; + end; + + ts := Canvas.TextStyle; + ts.SingleLine := true; // Draw text line by line + ts.Clipping := false; + ts.Layout := tlTop; + ts.Alignment := taLeftJustify; + ts.Opaque := false; + + if ATextRot = rt90DegreeClockwiseRotation then begin + // Clockwise + Canvas.Font.Orientation := -900; + case ACellHorAlign of + haLeft : P.X := Min(ARect.Right-1, ARect.Left + h - h0); + haCenter : P.X := Min(ARect.Right-1, (ARect.Left + ARect.Right + h) div 2); + haRight : P.X := ARect.Right - 1; + end; + for i:= 0 to L.Count-1 do begin + w := Canvas.TextWidth(L[i]); + case AJustification of + 0: P.Y := ARect.Top; // corresponds to "top" + 1: P.Y := Max(ARect.Top, (Arect.Top + ARect.Bottom - w) div 2); // "center" + 2: P.Y := Max(ARect.Top, ARect.Bottom - w); // "bottom" + end; + Canvas.TextRect(ARect, P.X, P.Y, L[i], ts); + dec(P.X, hline); + end + end + else begin + // Counter-clockwise + Canvas.Font.Orientation := +900; + case ACellHorAlign of + haLeft : P.X := ARect.Left; + haCenter : P.X := Max(ARect.Left, (ARect.Left + ARect.Right - h + h0) div 2); + haRight : P.X := MAx(ARect.Left, ARect.Right - h + h0); + end; + for i:= 0 to L.Count-1 do begin + w := Canvas.TextWidth(L[i]); + case AJustification of + 0: P.Y := ARect.Bottom; // like "Bottom" + 1: P.Y := Min(ARect.Bottom, (ARect.Top + ARect.Bottom + w) div 2); // "Center" + 2: P.Y := Min(ARect.Bottom, ARect.Top + w); // like "top" + end; + Canvas.TextRect(ARect, P.X, P.Y, L[i], ts); + inc(P.X, hline); + end; + end; + finally + L.Free; + end; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Standard key handling method inherited from TCustomGrid. Is overridden to + catch the ESC key during editing in order to restore the old cell text + + @param Key Key which has been pressed + @param Shift Additional shift keys which are pressed +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.KeyDown(var Key : Word; Shift : TShiftState); +begin + if (Key = VK_ESCAPE) and FEditing then begin + SetEditText(Col, Row, FOldEditText); + EditorHide; + exit; + end; + inherited; +end; + +{@@ ---------------------------------------------------------------------------- + Standard method inherited from TCustomGrid. Is overridden to create an + empty workbook +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.Loaded; +begin + inherited; + NewWorkbook(FInitColCount, FInitRowCount); +end; + +{@@ ---------------------------------------------------------------------------- + Loads the worksheet into the grid and displays its contents. + + @param AWorksheet Worksheet to be displayed in the grid +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.LoadFromWorksheet(AWorksheet: TsWorksheet); +begin + FWorksheet := AWorksheet; + if FWorksheet <> nil then begin + FWorksheet.OnChangeCell := @ChangedCellHandler; + FWorksheet.OnChangeFont := @ChangedFontHandler; + ShowHeaders := (soShowHeaders in FWorksheet.Options); + ShowGridLines := (soShowGridLines in FWorksheet.Options); + if (soHasFrozenPanes in FWorksheet.Options) then begin + FrozenCols := FWorksheet.LeftPaneWidth; + FrozenRows := FWorksheet.TopPaneHeight; + end else begin + FrozenCols := 0; + FrozenRows := 0; + end; + Row := FrozenRows; + Col := FrozenCols; + end; + Setup; +end; + +{@@ ---------------------------------------------------------------------------- + Creates a new workbook and loads the given file into it. The file is assumed + to have the given file format. Shows the sheet with the given sheet index. + + @param AFileName Name of the file to be loaded + @param AFormat Spreadsheet file format assumed for the file + @param AWorksheetIndex Index of the worksheet to be displayed in the grid +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string; + AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer); +begin + BeginUpdate; + try + CreateNewWorkbook; + FWorkbook.ReadFromFile(AFileName, AFormat); + LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex)); + finally + EndUpdate; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Creates a new workbook and loads the given file into it. The file format + is determined automatically. Shows the sheet with the given sheet index. + + @param AFileName Name of the file to be loaded + @param AWorksheetIndex Index of the worksheet to be shown in the grid +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string; + AWorksheetIndex: Integer); +begin + BeginUpdate; + try + CreateNewWorkbook; + FWorkbook.ReadFromFile(AFilename); + LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex)); + finally + EndUpdate; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Merges the selected cells to a single large cell + Only the upper left cell can have content and formatting (which is extended + into the other cells). +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.MergeCells; +begin + FWorksheet.MergeCells( + GetWorksheetRow(Selection.Top), + GetWorksheetCol(Selection.Left), + GetWorksheetRow(Selection.Bottom), + GetWorksheetCol(Selection.Right) + ); +end; + +{@@ ---------------------------------------------------------------------------- + Standard method inherited from TCustomGrid. + Repaints the grid after moving selection to avoid spurious rests of the + old thick selection border. +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.MoveSelection; +begin + //Refresh; + inherited; + Refresh; +end; + +{@@ ---------------------------------------------------------------------------- + Creates a new empty workbook with the specified number of columns and rows. + + @param AColCount Number of columns + @param ARowCount Number of rows +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.NewWorkbook(AColCount, ARowCount: Integer); +begin + BeginUpdate; + try + CreateNewWorkbook; + FWorksheet := FWorkbook.AddWorksheet('Sheet1'); + FWorksheet.OnChangeCell := @ChangedCellHandler; + FWorksheet.OnChangeFont := @ChangedFontHandler; + FInitColCount := AColCount; + FInitRowCount := ARowCount; + Setup; + finally + EndUpdate; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Splits a merged cell block into single cells +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.UnmergeCells; +begin + FWorksheet.UnmergeCells( + GetWorksheetRow(Selection.Top), + GetWorksheetCol(Selection.Left) + ); +end; + +{@@ ---------------------------------------------------------------------------- + Writes the workbook represented by the grid to a spreadsheet file. + + @param AFileName Name of the file to which the workbook is to be + saved. + @param AFormat Spreadsheet file format in which the file is to be + saved. + @param AOverwriteExisting If the file already exists, it is overwritten in + the case of AOverwriteExisting = true, or an + exception is raised if AOverwriteExisting = false +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.SaveToSpreadsheetFile(AFileName: String; + AFormat: TsSpreadsheetFormat; AOverwriteExisting: Boolean = true); +begin + if FWorkbook <> nil then + FWorkbook.WriteToFile(AFileName, AFormat, AOverwriteExisting); +end; + +{@@ ---------------------------------------------------------------------------- + Saves the workbook into a file with the specified file name. If this file + name already exists the file is overwritten if AOverwriteExisting is true. + + @param AFileName Name of the file to which the workbook is to be + saved + If the file format is not known is is written + as BIFF8/XLS. + @param AOverwriteExisting If this file already exists it is overwritten if + AOverwriteExisting = true, or an exception is + raised if AOverwriteExisting = false. +} +procedure TsCustomWorksheetGrid.SaveToSpreadsheetFile(AFileName: String; + AOverwriteExisting: Boolean = true); +begin + if FWorkbook <> nil then + FWorkbook.WriteToFile(AFileName, AOverwriteExisting); +end; + +{@@ ---------------------------------------------------------------------------- + Standard method inherited from TCustomGrid: Is called when editing starts. + Is overridden here to store the old text just in case that the user presses + ESC to cancel editing. +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.SelectEditor; +begin + FOldEditText := GetCellText(Col, Row); + inherited; +end; + +{@@ ---------------------------------------------------------------------------- + Loads the workbook into the grid and selects the sheet with the given index. + "Selected" means here that the sheet is loaded into the grid. + + @param AIndex Index of the worksheet to be shown in the grid +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.SelectSheetByIndex(AIndex: Integer); +begin + if FWorkbook <> nil then + LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AIndex)); +end; + +{@@ ---------------------------------------------------------------------------- + Standard method inherited from TCustomGrid. Fetches the text that is + currently in the editor. It is not yet transferred to the worksheet because + input will be checked only at the end of editing. + + @param ACol Grid column index of the cell being edited + @param ARow Grid row index of the cell being edited + @param AValue String which is currently in the cell editor +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.SetEditText(ACol, ARow: Longint; const AValue: string); +begin + FEditText := AValue; + FEditing := true; + inherited SetEditText(aCol, aRow, aValue); +end; + +{@@ ---------------------------------------------------------------------------- + Helper method for setting up the rows and columns after a new workbook is + loaded or created. Sets up the grid's column and row count, as well as the + initial column widths and row heights. +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.Setup; +begin + if (FWorksheet = nil) or (FWorksheet.GetCellCount = 0) then begin + if ShowHeaders then begin + ColCount := FInitColCount + 1; //2; + RowCount := FInitRowCount + 1; //2; + FixedCols := 1; + FixedRows := 1; + ColWidths[0] := Canvas.TextWidth(' 999999 '); + end else begin + FixedCols := 0; + FixedRows := 0; + ColCount := FInitColCount; //0; + RowCount := FInitRowCount; //0; + end; + end else + if FWorksheet <> nil then begin + ColCount := Max(FWorksheet.GetLastColIndex + 1 + FHeaderCount, FInitColCount); + RowCount := Max(FWorksheet.GetLastRowIndex + 1 + FHeaderCount, FInitRowCount); + FixedCols := FFrozenCols + FHeaderCount; + FixedRows := FFrozenRows + FHeaderCount; + if ShowHeaders then begin + ColWidths[0] := Canvas.TextWidth(' 999999 '); + RowHeights[0] := DefaultRowHeight; + end; + end; + UpdateColWidths; + UpdateRowHeights; + Invalidate; +end; + +{@@ ---------------------------------------------------------------------------- + Updates column widths according to the data in the TCol records +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.UpdateColWidths(AStartIndex: Integer = 0); +var + i: Integer; + lCol: PCol; + w: Integer; +begin + if AStartIndex = 0 then AStartIndex := FHeaderCount; + for i := AStartIndex to ColCount-1 do begin + w := DefaultColWidth; + if FWorksheet <> nil then + begin + lCol := FWorksheet.FindCol(i - FHeaderCount); + if lCol <> nil then + w := CalcColWidth(lCol^.Width) + end; + ColWidths[i] := w; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Updates row heights by using the data from the TRow records or by auto- + calculating the row height from the max of the cell heights +-------------------------------------------------------------------------------} +procedure TsCustomWorksheetGrid.UpdateRowHeights(AStartIndex: Integer = 0); +var + i: Integer; + lRow: PRow; + h: Integer; +begin + if AStartIndex <= 0 then AStartIndex := FHeaderCount; + for i := AStartIndex to RowCount-1 do begin + h := CalcAutoRowHeight(i); + if FWorksheet <> nil then + begin + lRow := FWorksheet.FindRow(i - FHeaderCount); + if (lRow <> nil) then + h := CalcRowHeight(lRow^.Height); + end; + RowHeights[i] := h; + end; +end; + + +{******************************************************************************* +* Setter / getter methods * +*******************************************************************************} + function TsCustomWorksheetGrid.GetCellFontColor(ACol, ARow: Integer): TsColor; var cell: PCell; @@ -2271,251 +3245,6 @@ begin end; end; -{@@ - Returns the height (in pixels) of the cell at ACol/ARow (of the grid). - - @param ACol Grid column index of the cell - @param ARow Grid row index of the cell - @result Height of the cell in pixels. Wrapped text is handled correctly. -} -function TsCustomWorksheetGrid.GetCellHeight(ACol, ARow: Integer): Integer; -var - lCell: PCell; - s: String; - wrapped: Boolean; - txtR: TRect; - cellR: TRect; - flags: Cardinal; - r1,c1,r2,c2: Cardinal; -begin - Result := 0; - if ShowHeaders and ((ACol = 0) or (ARow = 0)) then - exit; - if FWorksheet = nil then - exit; - - lCell := FWorksheet.FindCell(ARow-FHeaderCount, ACol-FHeaderCount); - if lCell <> nil then begin - //if lCell^.MergedNeighbors <> [] then begin - if (lCell^.Mergebase <> nil) then - begin - FWorksheet.FindMergedRange(lCell, r1, c1, r2, c2); - if r1 <> r2 then - // If the merged range encloses several rows we skip automatic row height - // determination since only the height of the first row of the block - // (containing the merge base cell) would change which is very confusing. - exit; - end; - s := GetCellText(ACol, ARow); - if s = '' then - exit; - DoPrepareCanvas(ACol, ARow, []); - wrapped := (uffWordWrap in lCell^.UsedFormattingFields) - or (lCell^.TextRotation = rtStacked); - // *** multi-line text *** - if wrapped then begin - // horizontal - if ( (uffTextRotation in lCell^.UsedFormattingFields) and - (lCell^.TextRotation in [trHorizontal, rtStacked])) - or not (uffTextRotation in lCell^.UsedFormattingFields) - then begin - cellR := CellRect(ACol, ARow); - InflateRect(cellR, -constCellPadding, -constCellPadding); - txtR := Bounds(cellR.Left, cellR.Top, cellR.Right-cellR.Left, cellR.Bottom-cellR.Top); - flags := DT_WORDBREAK and not DT_SINGLELINE; - LCLIntf.DrawText(Canvas.Handle, PChar(s), Length(s), txtR, - DT_CALCRECT or flags); - Result := txtR.Bottom - txtR.Top + 2*constCellPadding; - end; - // rotated wrapped text: - // do not consider this because wrapping affects cell height. - end else - // *** single-line text *** - begin - // not rotated - if ( not (uffTextRotation in lCell^.UsedFormattingFields) or - (lCell^.TextRotation = trHorizontal) ) - then - Result := Canvas.TextHeight(s) + 2*constCellPadding - else - // rotated by +/- 90° - if (uffTextRotation in lCell^.UsedFormattingFields) and - (lCell^.TextRotation in [rt90DegreeClockwiseRotation, rt90DegreeCounterClockwiseRotation]) - then - Result := Canvas.TextWidth(s) + 2*constCellPadding; - end; - end; -end; - -{@@ - This function returns the text to be shown in a grid cell. The text is looked - up in the corresponding cell of the worksheet by calling its ReadAsUTF8Text - method. In case of "stacked" text rotation, line endings are inserted after - each character. - - @param ACol Grid column index of the cell - @param ARow Grid row index of the cell - @return Text to be displayed in the cell. -} -function TsCustomWorksheetGrid.GetCellText(ACol, ARow: Integer): String; -var - lCell: PCell; - r, c, i: Integer; - s: String; -begin - Result := ''; - - if ShowHeaders then begin - // Headers - if (ARow = 0) and (ACol = 0) then - exit; - if (ARow = 0) then begin - Result := GetColString(ACol-FHeaderCount); - exit; - end - else - if (ACol = 0) then begin - Result := IntToStr(ARow); - exit; - end; - end; - - if FWorksheet <> nil then begin - r := ARow - FHeaderCount; - c := ACol - FHeaderCount; - lCell := FWorksheet.FindCell(r, c); - if lCell <> nil then begin - Result := FWorksheet.ReadAsUTF8Text(lCell); - if lCell^.TextRotation = rtStacked then begin - s := Result; - Result := ''; - for i:=1 to Length(s) do begin - Result := Result + s[i]; - if i < Length(s) then Result := Result + LineEnding; - end; - end; - end; - end; -end; - -{@@ - Determines the text to be passed to the cell editor. The text is determined - from the underlying worksheet cell, but it is possible to intercept this by - adding a handler for the OnGetEditText event. - - @param ACol Grid column index of the cell being edited - @param ARow Grid row index of the grid cell being edited - @return Text to be passed to the cell editor. -} -function TsCustomWorksheetGrid.GetEditText(aCol, aRow: Integer): string; -begin - Result := GetCellText(aCol, aRow); - if Assigned(OnGetEditText) then OnGetEditText(Self, aCol, aRow, result); -end; - -{ Determines the style of the border between a cell and its neighbor given by - ADeltaCol and ADeltaRow (one of them must be 0, the other one can only be +/-1). - ACol and ARow are in grid units. - Result is FALSE if there is no border line. -} -function TsCustomWorksheetGrid.GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer; - out ABorderStyle: TsCellBorderStyle): Boolean; -var - cell, neighborcell: PCell; - border, neighborborder: TsCellBorder; - r, c: Cardinal; -begin - Result := true; - if (ADeltaCol = -1) and (ADeltaRow = 0) then begin - border := cbWest; - neighborborder := cbEast; - end else - if (ADeltaCol = +1) and (ADeltaRow = 0) then begin - border := cbEast; - neighborborder := cbWest; - end else - if (ADeltaCol = 0) and (ADeltaRow = -1) then begin - border := cbNorth; - neighborborder := cbSouth; - end else - if (ADeltaCol = 0) and (ADeltaRow = +1) then begin - border := cbSouth; - neighborBorder := cbNorth; - end else - raise Exception.Create('[TsCustomWorksheetGrid] Incorrect col/row for GetBorderStyle.'); - - r := GetWorksheetRow(ARow); - c := GetWorksheetCol(ACol); - cell := FWorksheet.FindCell(r, c); - if (ARow - FHeaderCount + ADeltaRow < 0) or (ACol - FHeaderCount + ADeltaCol < 0) then - neighborcell := nil - else - neighborcell := FWorksheet.FindCell(ARow - FHeaderCount + ADeltaRow, ACol - FHeaderCount + ADeltaCol); - - // Only cell has border, but neighbor has not - if HasBorder(cell, border) and not HasBorder(neighborCell, neighborBorder) then - begin - if FWorksheet.IsMerged(cell) and FWorksheet.IsMerged(neighborcell) and - (cell^.MergeBase = neighborcell^.Mergebase) - then - result := false - else - ABorderStyle := cell^.BorderStyles[border] - end - else - // Only neighbor has border, cell has not - if not HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then - begin - if FWorksheet.IsMerged(cell) and FWorksheet.IsMerged(neighborcell) and - (cell^.MergeBase = neighborcell^.Mergebase) - then - result := false - else - ABorderStyle := neighborcell^.BorderStyles[neighborborder] - end - else - // Both cells have shared border -> use top or left border - if HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then - begin - if FWorksheet.IsMerged(cell) and FWorksheet.IsMerged(neighborcell) and - (cell^.MergeBase = neighborcell^.Mergebase) - then - result := false - else - if (border in [cbNorth, cbWest]) then - ABorderStyle := neighborcell^.BorderStyles[neighborborder] - else - ABorderStyle := cell^.BorderStyles[border]; - end else - Result := false; -end; - -{@@ - Converts a column index of the worksheet to a column index usable in the grid. - This is required because worksheet indexes always start at zero while - grid indexes also have to account for the column/row headers. - - @param ASheetCol Worksheet column index - @return Grid column index -} -function TsCustomWorksheetGrid.GetGridCol(ASheetCol: Cardinal): Integer; -begin - Result := Integer(ASheetCol) + FHeaderCount -end; - -{@@ - Converts a row index of the worksheet to a row index usable in the grid. - This is required because worksheet indexes always start at zero while - grid indexes also have to account for the column/row headers. - - @param ASheetRow Worksheet row index - @return Grid row index -} -function TsCustomWorksheetGrid.GetGridRow(ASheetRow: Cardinal): Integer; -begin - Result := Integer(ASheetRow) + FHeaderCount; -end; - function TsCustomWorksheetGrid.GetHorAlignment(ACol, ARow: Integer): TsHorAlignment; var cell: PCell; @@ -2545,23 +3274,6 @@ begin end; end; -{@@ - Returns a list of worksheets contained in the file. Useful for assigning to - user controls like TabControl, Combobox etc. in order to select a sheet. - - @param ASheets List of strings containing the names of the worksheets of - the workbook -} -procedure TsCustomWorksheetGrid.GetSheets(const ASheets: TStrings); -var - i: Integer; -begin - ASheets.Clear; - if Assigned(FWorkbook) then - for i:=0 to FWorkbook.GetWorksheetCount-1 do - ASheets.Add(FWorkbook.GetWorksheetByIndex(i).Name); -end; - function TsCustomWorksheetGrid.GetShowGridLines: Boolean; begin Result := (Options * [goHorzLine, goVertLine] <> []); @@ -2659,405 +3371,6 @@ begin end; end; -{@@ - Calculates the index of the worksheet column that is displayed in the - given column of the grid. If the sheet headers are turned on, both numbers - differ by 1, otherwise they are equal. Saves an "if" in cases. - - @param AGridCol Index of a grid column - @return Index of a the corresponding worksheet column -} -function TsCustomWorksheetGrid.GetWorksheetCol(AGridCol: Integer): cardinal; -begin - if (FHeaderCount > 0) and (AGridCol = 0) then - Result := Cardinal(-1) - else - Result := AGridCol - FHeaderCount; -end; - -{@@ - Calculates the index of the worksheet row that is displayed in the - given row of the grid. If the sheet headers are turned on, both numbers - differ by 1, otherwise they are equal. Saves an "if" in some cases. - - @param AGridRow Index of a grid row - @resturn Index of the corresponding worksheet row. -} -function TsCustomWorksheetGrid.GetWorksheetRow(AGridRow: Integer): Cardinal; -begin - if (FHeaderCount > 0) and (AGridRow = 0) then - Result := Cardinal(-1) - else - Result := AGridRow - FHeaderCount; -end; - -{@@ Returns true if the cell has the given border. - - @param ACell Pointer to cell considered - @param ABorder Indicator for border to be checked for visibility -} -function TsCustomWorksheetGrid.HasBorder(ACell: PCell; ABorder: TsCellBorder): Boolean; -begin - Result := (ACell <> nil) and (uffBorder in ACell^.UsedFormattingfields) and - (ABorder in ACell^.Border); -end; - -{@@ - Inherited from TCustomGrid. Is called when column widths or row heights - have changed. Stores the new column width or row height in the worksheet. - - @param IsColumn Specifies whether the changed parameter is a column width - (true) or a row height (false) - @param Index Index of the changed column or row -} -procedure TsCustomWorksheetGrid.HeaderSized(IsColumn: Boolean; index: Integer); -var - w0: Integer; - h, h_pts: Single; -begin - if FWorksheet = nil then - exit; - - Convert_sFont_to_Font(FWorkbook.GetFont(0), Canvas.Font); - if IsColumn then begin - // The grid's column width is in "pixels", the worksheet's column width is - // in "characters". - w0 := Canvas.TextWidth('0'); - FWorksheet.WriteColWidth(GetWorksheetCol(Index), ColWidths[Index] div w0); - end else begin - // The grid's row heights are in "pixels", the worksheet's row heights are - // in "lines" - h_pts := PxToPts(RowHeights[Index] - 4, Screen.PixelsPerInch); // in points - h := h_pts / (FWorkbook.GetFont(0).Size + ROW_HEIGHT_CORRECTION); - FWorksheet.WriteRowHeight(GetWorksheetRow(Index), h); - end; -end; - -{@@ - Inserts an empty column before the column specified -} -procedure TsCustomWorksheetGrid.InsertCol(AGridCol: Integer); -var - c: Cardinal; -begin - if AGridCol < FHeaderCount then - exit; - - if FWorksheet.GetLastColIndex + 1 + FHeaderCount >= FInitColCount then - ColCount := ColCount + 1; - c := AGridCol - FHeaderCount; - FWorksheet.InsertCol(c); - - UpdateColWidths(AGridCol); -end; - -{@@ - Inserts an empty row before the row specified -} -procedure TsCustomWorksheetGrid.InsertRow(AGridRow: Integer); -var - r: Cardinal; -begin - if AGridRow < FHeaderCount then - exit; - - if FWorksheet.GetlastRowIndex+1 + FHeaderCount >= FInitRowCount then - RowCount := RowCount + 1; - r := AGridRow - FHeaderCount; - FWorksheet.InsertRow(r); - - UpdateRowHeights(AGridRow); -end; - -{@@ - Internal general text drawing method. - - @param AText Text to be drawn - @param AMeasureText Text used for checking if the text fits into the - text rectangle. If too large and ReplaceTooLong = true, - a series of # is drawn. - @param ARect Rectangle in which the text is drawn - @param AJustification Determines whether the text is drawn at the "start" (0), - "center" (1) or "end" (2) of the drawing rectangle. - Start/center/end are seen along the text drawing - direction. - @param ACellHorAlign Is the HorAlignment property stored in the cell - @param ACellVertAlign Is the VertAlignment property stored in the cell - @param ATextRot Determines the rotation angle of the text. - @param ATextWrap Determines if the text can wrap into multiple lines - @param ReplaceTooLang If true too-long texts are replaced by a series of - # chars filling the cell. - - @Note The reason to separate AJustification from ACellHorAlign and ACelVertAlign is - the output of nfAccounting formatted numbers where the numbers are always - right-aligned, and the currency symbol is left-aligned. - THIS FEATURE IS CURRENTLY NO LONGER SUPPORTED. -} -procedure TsCustomWorksheetGrid.InternalDrawTextInCell(AText, AMeasureText: String; - ARect: TRect; AJustification: Byte; ACellHorAlign: TsHorAlignment; - ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation; - ATextWrap, ReplaceTooLong: Boolean); -var - ts: TTextStyle; - flags: Cardinal; - txt: String; - txtRect: TRect; - P: TPoint; - w, h, h0, hline: Integer; - i: Integer; - L: TStrings; - wrapped: Boolean; - pLeft, pRight: Integer; -begin - wrapped := ATextWrap or (ATextRot = rtStacked); - if AMeasureText = '' then txt := AText else txt := AMeasureText; - flags := DT_WORDBREAK and not DT_SINGLELINE or DT_CALCRECT; - txtRect := ARect; - - if (ATextRot in [trHorizontal, rtStacked]) then begin - // HORIZONAL TEXT DRAWING DIRECTION - Canvas.Font.Orientation := 0; - ts := Canvas.TextStyle; - ts.Opaque := false; - if wrapped then begin - ts.Wordbreak := true; - ts.SingleLine := false; - LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags); - w := txtRect.Right - txtRect.Left; - h := txtRect.Bottom - txtRect.Top; - end else begin - ts.WordBreak := false; - ts.SingleLine := false; - w := Canvas.TextWidth(AMeasureText); - h := Canvas.TextHeight('Tg'); - end; - - if ATextRot = rtStacked then begin - // Stacked - ts.Alignment := HOR_ALIGNMENTS[ACellHorAlign]; - if h > ARect.Bottom - ARect.Top then begin - if ReplaceTooLong then begin - txt := '#'; - repeat - txt := txt + '#'; - LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags); - until txtRect.Bottom - txtRect.Top > ARect.Bottom - ARect.Top; - AText := copy(txt, 1, Length(txt)-1); - end; - ts.Layout := tlTop; - end else - case AJustification of - 0: ts.Layout := tlTop; - 1: ts.Layout := tlCenter; - 2: ts.Layout := tlBottom; - end; - Canvas.TextStyle := ts; - Canvas.TextRect(ARect, ARect.Left, ARect.Top, AText); - end else begin - // Horizontal - if h > ARect.Bottom - ARect.Top then - ts.Layout := tlTop - else - ts.Layout := VERT_ALIGNMENTS[ACellVertAlign]; - - // too long text - if w > ARect.Right - ARect.Left then - if ReplaceTooLong then - begin - txt := ''; - repeat - txt := txt + '#'; - LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags); - until txtRect.Right - txtRect.Left > ARect.Right - ARect.Left; - AText := Copy(txt, 1, Length(txt)-1); - w := Canvas.TextWidth(AText); - end; - - P := ARect.TopLeft; - case AJustification of - 0: ts.Alignment := taLeftJustify; - 1: if (FDrawingCell <> nil) and (FDrawingCell^.MergeBase = nil) then //(FDrawingCell^.MergedNeighbors = []) then - begin - // Special treatment for overflowing cells: they must be centered - // at their original column, not in the total enclosing rectangle. - ColRowToOffset(true, true, FDrawingCell^.Col + FHeaderCount, pLeft, pRight); - P.X := (pLeft + pRight - w) div 2; - P.y := ARect.Top; - ts.Alignment := taLeftJustify; - end - else - ts.Alignment := taCenter; - 2: ts.Alignment := taRightJustify; - end; - (* - if w > ARect.Right - ARect.Left then begin - if ReplaceTooLong then begin - txt := ''; - repeat - txt := txt + '#'; - LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags); - until txtRect.Right - txtRect.Left > ARect.Right - ARect.Left; - AText := Copy(txt, 1, Length(txt)-1); - end; - //ts.Alignment := taLeftJustify; - end else - case AJustification of - 0: ts.Alignment := taLeftJustify; - 1: ts.Alignment := taCenter; - 2: ts.Alignment := taRightJustify; - end; - *) - Canvas.TextStyle := ts; - Canvas.TextRect(ARect, P.X, P.Y, AText); - end; - end - else - begin - // ROTATED TEXT DRAWING DIRECTION - // Since there is no good API for multiline rotated text, we draw the text - // line by line. - L := TStringList.Create; - try - txtRect := Bounds(ARect.Left, ARect.Top, ARect.Bottom - ARect.Top, ARect.Right - ARect.Left); - hline := Canvas.TextHeight('Tg'); - if wrapped then begin - // Extract wrapped lines - L.Text := WrapText(Canvas, txt, txtRect.Right - txtRect.Left); - // Calculate size of wrapped text - flags := DT_WORDBREAK and not DT_SINGLELINE or DT_CALCRECT; - LCLIntf.DrawText(Canvas.Handle, PChar(L.Text), Length(L.Text), txtRect, flags); - w := txtRect.Right - txtRect.Left; - h := txtRect.Bottom - txtRect.Top; - h0 := hline; - end - else begin - L.Text := txt; - w := Canvas.TextWidth(txt); - h := hline; - h0 := 0; - end; - // w and h are seen along the text direction, not x/y! - - if w > ARect.Bottom - ARect.Top then begin - if ReplaceTooLong then begin - txt := '#'; - repeat - txt := txt + '#'; - until Canvas.TextWidth(txt) > ARect.Bottom - ARect.Top; - L.Text := Copy(txt, 1, Length(txt)-1); - end; - end; - - ts := Canvas.TextStyle; - ts.SingleLine := true; // Draw text line by line - ts.Clipping := false; - ts.Layout := tlTop; - ts.Alignment := taLeftJustify; - ts.Opaque := false; - - if ATextRot = rt90DegreeClockwiseRotation then begin - // Clockwise - Canvas.Font.Orientation := -900; - case ACellHorAlign of - haLeft : P.X := Min(ARect.Right-1, ARect.Left + h - h0); - haCenter : P.X := Min(ARect.Right-1, (ARect.Left + ARect.Right + h) div 2); - haRight : P.X := ARect.Right - 1; - end; - for i:= 0 to L.Count-1 do begin - w := Canvas.TextWidth(L[i]); - case AJustification of - 0: P.Y := ARect.Top; // corresponds to "top" - 1: P.Y := Max(ARect.Top, (Arect.Top + ARect.Bottom - w) div 2); // "center" - 2: P.Y := Max(ARect.Top, ARect.Bottom - w); // "bottom" - end; { - case vertAlign of - vaTop : P.Y := ARect.Top; - vaCenter : P.Y := Max(ARect.Top, (ARect.Top + ARect.Bottom - w) div 2); - vaBottom : P.Y := Max(ARect.Top, ARect.Bottom - w); - end;} - Canvas.TextRect(ARect, P.X, P.Y, L[i], ts); - dec(P.X, hline); - end - end - else begin - // Counter-clockwise - Canvas.Font.Orientation := +900; - case ACellHorAlign of - haLeft : P.X := ARect.Left; - haCenter : P.X := Max(ARect.Left, (ARect.Left + ARect.Right - h + h0) div 2); - haRight : P.X := MAx(ARect.Left, ARect.Right - h + h0); - end; - for i:= 0 to L.Count-1 do begin - w := Canvas.TextWidth(L[i]); - case AJustification of - 0: P.Y := ARect.Bottom; // like "Bottom" - 1: P.Y := Min(ARect.Bottom, (ARect.Top + ARect.Bottom + w) div 2); // "Center" - 2: P.Y := Min(ARect.Bottom, ARect.Top + w); // like "top" - end; { - case vertAlign of - vaTop : P.Y := Min(ARect.Bottom, ARect.Top + w); - vaCenter : P.Y := Min(ARect.Bottom, (ARect.Top + ARect.Bottom + w) div 2); - vaBottom : P.Y := ARect.Bottom; - end;} - Canvas.TextRect(ARect, P.X, P.Y, L[i], ts); - inc(P.X, hline); - end; - end; - finally - L.Free; - end; - end; -end; - -{@@ - Standard key handling method inherited from TCustomGrid. Is overridden to - catch the ESC key during editing in order to restore the old cell text - - @param Key Key which has been pressed - @param Shift Additional shift keys which are pressed -} -procedure TsCustomWorksheetGrid.KeyDown(var Key : Word; Shift : TShiftState); -begin - if (Key = VK_ESCAPE) and FEditing then begin - SetEditText(Col, Row, FOldEditText); - EditorHide; - exit; - end; - inherited; -end; - -{@@ - Standard method inherited from TCustomGrid. Is overridden to create an - empty workbook -} -procedure TsCustomWorksheetGrid.Loaded; -begin - inherited; - NewWorkbook(FInitColCount, FInitRowCount); -end; - -{@@ - Standard method inherited from TCustomGrid. - Repaints the grid after moving selection to avoid spurious rests of the - old thick selection border. } -procedure TsCustomWorksheetGrid.MoveSelection; -begin - //Refresh; - inherited; - Refresh; -end; - -{@@ - Standard method inherited from TCustomGrid: Is called when editing starts. - Is overridden here to store the old text just in case that the user presses - ESC to cancel editing. -} -procedure TsCustomWorksheetGrid.SelectEditor; -begin - FOldEditText := GetCellText(Col, Row); - inherited; -end; - procedure TsCustomWorksheetGrid.SetAutoCalc(AValue: Boolean); begin FAutoCalc := AValue; @@ -3280,22 +3593,6 @@ begin end; end; -{@@ - Standaard method inherited from TCustomGrid. Fetches the text that is - currently in the editor. It is not yet transferred to the worksheet because - input will be checked only at the end of editing. - - @param ACol Grid column index of the cell being edited - @param ARow Grid row index of the cell being edited - @param AValue String which is currently in the cell editor -} -procedure TsCustomWorksheetGrid.SetEditText(ACol, ARow: Longint; const AValue: string); -begin - FEditText := AValue; - FEditing := true; - inherited SetEditText(aCol, aRow, aValue); -end; - procedure TsCustomWorksheetGrid.SetFrozenCols(AValue: Integer); begin FFrozenCols := AValue; @@ -3399,42 +3696,6 @@ begin end; end; -{@@ - Helper method for setting up the rows and columns after a new workbook is - loaded or created. Sets up the grid's column and row count, as well as the - initial column widths and row heights. -} -procedure TsCustomWorksheetGrid.Setup; -begin - if (FWorksheet = nil) or (FWorksheet.GetCellCount = 0) then begin - if ShowHeaders then begin - ColCount := FInitColCount + 1; //2; - RowCount := FInitRowCount + 1; //2; - FixedCols := 1; - FixedRows := 1; - ColWidths[0] := Canvas.TextWidth(' 999999 '); - end else begin - FixedCols := 0; - FixedRows := 0; - ColCount := FInitColCount; //0; - RowCount := FInitRowCount; //0; - end; - end else - if FWorksheet <> nil then begin - ColCount := Max(FWorksheet.GetLastColIndex + 1 + FHeaderCount, FInitColCount); - RowCount := Max(FWorksheet.GetLastRowIndex + 1 + FHeaderCount, FInitRowCount); - FixedCols := FFrozenCols + FHeaderCount; - FixedRows := FFrozenRows + FHeaderCount; - if ShowHeaders then begin - ColWidths[0] := Canvas.TextWidth(' 999999 '); - RowHeights[0] := DefaultRowHeight; - end; - end; - UpdateColWidths; - UpdateRowHeights; - Invalidate; -end; - procedure TsCustomWorksheetGrid.SetVertAlignment(ACol, ARow: Integer; AValue: TsVertAlignment); begin @@ -3479,204 +3740,6 @@ begin end; end; -procedure TsCustomWorksheetGrid.UpdateColWidths(AStartIndex: Integer = 0); -var - i: Integer; - lCol: PCol; - w: Integer; -begin - if AStartIndex = 0 then AStartIndex := FHeaderCount; - for i := AStartIndex to ColCount-1 do begin - w := DefaultColWidth; - if FWorksheet <> nil then - begin - lCol := FWorksheet.FindCol(i - FHeaderCount); - if lCol <> nil then - w := CalcColWidth(lCol^.Width) - end; - ColWidths[i] := w; - end; -end; - -procedure TsCustomWorksheetGrid.UpdateRowHeights(AStartIndex: Integer = 0); -var - i: Integer; - lRow: PRow; - h: Integer; -begin - if AStartIndex <= 0 then AStartIndex := FHeaderCount; - for i := AStartIndex to RowCount-1 do begin - h := CalcAutoRowHeight(i); - if FWorksheet <> nil then - begin - lRow := FWorksheet.FindRow(i - FHeaderCount); - if (lRow <> nil) then - h := CalcRowHeight(lRow^.Height); - end; - RowHeights[i] := h; - end; -end; - -{@@ - Loads the worksheet into the grid and displays its contents. - - @param AWorksheet Worksheet to be displayed in the grid -} -procedure TsCustomWorksheetGrid.LoadFromWorksheet(AWorksheet: TsWorksheet); -begin - FWorksheet := AWorksheet; - if FWorksheet <> nil then begin - FWorksheet.OnChangeCell := @ChangedCellHandler; - FWorksheet.OnChangeFont := @ChangedFontHandler; - ShowHeaders := (soShowHeaders in FWorksheet.Options); - ShowGridLines := (soShowGridLines in FWorksheet.Options); - if (soHasFrozenPanes in FWorksheet.Options) then begin - FrozenCols := FWorksheet.LeftPaneWidth; - FrozenRows := FWorksheet.TopPaneHeight; - end else begin - FrozenCols := 0; - FrozenRows := 0; - end; - Row := FrozenRows; - Col := FrozenCols; - end; - Setup; -end; - -{@@ - Creates a new workbook and loads the given file into it. The file is assumed - to have the given file format. Shows the sheet with the given sheet index. - - @param AFileName Name of the file to be loaded - @param AFormat Spreadsheet file format assumed for the file - @param AWorksheetIndex Index of the worksheet to be displayed in the grid -} -procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string; - AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer); -begin - BeginUpdate; - try - CreateNewWorkbook; - FWorkbook.ReadFromFile(AFileName, AFormat); - LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex)); - finally - EndUpdate; - end; -end; - -{@@ - Creates a new workbook and loads the given file into it. The file format - is determined automatically. Shows the sheet with the given sheet index. - - @param AFileName Name of the file to be loaded - @param AWorksheetIndex Index of the worksheet to be shown in the grid -} -procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string; - AWorksheetIndex: Integer); -begin - BeginUpdate; - try - CreateNewWorkbook; - FWorkbook.ReadFromFile(AFilename); - LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex)); - finally - EndUpdate; - end; -end; - -{@@ - Merges the selected cells to a single large cell -} -procedure TsCustomWorksheetGrid.MergeCells; -begin - FWorksheet.MergeCells( - GetWorksheetRow(Selection.Top), - GetWorksheetCol(Selection.Left), - GetWorksheetRow(Selection.Bottom), - GetWorksheetCol(Selection.Right) - ); -end; - -{@@ - Splits a merged cell block into single cells -} -procedure TsCustomWorksheetGrid.UnmergeCells; -begin - FWorksheet.UnmergeCells( - GetWorksheetRow(Selection.Top), - GetWorksheetCol(Selection.Left) - ); -end; - -{@@ - Creates a new empty workbook with the specified number of columns and rows. - - @param AColCount Number of columns - @param ARowCount Number of rows -} -procedure TsCustomWorksheetGrid.NewWorkbook(AColCount, ARowCount: Integer); -begin - BeginUpdate; - try - CreateNewWorkbook; - FWorksheet := FWorkbook.AddWorksheet('Sheet1'); - FWorksheet.OnChangeCell := @ChangedCellHandler; - FWorksheet.OnChangeFont := @ChangedFontHandler; - FInitColCount := AColCount; - FInitRowCount := ARowCount; - Setup; - finally - EndUpdate; - end; -end; - -{@@ - Writes the workbook represented by the grid to a spreadsheet file. - - @param AFileName Name of the file to which the workbook is to be - saved. - @param AFormat Spreadsheet file format in which the file is to be - saved. - @param AOverwriteExisting If the file already exists, it is overwritten in - the case of AOverwriteExisting = true, or an - exception is raised if AOverwriteExisting = false -} -procedure TsCustomWorksheetGrid.SaveToSpreadsheetFile(AFileName: String; - AFormat: TsSpreadsheetFormat; AOverwriteExisting: Boolean = true); -begin - if FWorkbook <> nil then - FWorkbook.WriteToFile(AFileName, AFormat, AOverwriteExisting); -end; - -{@@ - Saves the workbook into a file with the specified file name. If this file - name already exists the file is overwritten if AOverwriteExisting is true. - - @param AFileName Name of the file to which the workbook is to be saved - If the file format is not known is is written as BIFF8/XLS. - @param AOverwriteExisting If this file already exists it is overwritten if - AOverwriteExisting = true, or an exception is raised - if AOverwriteExisting = false. -} -procedure TsCustomWorksheetGrid.SaveToSpreadsheetFile(AFileName: String; - AOverwriteExisting: Boolean = true); -begin - if FWorkbook <> nil then - FWorkbook.WriteToFile(AFileName, AOverwriteExisting); -end; - -{@@ - Loads the workbook into the grid and selects the sheet with the given index. - "Selected" means here that the sheet is loaded into the grid. - - @param AIndex Index of the worksheet to be shown in the grid -} -procedure TsCustomWorksheetGrid.SelectSheetByIndex(AIndex: Integer); -begin - if FWorkbook <> nil then - LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AIndex)); -end; - initialization fpsutils.ScreenPixelsPerInch := Screen.PixelsPerInch; diff --git a/components/fpspreadsheet/fpsrpn.pas b/components/fpspreadsheet/fpsrpn.pas index b82fd1d3f..9a54820d4 100644 --- a/components/fpspreadsheet/fpsrpn.pas +++ b/components/fpspreadsheet/fpsrpn.pas @@ -58,12 +58,12 @@ uses { Simplified creation of RPN formulas } {******************************************************************************} -{@@ +{@@ ---------------------------------------------------------------------------- Creates a pointer to a new RPN item. This represents an element in the array of token of an RPN formula. @return Pointer to the RPN item -} +-------------------------------------------------------------------------------} function NewRPNItem: PRPNItem; begin New(Result); @@ -71,21 +71,21 @@ begin Result^.FE.StringValue := ''; end; -{@@ +{@@ ---------------------------------------------------------------------------- Destroys an RPN item -} +-------------------------------------------------------------------------------} procedure DisposeRPNItem(AItem: PRPNItem); begin if AItem <> nil then Dispose(AItem); end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates a boolean value entry in the RPN array. @param AValue Boolean value to be stored in the RPN item @next ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNBool(AValue: Boolean; ANext: PRPNItem): PRPNItem; begin Result := NewRPNItem; @@ -94,13 +94,13 @@ begin Result^.Next := ANext; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a cell value, specifed by its address, e.g. 'A1'. Takes care of absolute and relative cell addresses. @param ACellAddress Adress of the cell given in Excel A1 notation @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNCellValue(ACellAddress: String; ANext: PRPNItem): PRPNItem; var r,c: Cardinal; @@ -111,7 +111,7 @@ begin Result := RPNCellValue(r,c, flags, ANext); end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a cell value, specifed by its row and column index and a flag containing information on relative addresses. @@ -119,7 +119,7 @@ end; @param ACol Column index of the cell @param AFlags Flags specifying absolute or relative cell addresses @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNCellValue(ARow, ACol: Integer; AFlags: TsRelFlags; ANext: PRPNItem): PRPNItem; begin @@ -131,7 +131,7 @@ begin Result^.Next := ANext; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a cell reference, specifed by its address, e.g. 'A1'. Takes care of absolute and relative cell addresses. "Cell reference" means that all properties of the cell can be handled. @@ -140,7 +140,7 @@ end; @param ACellAddress Adress of the cell given in Excel A1 notation @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNCellRef(ACellAddress: String; ANext: PRPNItem): PRPNItem; var r,c: Cardinal; @@ -151,7 +151,7 @@ begin Result := RPNCellRef(r,c, flags, ANext); end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a cell reference, specifed by its row and column index and flags containing information on relative addresses. "Cell reference" means that all properties of the cell can be handled. @@ -162,7 +162,7 @@ end; @param ACol Column index of the cell @param AFlags Flags specifying absolute or relative cell addresses @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNCellRef(ARow, ACol: Integer; AFlags: TsRelFlags; ANext: PRPNItem): PRPNItem; begin @@ -174,14 +174,15 @@ begin Result^.Next := ANext; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a range of cells, specified by an Excel-style address, e.g. A1:G5. As in Excel, use a $ sign to indicate absolute addresses. - @param ACellRangeAddress Adress of the cell range given in Excel notation, such as A1:G5 + @param ACellRangeAddress Adress of the cell range given in Excel notation, + such as A1:G5 @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNCellRange(ACellRangeAddress: String; ANext: PRPNItem): PRPNItem; var r1,c1, r2,c2: Cardinal; @@ -192,7 +193,7 @@ begin Result := RPNCellRange(r1,c1, r2,c2, flags, ANext); end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a range of cells, specified by the row/column indexes of the top/left and bottom/right corners of the block. The flags indicate relative indexes. @@ -203,7 +204,7 @@ end; @param ACol2 Column index of the bottom/right cell @param AFlags Flags specifying absolute or relative cell addresses @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNCellRange(ARow, ACol, ARow2, ACol2: Integer; AFlags: TsRelFlags; ANext: PRPNItem): PRPNItem; begin @@ -217,7 +218,7 @@ begin Result^.Next := ANext; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a relative cell reference as used in shared formulas. The given parameters indicate the relativ offset between the current cell coordinates and a reference rell. @@ -226,7 +227,7 @@ end; @param AColOffset Offset between current column and the column of a reference cell @param AFlags Flags specifying absolute or relative cell addresses @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNCellOffset(ARowOffset, AColOffset: Integer; AFlags: TsRelFlags; ANext: PRPNItem): PRPNItem; begin @@ -238,13 +239,13 @@ begin Result^.Next := ANext; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array with an error value. @param AErrCode Error code to be inserted (see TsErrorValue @param ANext Pointer to the next RPN item in the list @see TsErrorValue -} +-------------------------------------------------------------------------------} function RPNErr(AErrCode: TsErrorValue; ANext: PRPNItem): PRPNItem; begin Result := NewRPNItem; @@ -253,12 +254,12 @@ begin Result^.Next := ANext; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a 2-byte unsigned integer @param AValue Integer value to be inserted into the formula @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNInteger(AValue: Word; ANext: PRPNItem): PRPNItem; begin Result := NewRPNItem; @@ -267,12 +268,12 @@ begin Result^.Next := ANext; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a missing argument in of function call. Use this in a formula to indicate a missing argument @param ANext Pointer to the next RPN item in the list. -} +-------------------------------------------------------------------------------} function RPNMissingArg(ANext: PRPNItem): PRPNItem; begin Result := NewRPNItem; @@ -280,12 +281,12 @@ begin Result^.Next := ANext; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a floating point number. @param AValue Number value to be inserted into the formula @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNNumber(AValue: Double; ANext: PRPNItem): PRPNItem; begin Result := NewRPNItem; @@ -294,12 +295,12 @@ begin Result^.Next := ANext; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array which puts the current operator in parenthesis. For display purposes only, does not affect calculation. @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNParenthesis(ANext: PRPNItem): PRPNItem; begin Result := NewRPNItem; @@ -307,12 +308,12 @@ begin Result^.Next := ANext; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for a string. @param AValue String to be inserted into the formula @param ANext Pointer to the next RPN item in the list -} +-------------------------------------------------------------------------------} function RPNString(AValue: String; ANext: PRPNItem): PRPNItem; begin Result := NewRPNItem; @@ -321,92 +322,57 @@ begin Result^.Next := ANext; end; -{@@ - Creates an entry in the RPN array for an Excel function or operation - specified by its TokenID (--> TFEKind). Note that array elements for all - needed parameters must have been created before. +{@@ ---------------------------------------------------------------------------- + Creates an entry in the RPN array for an operation specified by its TokenID + (--> TFEKind). Note that array elements for all needed parameters must have + been created before. @param AToken Formula element indicating the function to be executed, see the TFEKind enumeration for possible values. @param ANext Pointer to the next RPN item in the list @see TFEKind -} +-------------------------------------------------------------------------------} function RPNFunc(AToken: TFEKind; ANext: PRPNItem): PRPNItem; begin - { - if FEProps[AToken].MinParams <> FEProps[AToken].MaxParams then - raise Exception.CreateFmt(lpSpecifyNumberOfParams, [FEProps[AToken].Symbol]); - } Result := NewRPNItem; Result^.FE.ElementKind := AToken; Result^.Fe.FuncName := ''; Result^.Next := ANext; end; - -{@@ +{@@ ---------------------------------------------------------------------------- Creates an entry in the RPN array for an Excel function or operation - specified by its TokenID (--> TFEKind). Note that array elements for all - needed parameters must have been created before. + specified by its name. Note that array elements for all needed parameters + must have been created before. - @param AToken Formula element indicating the function to be executed, - see the TFEKind enumeration for possible values. - @param ANext Pointer to the next RPN item in the list - - @see TFEKind -} + @param AFuncName Name of the spreadsheet function (as used by Excel) + @param ANext Pointer to the next RPN item in the list +-------------------------------------------------------------------------------} function RPNFunc(AFuncName: String; ANext: PRPNItem): PRPNItem; begin - { - if FEProps[AToken].MinParams <> FEProps[AToken].MaxParams then - raise Exception.CreateFmt(lpSpecifyNumberOfParams, [FEProps[AToken].Symbol]); - } - Result := RPNFunc(AFuncName, 255, ANext); //FEProps[AToken].MinParams, ANext); + Result := RPNFunc(AFuncName, 255, ANext); end; -{@@ - Creates an entry in the RPN array for an Excel function or operation - specified by its TokenID (--> TFEKind). Specify the number of parameters used. +{@@ ---------------------------------------------------------------------------- + Creates an entry in the RPN array for an Excel spreadsheet function + specified by its name. Specify the number of parameters used. They must have been created before. - @param AToken Formula element indicating the function to be executed, - see the TFEKind enumeration for possible values. - @param ANumParams Number of arguments used in the formula. If -1 then the - fixed number of arguments known from the function definiton - is used. + @param AFuncName Name of the spreadsheet function (as used by Excel). + @param ANumParams Number of arguments used in the formula. @param ANext Pointer to the next RPN item in the list - - @see TFEKind -} +-------------------------------------------------------------------------------} function RPNFunc(AFuncName: String; ANumParams: Byte; ANext: PRPNItem): PRPNItem; begin - { - if (ANumParams > -1) then - if (ANumParams < FEProps[AToken].MinParams) or (ANumParams > FEProps[AToken].MaxParams) then - raise Exception.CreateFmt(lpIncorrectParamCount, [ - FEProps[AToken].Symbol, FEProps[AToken].MinParams, FEProps[AToken].MaxParams - ]); - } Result := NewRPNItem; Result^.FE.ElementKind := fekFunc; Result^.Fe.FuncName := AFuncName; Result^.FE.ParamsNum := ANumParams; Result^.Next := ANext; end; - (* -{@@ - Returns if the function defined by the token requires a fixed number of parameter. - @param AElementKind Identifier of the formula function considered -} -function FixedParamCount(AElementKind: TFEKind): Boolean; -begin - Result := (FEProps[AElementKind].MinParams = FEProps[AElementKind].MaxParams) - and (FEProps[AElementKind].MinParams >= 0); -end; - *) -{@@ +{@@ ---------------------------------------------------------------------------- Creates an RPN formula by a single call using nested RPN items. For each formula element, use one of the RPNxxxx functions implemented here. @@ -431,7 +397,7 @@ end; RPNFunc(fekAdd, nil)))); -} +-------------------------------------------------------------------------------} function CreateRPNFormula(AItem: PRPNItem; AReverse: Boolean = false): TsRPNFormula; var item: PRPNItem; @@ -461,13 +427,13 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Destroys the RPN formula starting with the given RPN item. @param AItem Pointer to the first RPN items representing the formula. Each item contains a pointer to the next item in the list. The list is terminated by nil. -} +-------------------------------------------------------------------------------} procedure DestroyRPNFormula(AItem: PRPNItem); var nextitem: PRPNItem; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 28f871a8e..793bccd51 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -179,12 +179,12 @@ type big-endian isn't support, because Delphi doesn't support it. } -{@@ +{@@ ---------------------------------------------------------------------------- WordLEToLE converts a word value from big-endian to little-endian byte order. @param AValue Big-endian word value @return Little-endian word value -} +-------------------------------------------------------------------------------} function WordToLE(AValue: Word): Word; begin {$IFDEF FPC} @@ -194,12 +194,12 @@ begin {$ENDIF} end; -{@@ +{@@ ---------------------------------------------------------------------------- DWordLEToLE converts a DWord value from big-endian to little-endian byte-order. @param AValue Big-endian DWord value @return Little-endian DWord value -} +-------------------------------------------------------------------------------} function DWordToLE(AValue: Cardinal): Cardinal; begin {$IFDEF FPC} @@ -209,12 +209,12 @@ begin {$ENDIF} end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts an integer value from big-endian to little-endian byte-order. @param AValue Big-endian integer value @return Little-endian integer value -} +-------------------------------------------------------------------------------} function IntegerToLE(AValue: Integer): Integer; begin {$IFDEF FPC} @@ -224,12 +224,12 @@ begin {$ENDIF} end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts a word value from little-endian to big-endian byte-order. @param AValue Little-endian word value @return Big-endian word value -} +-------------------------------------------------------------------------------} function WordLEtoN(AValue: Word): Word; begin {$IFDEF FPC} @@ -239,12 +239,12 @@ begin {$ENDIF} end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts a DWord value from little-endian to big-endian byte-order. @param AValue Little-endian DWord value @return Big-endian DWord value -} +-------------------------------------------------------------------------------} function DWordLEtoN(AValue: Cardinal): Cardinal; begin {$IFDEF FPC} @@ -254,12 +254,12 @@ begin {$ENDIF} end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts a widestring from big-endian to little-endian byte-order. @param AValue Big-endian widestring @return Little-endian widestring -} +-------------------------------------------------------------------------------} function WideStringToLE(const AValue: WideString): WideString; {$IFNDEF FPC} var @@ -280,12 +280,12 @@ begin {$ENDIF} end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts a widestring from little-endian to big-endian byte-order. @param AValue Little-endian widestring @return Big-endian widestring -} +-------------------------------------------------------------------------------} function WideStringLEToN(const AValue: WideString): WideString; {$IFNDEF FPC} var @@ -306,12 +306,14 @@ begin {$ENDIF} end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts the RGB part of a LongRGB logical structure to its physical representation. In other words: RGBA (where A is 0 and omitted in the function call) => ABGR Needed for conversion of palette colors. + @param RGB DWord value containing RGBA bytes in big endian byte-order - @return DWord containing RGB bytes in little-endian byte-order (A = 0) } + @return DWord containing RGB bytes in little-endian byte-order (A = 0) +-------------------------------------------------------------------------------} function LongRGBToExcelPhysical(const RGB: DWord): DWord; begin {$IFDEF FPC} @@ -327,7 +329,7 @@ begin {$ENDIF} end; -{@@ +{@@ ---------------------------------------------------------------------------- Parses strings like A5:A10 into an selection interval information @param AStr Cell range string, such as A5:A10 @@ -336,8 +338,9 @@ end; @param ACount Number of cells included in the range (output) @param ADirection fpsVerticalSelection if the range is along a column, fpsHorizontalSelection if the range is along a row + @return false if the string is not a valid cell range -} +-------------------------------------------------------------------------------} function ParseIntervalString(const AStr: string; out AFirstCellRow, AFirstCellCol, ACount: Cardinal; out ADirection: TsSelectionDirection): Boolean; @@ -389,7 +392,7 @@ begin else Exit(False); end; -{@@ +{@@ ---------------------------------------------------------------------------- Parses strings like A5:C10 into a range selection information. Returns in AFlags also information on relative/absolute cells. @@ -401,8 +404,9 @@ end; @param AFlags a set containing an element for AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol if they represent relative cell addresses. + @return false if the string is not a valid cell range -} +-------------------------------------------------------------------------------} function ParseCellRangeString(const AStr: string; out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal; out AFlags: TsRelFlags): Boolean; @@ -432,7 +436,7 @@ begin end; -{@@ +{@@ ---------------------------------------------------------------------------- Parses strings like A5:C10 into a range selection information. Information on relative/absolute cells is ignored. @@ -442,17 +446,20 @@ end; @param ALastCellRow Row index of the bottom/right cell of the range (output) @param ALastCellCol Column index of the bottom/right cell of the range (output) @return false if the string is not a valid cell range -} +--------------------------------------------------------------------------------} function ParseCellRangeString(const AStr: string; out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal): Boolean; var flags: TsRelFlags; begin - Result := ParseCellRangeString(AStr, AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol, flags); + Result := ParseCellRangeString(AStr, + AFirstCellRow, AFirstCellCol, + ALastCellRow, ALastCellCol, + flags + ); end; - -{@@ +{@@ ---------------------------------------------------------------------------- Parses a cell string, like 'A1' into zero-based column and row numbers Note that there can be several letters to address for more than 26 columns. 'AFlags' indicates relative addresses. @@ -466,7 +473,7 @@ end; @example "AMP$200" --> (rel) column 1029 (= 26*26*1 + 26*16 + 26 - 1) (abs) row = 199 (abs) -} +-------------------------------------------------------------------------------} function ParseCellString(const AStr: String; out ACellRow, ACellCol: Cardinal; out AFlags: TsRelFlags): Boolean; @@ -485,7 +492,9 @@ function ParseCellString(const AStr: String; out ACellRow, ACellCol: Cardinal; while (i <= Length(AStr)) do begin if (UpCase(AStr[i]) in LETTERS) then begin ACellCol := Cardinal(ord(UpCase(AStr[i])) - ord('A')) + 1 + ACellCol * 26; - if ACellCol >= MAX_COL_COUNT then // too many columns (dropping this limitation could cause overflow if a too long string is passed + if ACellCol >= MAX_COL_COUNT then + // too many columns (dropping this limitation could cause overflow + // if a too long string is passed exit; inc(i); end @@ -543,7 +552,7 @@ begin Result := Scan(1); end; -{@@ +{@@ ---------------------------------------------------------------------------- Parses a cell string, like 'A1' into zero-based column and row numbers Note that there can be several letters to address for more than 26 columns. @@ -554,7 +563,7 @@ end; @param ACellRow Row index of the top/left cell of the range (output) @param ACellCol Column index of the top/left cell of the range (output) @return False if the string is not a valid cell range -} +-------------------------------------------------------------------------------} function ParseCellString(const AStr: string; out ACellRow, ACellCol: Cardinal): Boolean; var @@ -563,13 +572,13 @@ begin Result := ParseCellString(AStr, ACellRow, ACellCol, flags); end; -{@@ +{@@ ---------------------------------------------------------------------------- Parses a cell row string to a zero-based row number. @param AStr Cell row string, such as '1', 1-based! @param AResult Index of the row (zero-based!) (putput) @return False if the string is not a valid cell row string -} +-------------------------------------------------------------------------------} function ParseCellRowString(const AStr: string; out AResult: Cardinal): Boolean; begin try @@ -580,14 +589,14 @@ begin Result := True; end; -{@@ +{@@ ---------------------------------------------------------------------------- Parses a cell column string, like 'A' or 'CZ', into a zero-based column number. Note that there can be several letters to address more than 26 columns. @param AStr Cell range string, such as A1 @param AResult Zero-based index of the column (output) @return False if the string is not a valid cell column string -} +-------------------------------------------------------------------------------} function ParseCellColString(const AStr: string; out AResult: Cardinal): Boolean; const INT_NUM_LETTERS = 26; @@ -617,15 +626,16 @@ begin Result := Char(AValue + ord('A')); end; -{@@ +{@@ ---------------------------------------------------------------------------- Calculates an Excel column name ('A', 'B' etc) from the zero-based column index @param AColIndex Zero-based column index @return Letter-based column name string. Can contain several letter in case of more than 26 columns -} +-------------------------------------------------------------------------------} function GetColString(AColIndex: Integer): String; -{ Code adapted from: http://stackoverflow.com/questions/12796973/vba-function-to-convert-column-number-to-letter } +{ Code adapted from: + http://stackoverflow.com/questions/12796973/vba-function-to-convert-column-number-to-letter } var n: Integer; c: byte; @@ -642,7 +652,7 @@ end; const RELCHAR: Array[boolean] of String = ('$', ''); -{@@ +{@@ ---------------------------------------------------------------------------- Calculates a cell address string from zero-based column and row indexes and the relative address state flags. @@ -654,7 +664,7 @@ const @return Excel type of cell address containing $ characters for absolute address parts. @example ARowIndex = 0, AColIndex = 0, AFlags = [rfRelRow] --> $A1 -} +-------------------------------------------------------------------------------} function GetCellString(ARow, ACol: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String; begin @@ -664,7 +674,7 @@ begin ]); end; -{@@ +{@@ ---------------------------------------------------------------------------- Calculates a cell range address string from zero-based column and row indexes and the relative address state flags. @@ -679,7 +689,7 @@ end; range @example ARow1 = 0, ACol1 = 0, ARow = 2, ACol = 1, AFlags = [rfRelRow, rfRelRow2] --> $A1:$B3 -} +-------------------------------------------------------------------------------} function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol, rfRelRow2, rfRelCol2]): String; begin @@ -691,13 +701,12 @@ begin ]); end; - -{@@ +{@@ ---------------------------------------------------------------------------- Returns the message text assigned to an error value @param AErrorValue Error code as defined by TsErrorvalue @return Text corresponding to the error code. -} +-------------------------------------------------------------------------------} function GetErrorValueStr(AErrorValue: TsErrorValue): String; begin case AErrorValue of @@ -715,7 +724,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Helper function to reduce typing: "if a conditions is true return the first number format, otherwise return the second format" @@ -723,40 +732,45 @@ end; @param AValue1 First built-in number format code @param AValue2 Second built-in number format code @return AValue1 if ACondition is true, AValue2 otherwise. -} -function IfThen(ACondition: Boolean; AValue1, AValue2: TsNumberFormat): TsNumberFormat; +-------------------------------------------------------------------------------} +function IfThen(ACondition: Boolean; + AValue1, AValue2: TsNumberFormat): TsNumberFormat; begin if ACondition then Result := AValue1 else Result := AValue2; end; -{@@ +{@@ ---------------------------------------------------------------------------- Checks whether the given number format code is for currency, i.e. requires currency symbol. @param AFormat Built-in number format identifier to be checked - @return True if AFormat is nfCurrency or nfCurrencyRed, false otherwise. } + @return True if AFormat is nfCurrency or nfCurrencyRed, false otherwise. +-------------------------------------------------------------------------------} function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; begin Result := AFormat in [nfCurrency, nfCurrencyRed]; end; -{@@ +{@@ ---------------------------------------------------------------------------- Checks whether the given number format code is for date/time values. @param AFormat Built-in number format identifier to be checked - @return True if AFormat is a date/time format (such as nfShortTime), false otherwise } + @return True if AFormat is a date/time format (such as nfShortTime), + false otherwise +-------------------------------------------------------------------------------} function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; begin Result := AFormat in [{nfFmtDateTime, }nfShortDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval]; end; -{@@ +{@@ ---------------------------------------------------------------------------- Checks whether the given string with formatting codes is for date/time values. @param AFormatStr String with formatting codes to be checked. @return True if AFormatStr is a date/time format string (such as 'hh:nn'), - false otherwise } + false otherwise +-------------------------------------------------------------------------------} function IsDateTimeFormat(AFormatStr: string): Boolean; var parser: TsNumFormatParser; @@ -769,22 +783,24 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Checks whether the given built-in number format code is for time values. @param AFormat Built-in number format identifier to be checked - @return True if AFormat represents to a time-format, false otherwise } + @return True if AFormat represents to a time-format, false otherwise +-------------------------------------------------------------------------------} function IsTimeFormat(AFormat: TsNumberFormat): boolean; begin Result := AFormat in [nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval]; end; -{@@ +{@@ ---------------------------------------------------------------------------- Checks whether the given string with formatting codes is for time values. @param AFormatStr String with formatting codes to be checked - @return True if AFormatStr represents a time-format, false otherwise } + @return True if AFormatStr represents a time-format, false otherwise +-------------------------------------------------------------------------------} function IsTimeFormat(AFormatStr: String): Boolean; var parser: TsNumFormatParser; @@ -797,7 +813,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Builds a date/time format string from the number format code. @param ANumberFormat built-in number format identifier @@ -808,7 +824,7 @@ end; are added to the first time code field. @return String of date/time formatting code constructed from the built-in format information. -} +-------------------------------------------------------------------------------} function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings; AFormatString: String = '') : string; begin @@ -844,7 +860,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Builds a currency format string. The presentation of negative values (brackets, or minus signs) is taken from the provided format settings. The format string consists of three sections, separated by semicolons. @@ -869,7 +885,7 @@ end; If ? the CurrencyString of the FormatSettings is used. @return String of formatting codes, such as '"$"#,##0.00;("$"#,##0.00);"EUR"0.00' -} +-------------------------------------------------------------------------------} function BuildCurrencyFormatString(ADialect: TsNumFormatDialect; ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings; ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ACurrencySymbol: String): String; @@ -947,7 +963,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Builds a number format string from the number format code and the count of decimal places. @@ -958,7 +974,7 @@ end; value of the FormatSettings is used. @return String of formatting codes, such as '#,##0.00' for nfFixedTh and 2 decimals -} +-------------------------------------------------------------------------------} function BuildNumberFormatString(ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings; ADecimals: Integer = -1): String; var @@ -988,7 +1004,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Adds an AM/PM format code to a pre-built time formatting string. The strings replacing "AM" or "PM" in the final formatted number are taken from the TimeAMString or TimePMString of the given FormatSettings. @@ -998,7 +1014,7 @@ end; @result Formatting string with AM/PM option activated. Example: ATimeFormatString = 'hh:nn' ==> 'hh:nn AM/PM' -} +-------------------------------------------------------------------------------} function AddAMPM(const ATimeFormatString: String; const AFormatSettings: TFormatSettings): String; var @@ -1009,14 +1025,14 @@ begin Result := Format('%s %s/%s', [StripAMPM(ATimeFormatString), am, pm]); end; -{@@ +{@@ ---------------------------------------------------------------------------- Removes an AM/PM formatting code from a given time formatting string. Variants of "AM/PM" are considered as well. The string is left unchanged if it does not contain AM/PM codes. @param ATimeFormatString String of time formatting codes (such as 'hh:nn AM/PM') @return Formatting string with AM/PM being removed (--> 'hh:nn') -} +-------------------------------------------------------------------------------} function StripAMPM(const ATimeFormatString: String): String; var i: Integer; @@ -1034,7 +1050,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Counts how many decimal places are coded into a given formatting string. @param AFormatString String with number format codes, such as '0.000' @@ -1042,7 +1058,7 @@ end; For the fixed decimals, this is the '0'. Optional decimals are encoced as '#'. @return Count of decimal places found (3 in above example). -} +-------------------------------------------------------------------------------} function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; var i: Integer; @@ -1062,8 +1078,8 @@ begin end; end; -{@@ - The given format string is assumed to represent for time intervals, i.e. its +{@@ ---------------------------------------------------------------------------- + The given format string is assumed to represent a time interval, i.e. its first time symbol must be enclosed by square brackets. Checks if this is true, and adds the brackes if not. @@ -1071,7 +1087,7 @@ end; @return Unchanged format string if its first time code is in square brackets (as in '[h]:nn:ss'), if not, the first time code is enclosed in square brackets. - } +-------------------------------------------------------------------------------} function AddIntervalBrackets(AFormatString: String): String; var p: Integer; @@ -1090,7 +1106,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates a long date format string out of a short date format string. Retains the order of year-month-day and the separators, but uses 4 digits for year and 3 digits of month. @@ -1098,7 +1114,7 @@ end; @param ADateFormat String with date formatting code representing a "short" date, such as 'dd/mm/yy' @return Format string modified to represent a "long" date, such as 'dd/mmm/yyyy' -} +-------------------------------------------------------------------------------} function MakeLongDateFormat(ADateFormat: String): String; var i: Integer; @@ -1126,14 +1142,14 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Modifies the short date format such that it has a two-digit year and a two-digit month. Retains the order of year-month-day and the separators. @param ADateFormat String with date formatting codes representing a "long" date, such as 'dd/mmm/yyyy' @return Format string modified to represent a "short" date, such as 'dd/mm/yy' -} +-------------------------------------------------------------------------------} function MakeShortDateFormat(ADateFormat: String): String; var i: Integer; @@ -1161,7 +1177,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz" out of the formatsettings. @@ -1171,7 +1187,7 @@ end; "ms" = minutes + seconds "msz" = minutes + seconds + fractions of a second @return String of formatting codes according to the parameter ACode -} +-------------------------------------------------------------------------------} function SpecialDateTimeFormat(ACode: String; const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; var @@ -1206,7 +1222,7 @@ begin Result := ACode; end; -{@@ +{@@ ---------------------------------------------------------------------------- Currency formatting strings consist of three parts, separated by semicolons, which are valid for positive, negative or zero values. Splits such a formatting string at the positions of the semicolons and @@ -1222,8 +1238,7 @@ end; @param ANegativePart Second section of the formatting string which is valid for negative numbers @param AZeroPart Third section of the formatting string for zero. -} - +-------------------------------------------------------------------------------} procedure SplitFormatString(const AFormatString: String; out APositivePart, ANegativePart, AZeroPart: String); @@ -1281,14 +1296,14 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Creates a "time interval" format string having the first time code identifier in square brackets. @param Src Source format string, must be a time format string, like 'hh:nn' @param Dest Destination format string, will have the first time code element of the src format string in square brackets, like '[hh]:nn'. -} +-------------------------------------------------------------------------------} procedure MakeTimeIntervalMask(Src: String; var Dest: String); var L: TStrings; @@ -1306,108 +1321,108 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Excel's unit of row heights is "twips", i.e. 1/20 point. Converts Twips to points. @param AValue Length value in twips @return Value converted to points -} +-------------------------------------------------------------------------------} function TwipsToPts(AValue: Integer): Single; begin Result := AValue / 20; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts points to twips (1 twip = 1/20 point) @param AValue Length value in points @return Value converted to twips -} +-------------------------------------------------------------------------------} function PtsToTwips(AValue: Single): Integer; begin Result := round(AValue * 20); end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts centimeters to points (72 pts = 1 inch) @param AValue Length value in centimeters @return Value converted to points -} +-------------------------------------------------------------------------------} function cmToPts(AValue: Double): Double; begin Result := AValue * 72 / 2.54; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts points to centimeters @param AValue Length value in points @return Value converted to centimeters -} +-------------------------------------------------------------------------------} function PtsToCm(AValue: Double): Double; begin Result := AValue / 72 * 2.54; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts inches to points (72 pts = 1 inch) @param AValue Length value in inches @return Value converted to points -} +-------------------------------------------------------------------------------} function InToPts(AValue: Double): Double; begin Result := AValue * 72; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts millimeters to points (72 pts = 1 inch) @param AValue Length value in millimeters @return Value converted to points -} +-------------------------------------------------------------------------------} function mmToPts(AValue: Double): Double; begin Result := AValue * 72 / 25.4; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts points to millimeters @param AValue Length value in points @return Value converted to millimeters -} +-------------------------------------------------------------------------------} function PtsToMM(AValue: Double): Double; begin Result := AValue / 72 * 25.4; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts pixels to points. @param AValue Length value given in pixels @param AScreenPixelsPerInch Pixels per inch of the screen @return Value converted to points -} +-------------------------------------------------------------------------------} function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double; begin Result := (AValue / AScreenPixelsPerInch) * 72; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts points to pixels @param AValue Length value given in points @param AScreenPixelsPerInch Pixels per inch of the screen @return Value converted to pixels -} +-------------------------------------------------------------------------------} function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer; begin Result := Round(AValue / 72 * AScreenPixelsPerInch); end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts a HTML length string to points. The units are assumed to be the last two digits of the string, such as '1.25in' @@ -1416,7 +1431,7 @@ end; 'px' (pixels), 'pt' (points), 'in' (inches), 'mm' (millimeters), 'cm' (centimeters). @return Extracted length in points -} +-------------------------------------------------------------------------------} function HTMLLengthStrToPts(AValue: String): Double; var units: String; @@ -1449,13 +1464,13 @@ begin raise Exception.Create('Unknown length units'); end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts a HTML color string to a TsColorValue. Need for the ODS file format. @param AValue HTML color string, such as '#FF0000' @return rgb color value in little endian byte-sequence. This value is compatible with the TColor data type of the graphics unit. -} +-------------------------------------------------------------------------------} function HTMLColorStrToColor(AValue: String): TsColorValue; begin if AValue = '' then @@ -1495,7 +1510,7 @@ begin end; end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts an rgb color value to a string as used in HTML code (for ods) @param AValue RGB color value (compatible with the TColor data type @@ -1503,7 +1518,7 @@ end; @param AExcelDialect If TRUE, returned string is in Excels format for xlsx, i.e. in AARRGGBB notation, like '00FF0000' for "red" @return HTML-compatible string, like '#FF0000' (AExcelDialect = false) -} +-------------------------------------------------------------------------------} function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String; type TRGB = record r,g,b,a: Byte end; @@ -1517,13 +1532,13 @@ begin Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]); end; -{@@ +{@@ ---------------------------------------------------------------------------- Converts a string encoded in UTF8 to a string usable in XML. For this purpose, some characters must be translated. @param AText input string encoded as UTF8 @return String usable in XML with some characters replaced by the HTML codes. -} +-------------------------------------------------------------------------------} function UTF8TextToXMLText(AText: ansistring): ansistring; var Idx:Integer;