diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk
index fd90c6773..80c6841a3 100644
--- a/components/fpspreadsheet/laz_fpspreadsheet.lpk
+++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk
@@ -270,6 +270,30 @@ This package is all you need if you don't want graphical components (like g
+ -
+
+
+
+ -
+
+
+
+ -
+
+
+
+ -
+
+
+
+ -
+
+
+
+ -
+
+
+
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet.pas b/components/fpspreadsheet/source/common/fpspreadsheet.pas
index 267d61a1a..83670f018 100644
--- a/components/fpspreadsheet/source/common/fpspreadsheet.pas
+++ b/components/fpspreadsheet/source/common/fpspreadsheet.pas
@@ -1494,311 +1494,6 @@ begin
Result := false;
end;
-{@@ ----------------------------------------------------------------------------
- Checks whether a cell contains a comment and returns a pointer to the
- comment data.
-
- @param ACell Pointer to the cell
- @return Pointer to the TsComment record (nil, if the cell does not have a
- comment)
--------------------------------------------------------------------------------}
-function TsWorksheet.FindComment(ACell: PCell): PsComment;
-begin
- if HasComment(ACell) then
- Result := PsComment(FComments.FindByRowCol(ACell^.Row, ACell^.Col))
- else
- Result := nil;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Checks whether a specific cell contains a comment
--------------------------------------------------------------------------------}
-function TsWorksheet.HasComment(ACell: PCell): Boolean;
-begin
- Result := (ACell <> nil) and (cfHasComment in ACell^.Flags);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the comment text attached to a specific cell
-
- @param ARow (0-based) index to the row
- @param ACol (0-based) index to the column
- @return Text assigned to the cell as a comment
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadComment(ARow, ACol: Cardinal): String;
-var
- comment: PsComment;
-begin
- Result := '';
- comment := PsComment(FComments.FindByRowCol(ARow, ACol));
- if comment <> nil then
- Result := comment^.Text;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the comment text attached to a specific cell
-
- @param ACell Pointer to the cell
- @return Text assigned to the cell as a comment
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadComment(ACell: PCell): String;
-var
- comment: PsComment;
-begin
- Result := '';
- comment := FindComment(ACell);
- if comment <> nil then
- Result := comment^.Text;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Adds a comment to a specific cell
-
- @param ARow (0-based) row index of the cell
- @param ACol (0-based) column index of the cell
- @param AText Comment text
- @return Pointer to the cell containing the comment
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteComment(ARow, ACol: Cardinal; AText: String): PCell;
-begin
- Result := GetCell(ARow, ACol);
- WriteComment(Result, AText);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Adds a comment to a specific cell
-
- @param ACell Pointer to the cell
- @param AText Comment text
--------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteComment(ACell: PCell; AText: String);
-begin
- if ACell = nil then
- exit;
-
- // Remove the comment if an empty string is passed
- if AText = '' then
- begin
- RemoveComment(ACell);
- exit;
- end;
-
- // Add new comment record
- FComments.AddComment(ACell^.Row, ACell^.Col, AText);
- Include(ACell^.Flags, cfHasComment);
-
- ChangedCell(ACell^.Row, ACell^.Col);
-
-end;
-
-
-{ Hyperlinks }
-
-{@@ ----------------------------------------------------------------------------
- Checks whether the specified cell contains a hyperlink and returns a pointer
- to the hyperlink data.
-
- @param ACell Pointer to the cell
- @return Pointer to the TsHyperlink record, or NIL if the cell does not contain
- a hyperlink.
--------------------------------------------------------------------------------}
-function TsWorksheet.FindHyperlink(ACell: PCell): PsHyperlink;
-begin
- if HasHyperlink(ACell) then
- Result := PsHyperlink(FHyperlinks.FindByRowCol(ACell^.Row, ACell^.Col))
- else
- Result := nil;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Reads the hyperlink information of a specified cell.
-
- @param ACell Pointer to the cell considered
- @returns Record with the hyperlink data assigned to the cell.
- If the cell is not a hyperlink the result field Kind is hkNone.
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadHyperlink(ACell: PCell): TsHyperlink;
-var
- hyperlink: PsHyperlink;
-begin
- hyperlink := FindHyperlink(ACell);
- if hyperlink <> nil then
- Result := hyperlink^
- else
- begin
- Result.Row := ACell^.Row;
- Result.Col := ACell^.Col;
- Result.Target := '';
- Result.Tooltip := '';
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Removes a hyperlink from the specified cell. Releaes memory occupied by
- the associated TsHyperlink record. Cell content type is converted to
- cctUTF8String.
--------------------------------------------------------------------------------}
-procedure TsWorksheet.RemoveHyperlink(ACell: PCell);
-begin
- if HasHyperlink(ACell) then
- begin
- FHyperlinks.DeleteHyperlink(ACell^.Row, ACell^.Col);
- Exclude(ACell^.Flags, cfHyperlink);
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Checks whether the passed string represents a valid hyperlink target
-
- @param AValue String to be checked. Must be either a fully qualified URI,
- a local relative (!) file name, or a # followed by a cell
- address in the current workbook
- @param AErrMsg Error message in case that the string is not correct.
- @returns TRUE if the string is correct, FALSE otherwise
--------------------------------------------------------------------------------}
-function TsWorksheet.ValidHyperlink(AValue: String; out AErrMsg: String): Boolean;
-var
- u: TUri;
- sheet: TsWorksheet;
- r, c: Cardinal;
-begin
- Result := false;
- AErrMsg := '';
- if AValue = '' then
- begin
- AErrMsg := rsEmptyHyperlink;
- exit;
- end else
- if (AValue[1] = '#') then
- begin
- Delete(AValue, 1, 1);
- if not FWorkbook.TryStrToCell(AValue, sheet, r, c) then
- begin
- AErrMsg := Format(rsNoValidHyperlinkInternal, ['#'+AValue]);
- exit;
- end;
- end else
- begin
- u := ParseURI(AValue);
- if SameText(u.Protocol, 'mailto') then
- begin
- Result := true; // To do: Check email address here...
- exit;
- end else
- if SameText(u.Protocol, 'file') then
- begin
- if FilenameIsAbsolute(u.Path + u.Document) then
- begin
- Result := true;
- exit;
- end else
- begin
- AErrMsg := Format(rsLocalfileHyperlinkAbs, [AValue]);
- exit;
- end;
- end else
- begin
- Result := true;
- exit;
- end;
- end;
-end;
-
-
-{@@ ----------------------------------------------------------------------------
- Assigns a hyperlink to the cell at the specified row and column
- Cell content is not affected by the presence of a hyperlink.
-
- @param ARow Row index of the cell considered
- @param ACol Column index of the cell considered
- @param ATarget Hyperlink address given as a fully qualitifed URI for
- external links, or as a # followed by a cell address
- for internal links.
- @param ATooltip Text for popup tooltip hint used by Excel
- @returns Pointer to the cell with the hyperlink
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteHyperlink(ARow, ACol: Cardinal; ATarget: String;
- ATooltip: String = ''): PCell;
-begin
- Result := GetCell(ARow, ACol);
- WriteHyperlink(Result, ATarget, ATooltip);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Assigns a hyperlink to the specified cell.
-
- @param ACell Pointer to the cell considered
- @param ATarget Hyperlink address given as a fully qualitifed URI for
- external links, or as a # followed by a cell address
- for internal links. Local files can be specified also
- by their name relative to the workbook.
- An existing hyperlink is removed if ATarget is empty.
- @param ATooltip Text for popup tooltip hint used by Excel
--------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteHyperlink(ACell: PCell; ATarget: String;
- ATooltip: String = '');
-
- function GetDisplayText(ATarget: String): String;
- var
- target, bm: String;
- begin
- SplitHyperlink(ATarget, target, bm);
- if pos('file:', lowercase(ATarget))=1 then
- begin
- URIToFilename(target, Result);
- ForcePathDelims(Result);
- if bm <> '' then Result := Result + '#' + bm;
- end else
- if target = '' then
- Result := bm
- else
- Result := ATarget;
- end;
-
-var
- fmt: TsCellFormat;
- noCellText: Boolean = false;
-begin
- if ACell = nil then
- exit;
-
- fmt := ReadCellFormat(ACell);
-
- // Empty target string removes the hyperlink. Resets the font from hyperlink
- // to default font.
- if ATarget = '' then begin
- RemoveHyperlink(ACell);
- if fmt.FontIndex = HYPERLINK_FONTINDEX then
- WriteFont(ACell, DEFAULT_FONTINDEX);
- exit;
- end;
-
- // Detect whether the cell already has a hyperlink, but has no other content.
- if HasHyperlink(ACell) then
- noCellText := (ACell^.ContentType = cctUTF8String) and
- (GetDisplayText(ReadHyperlink(ACell).Target) = ReadAsText(ACell));
-
- // Attach the hyperlink to the cell
- FHyperlinks.AddHyperlink(ACell^.Row, ACell^.Col, ATarget, ATooltip);
- Include(ACell^.Flags, cfHyperlink);
-
- // If there is no other cell content use the target as cell label string.
- if (ACell^.ContentType = cctEmpty) or noCellText then
- begin
- ACell^.ContentType := cctUTF8String;
- ACell^.UTF8StringValue := GetDisplayText(ATarget);
- end;
-
- // Select the hyperlink font.
- if fmt.FontIndex = DEFAULT_FONTINDEX then
- begin
- fmt.FontIndex := HYPERLINK_FONTINDEX;
- Include(fmt.UsedFormattingFields, uffFont);
- ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt);
- end;
-
- ChangedCell(ACell^.Row, ACell^.Col);
-end;
{@@ ----------------------------------------------------------------------------
Is called whenever a cell value or formatting has changed. Fires an event
@@ -2523,57 +2218,6 @@ begin
end;
end;
-{@@ ----------------------------------------------------------------------------
- Determines some number format attributes (decimal places, currency symbol) of
- a cell
-
- @param ACell Pointer to the cell under investigation
- @param ADecimals Number of decimal places that can be extracted from
- the formatting string, e.g. in case of '0.000' this
- would be 3.
- @param ACurrencySymbol String representing the currency symbol extracted from
- the formatting string.
-
- @return true if the the format string could be analyzed successfully, false if not
--------------------------------------------------------------------------------}
-function TsWorksheet.GetNumberFormatAttributes(ACell: PCell; out ADecimals: byte;
- out ACurrencySymbol: String): Boolean;
-var
- parser: TsNumFormatParser;
- nf: TsNumberFormat;
- nfs: String;
-begin
- Result := false;
- if ACell <> nil then
- begin
- ReadNumFormat(ACell, nf, nfs);
- parser := TsNumFormatParser.Create(nfs, FWorkbook.FormatSettings);
- try
- if parser.Status = psOK then
- begin
- nf := parser.NumFormat;
- if (nf = nfGeneral) and (ACell^.ContentType = cctNumber) then
- begin
- ADecimals := GetDisplayedDecimals(ACell);
- ACurrencySymbol := '';
- end else
- if IsDateTimeFormat(nf) then
- begin
- ADecimals := 2;
- ACurrencySymbol := '?';
- end
- else
- begin
- ADecimals := parser.Decimals;
- ACurrencySymbol := parser.CurrencySymbol;
- end;
- Result := true;
- end;
- finally
- parser.Free;
- end;
- end;
-end;
{@@ ----------------------------------------------------------------------------
Returns the 0-based index of the first column with a cell with contents.
@@ -3183,174 +2827,6 @@ begin
Result := FWorkbook.GetPointerToCellFormat(fmtIndex);
end; *)
-{@@ ----------------------------------------------------------------------------
- Reads the set of used formatting fields of a cell.
-
- Each cell contains a set of "used formatting fields". Formatting is applied
- only if the corresponding element is contained in the set.
-
- @param ACell Pointer to the cell
- @return Set of elements used in formatting the cell
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadUsedFormatting(ACell: PCell): TsUsedFormattingFields;
-var
- fmt: PsCellFormat;
-begin
- if ACell = nil then
- begin
- Result := [];
- Exit;
- end;
- fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
- Result := fmt^.UsedFormattingFields;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the background fill pattern and colors of a cell.
-
- @param ACell Pointer to the cell
- @return TsFillPattern record (or EMPTY_FILL, if the cell does not have a
- filled background
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadBackground(ACell: PCell): TsFillPattern;
-var
- fmt : PsCellFormat;
-begin
- Result := EMPTY_FILL;
- if ACell <> nil then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- if (uffBackground in fmt^.UsedFormattingFields) then
- Result := fmt^.Background;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the background color of a cell as rbg value
-
- @param ACell Pointer to the cell
- @return Value containing the rgb bytes in little-endian order
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadBackgroundColor(ACell: PCell): TsColor;
-begin
- Result := scTransparent;
- if ACell <> nil then
- Result := ReadBackgroundColor(ACell^.FormatIndex);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the background color stored at the specified index in the format
- list of the workkbok.
-
- @param AFormatIndex Index of the format record
- @return Value containing the rgb bytes in little-endian order
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadBackgroundColor(AFormatIndex: Integer): TsColor;
-var
- fmt: PsCellFormat;
-begin
- Result := scTransparent;
- if AFormatIndex > -1 then begin
- fmt := Workbook.GetPointerToCellFormat(AFormatIndex);
- if (uffBackground in fmt^.UsedFormattingFields) then
- begin
- if fmt^.Background.Style = fsSolidFill then
- Result := fmt^.Background.FgColor
- else
- Result := fmt^.Background.BgColor;
- end;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Determines which borders are drawn around a specific cell
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadCellBorders(ACell: PCell): TsCellBorders;
-var
- fmt: PsCellFormat;
-begin
- Result := [];
- if ACell <> nil then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- if (uffBorder in fmt^.UsedFormattingFields) then
- Result := fmt^.Border;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Determines which the style of a particular cell border
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadCellBorderStyle(ACell: PCell;
- ABorder: TsCelLBorder): TsCellBorderStyle;
-var
- fmt: PsCellFormat;
-begin
- Result := DEFAULT_BORDERSTYLES[ABorder];
- if ACell <> nil then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- Result := fmt^.BorderStyles[ABorder];
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Determines which all border styles of a given cell
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadCellBorderStyles(ACell: PCell): TsCellBorderStyles;
-var
- fmt: PsCellFormat;
-begin
- Result := DEFAULT_BORDERSTYLES;
- if ACell <> nil then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- Result := Fmt^.BorderStyles;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Determines the font used by a specified cell. Returns the workbook's default
- font if the cell does not exist.
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadCellFont(ACell: PCell): TsFont;
-var
- fmt: PsCellFormat;
-begin
- Result := nil;
- if ACell <> nil then begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- Result := Workbook.GetFont(fmt^.FontIndex);
- end;
- if Result = nil then
- Result := Workbook.GetDefaultFont;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Determines the index of the font used by a specified cell, referring to the
- workbooks font list. Returns 0 (the default font index) if the cell does not
- exist.
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadCellFontIndex(ACell: PCell): Integer;
-var
- fmt: PsCellFormat;
-begin
- Result := DEFAULT_FONTINDEX;
- if ACell <> nil then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- Result := fmt^.FontIndex;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the format record that is assigned to a specified cell
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadCellFormat(ACell: PCell): TsCellFormat;
-begin
- Result := Workbook.GetCellFormat(ACell^.FormatIndex);
-end;
-
{@@ ----------------------------------------------------------------------------
Determines the font used in a specified column record.
Returns the workbook's default font if the column record does not exist.
@@ -3386,133 +2862,6 @@ begin
Result := Workbook.GetDefaultFont;
end;
-{@@ ----------------------------------------------------------------------------
- Returns the horizontal alignment of a specific cell
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadHorAlignment(ACell: PCell): TsHorAlignment;
-var
- fmt: PsCellFormat;
-begin
- Result := haDefault;
- if (ACell <> nil) then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- if (uffHorAlign in fmt^.UsedFormattingFields) then
- Result := fmt^.HorAlignment;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the number format type and format string used in a specific cell
--------------------------------------------------------------------------------}
-procedure TsWorksheet.ReadNumFormat(ACell: PCell; out ANumFormat: TsNumberFormat;
- out ANumFormatStr: String);
-var
- fmt: PsCellFormat;
- numFmt: TsNumFormatParams;
-begin
- ANumFormat := nfGeneral;
- ANumFormatStr := '';
- if ACell <> nil then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- if (uffNumberFormat in fmt^.UsedFormattingFields) then
- begin
- numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
- if numFmt <> nil then
- begin
- ANumFormat := numFmt.NumFormat;
- ANumFormatStr := numFmt.NumFormatStr;
- end else
- begin
- ANumFormat := nfGeneral;
- ANumFormatStr := '';
- end;
- end;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the text orientation of a specific cell
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadTextRotation(ACell: PCell): TsTextRotation;
-var
- fmt: PsCellFormat;
-begin
- Result := trHorizontal;
- if ACell <> nil then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- if (uffTextRotation in fmt^.UsedFormattingFields) then
- Result := fmt^.TextRotation;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the vertical alignment of a specific cell
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadVertAlignment(ACell: PCell): TsVertAlignment;
-var
- fmt: PsCellFormat;
-begin
- Result := vaDefault;
- if (ACell <> nil) then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- if (uffVertAlign in fmt^.UsedFormattingFields) then
- Result := fmt^.VertAlignment;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns whether a specific cell support word-wrapping.
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadWordwrap(ACell: PCell): boolean;
-var
- fmt: PsCellFormat;
-begin
- Result := false;
- if (ACell <> nil) then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- Result := uffWordwrap in fmt^.UsedFormattingFields;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the BiDi mode of the cell (right-to-left or left-to-right)
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadBiDiMode(ACell: PCell): TsBiDiMode;
-var
- fmt: PsCellFormat;
-begin
- Result := bdDefault;
- if (ACell <> nil) then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- if (uffBiDi in fmt^.UsedFormattingFields) then
- Result := fmt^.BiDiMode;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the protection flags of the cell.
-
- NOTE: These flags are active only if sheet protection is active, i.e.
- soProtected in Worksheet.Options.
--------------------------------------------------------------------------------}
-function TsWorksheet.ReadCellProtection(ACell: PCell): TsCellProtections;
-var
- fmt: PsCellFormat;
-begin
- Result := DEFAULT_CELL_PROTECTION;
- if (ACell <> nil) then
- begin
- fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
- if fmt <> nil then
- Result := fmt^.Protection;
- end;
-end;
{@@ ----------------------------------------------------------------------------
Returns true if the worksheet does not contain any cell, column or row records
@@ -3795,282 +3144,6 @@ begin
DeleteFormula(ACell);
end;
-{@@ ----------------------------------------------------------------------------
- Returns the parameters of the image stored in the internal image list at
- the specified index.
-
- @param AIndex Index of the image to be retrieved
- @return TsImage record with all image parameters.
--------------------------------------------------------------------------------}
-function TsWorksheet.GetImage(AIndex: Integer): TsImage;
-var
- img: PsImage;
-begin
- img := PsImage(FImages[AIndex]);
- Result := img^;
-end;
-
-function TsWorksheet.GetPointerToImage(AIndex: Integer): PsImage;
-begin
- Result := PsImage(FImages[AIndex]);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the count of images that are embedded into this sheet.
--------------------------------------------------------------------------------}
-function TsWorksheet.GetImageCount: Integer;
-begin
- Result := FImages.Count;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Calculates the position of the image with given index relative to the cell
- containing the top/left corner of the image.
-
- @@param x worksheet-relative coordinate of the left image edge, in workbook units
- @@param y worksheet-relative coordinate of the top image edge, in workbook units
- @@param ARow Index of the row containing the top/left corner of the image
- @@param ACol Index of the column containing the top/left corner of the image
- @@param ARowOffset Distance, in workbook units, between top cell and image borders
- @@param AColOffset Distance, in workbook units, between left cell and image borders
- @@param AScaleX Scaling factor for the image width
- @@param AScaleY Scaling factor for the image height
--------------------------------------------------------------------------------}
-procedure TsWorksheet.CalcImageCell(AIndex: Integer; x, y, AWidth, AHeight: Double;
- out ARow, ACol: Cardinal; out ARowOffs, AColOffs, AScaleX, AScaleY: Double);
-// All lengths are in workbook units!
-var
- colW, rowH, sum: Double;
- embobj: TsEmbeddedObj;
-begin
- ACol := 0;
- sum := 0;
- colW := GetColWidth(0, FWorkbook.Units);
- while (sum + colW < x) do begin
- sum := sum + colW;
- inc(ACol);
- colW := GetColWidth(ACol, FWorkbook.Units);
- end;
- AColOffs := x - sum;
-
- ARow := 0;
- sum := 0;
- rowH := CalcRowHeight(0);
- while (sum + rowH < y) do begin
- sum := sum + rowH;
- inc(ARow);
- rowH := CalcRowHeight(ARow);
- end;
- ARowOffs := y - sum;
-
- embObj := FWorkbook.GetEmbeddedObj(AIndex);
- AScaleX := AWidth / embObj.ImageWidth;
- AScaleY := AHeight / embObj.ImageHeight;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Calculates image extent
-
- @param AIndex Index of the image into the worksheet's image list
- @param UsePixels if TRUE then pixels are used for calculation - this improves
- the display of the images in Excel
- @param ARow1 Index of the row containing the top edge of the image
- @param ACol1 Index of the column containing the left edege of the image
- @param ARow2 Index of the row containing the right edge of the image
- @param ACol2 Index of the column containing the bottom edge of the image
- @param ARowOffs1 Distance between the top edge of image and row 1
- @param AColOffs1 Distance between the left edge of image and column 1
- @param ARowOffs2 Distance between the bottom edge of image and top of row 2
- @param AColOffs2 Distance between the right edge of image and left of col 2
- @param x Absolute coordinate of left edge of image
- @param y Absolute coordinate of top edge of image
- @param AWidth Width of the image
- @param AHeight Height of the image
-
- All dimensions are in workbook units
--------------------------------------------------------------------------------}
-procedure TsWorksheet.CalcImageExtent(AIndex: Integer; UsePixels: Boolean;
- out ARow1, ACol1, ARow2, ACol2: Cardinal;
- out ARowOffs1, AColOffs1, ARowOffs2, AColOffs2: Double;
- out x,y, AWidth, AHeight: Double);
-var
- img: TsImage;
- obj: TsEmbeddedObj;
- colW, rowH: Double;
- totH: Double;
- r, c: Integer;
- w_px, h_px: Integer;
- totH_px, rowH_px: Integer;
- totW_px, colW_px: Integer;
- ppi: Integer;
- u: TsSizeUnits;
-begin
- // Abbreviations
- ppi := ScreenPixelsPerInch;
- u := FWorkbook.Units;
-
- img := GetImage(AIndex);
- ARow1 := img.Row;
- ACol1 := img.Col;
- ARowOffs1 := img.OffsetX; // in workbook units
- AColOffs1 := img.OffsetY; // in workbook units
-
- obj := FWorkbook.GetEmbeddedObj(img.Index);
- AWidth := obj.ImageWidth * img.ScaleX; // in workbook units
- AHeight := obj.ImageHeight * img.ScaleY; // in workbook units
-
- // Find x coordinate of left image edge, in workbook units
- x := AColOffs1;
- for c := 0 to ACol1-1 do
- begin
- colW := GetColWidth(c, u);
- x := x + colW;
- end;
- // Find y coordinate of top image edge, in workbook units.
- y := ARowOffs1;
- for r := 0 to ARow1 - 1 do
- begin
- rowH := CalcRowHeight(r);
- y := y + rowH;
- end;
-
- if UsePixels then
- // Use pixels for calculation. Better for Excel, maybe due to rounding error?
- begin
- // If we don't know the ppi of the screen the calculation is not exact!
- w_px := ptsToPx(FWorkbook.ConvertUnits(AWidth, u, suPoints), ppi);
- h_px := ptsToPx(FWorkbook.ConvertUnits(AHeight, u, suPoints), ppi);
- // Find cell with right image edge. Find horizontal within-cell-offsets
- totW_px := -ptsToPx(FWorkbook.ConvertUnits(AColOffs1, u, suPoints), ppi);
- ACol2 := ACol1;
- while (totW_px < w_px) do
- begin
- colW := GetColWidth(ACol2, u);
- colW_px := ptsToPx(FWorkbook.ConvertUnits(colW, u, suPoints), ppi);
- totW_px := totW_px + colW_px;
- if totW_px > w_px then
- begin
- AColOffs2 := FWorkbook.ConvertUnits(pxToPts(colW_px - (totW_px - w_px), ppi), suPoints, u);
- break;
- end;
- inc(ACol2);
- end;
- // Find cell with bottom image edge. Find vertical within-cell-offset.
- totH_px := -ptsToPx(FWorkbook.ConvertUnits(ARowOffs1, u, suPoints), ppi);
- ARow2 := ARow1;
- while (totH_px < h_px) do
- begin
- rowH := CalcRowHeight(ARow2);
- rowH_px := ptsToPx(FWorkbook.ConvertUnits(rowH, u, suPoints), ppi);
- totH_px := totH_px + rowH_px;
- if totH_px > h_px then
- begin
- ARowOffs2 := FWorkbook.ConvertUnits(pxToPts(rowH_px - (totH_px - h_px), ppi), suPoints, u);
- break;
- end;
- inc(ARow2);
- end;
- end
- else // Use workbook units for calculation
- begin
- // Find cell with right image edge. Find horizontal within-cell-offsets
- totH := -ARowOffs1;
- ARow2 := ARow1;
- while (totH < AHeight) do
- begin
- rowH := CalcRowHeight(ARow2);
- totH := totH + rowH;
- if totH >= AHeight then
- begin
- ARowOffs2 := rowH - (totH - AHeight);
- break;
- end;
- inc(ARow2);
- end;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Adds an embedded image to the worksheet
-
- @param ARow Index of the row at which the image begins (top edge)
- @param ACol Index of the column at which the image begins (left edge)
- @param AFileName Name of the image file
- @param AOffsetX The image is offset horizontally from the left edge of
- the anchor cell. May reach into another cell.
- Value is in workbook units.
- @param AOffsetY The image is offset vertically from the top edge of the
- anchor cell. May reach into another cell.
- Value is in workbook units.
- @param AScaleX Horizontal scaling factor of the image
- @param AScaleY Vertical scaling factor of the image
- @return Index into the internal image list.
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AFileName: String;
- AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
- AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
-var
- idx: Integer;
-begin
- // Does the image already exist?
- idx := Workbook.FindEmbeddedObj(AFileName);
- // No? Open and store in embedded object list.
- if idx = -1 then
- idx := Workbook.AddEmbeddedObj(AFileName);
- // An error has occured? Error is already logged. Just exit.
- if idx = -1 then
- exit;
-
- // Everything ok here...
- Result := WriteImage(ARow, ACol, idx, AOffsetX, AOffsetY, AScaleX, AScaleY);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Adds an embedded image to the worksheet. The image passed in a stream.
-
- @param ARow Index of the row at which the image begins (top edge)
- @param ACol Index of the column at which the image begins (left edge)
- @param AStream Stream which contains the image data
- @param AOffsetX The image is offset horizontally from the left edge of
- the anchor cell. May reach into another cell.
- Value is in workbook units.
- @param AOffsetY The image is offset vertically from the top edge of the
- anchor cell. May reach into another cell.
- Value is in workbook units.
- @param AScaleX Horizontal scaling factor of the image
- @param AScaleY Vertical scaling factor of the image
- @param ASize Number ob bytes to be read from the input stream.
- @return Index into the internal image list.
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AStream: TStream;
- AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
- AScaleX: Double = 1.0; AScaleY: Double = 1.0;
- ASize: Int64 = -1): Integer;
-var
- idx: Integer;
-begin
- // Copy the stream to a new item in embedded object list.
- idx := Workbook.AddEmbeddedObj(AStream, '', ASize);
-
- // An error has occured? Error is already logged. Just exit.
- if idx = -1 then
- exit;
-
- // Everything ok here...
- Result := WriteImage(ARow, ACol, idx, AOffsetX, AOffsetY, AScaleX, AScaleY);
-end;
-
-function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AImageIndex: Integer;
- AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
- AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
-var
- img: PsImage;
-begin
- New(img);
- InitImageRecord(img^, ARow, ACol, AOffsetX, AOffsetY, AScaleX, AScaleY);
- img^.Index := AImageIndex;
- Result := FImages.Add(img);
-end;
{@@ Assigns a hyperlink to an image. The image is specified by its index in the
internal image list}
@@ -4086,49 +3159,6 @@ begin
end;
end;
-{@@ ----------------------------------------------------------------------------
- Removes an image from the internal image list.
- The image is identified by its index.
- The image stream (stored by the workbook) is retained.
--------------------------------------------------------------------------------}
-procedure TsWorksheet.RemoveImage(AIndex: Integer);
-var
- img: PsImage;
-begin
- img := PsImage(FImages[AIndex]);
- if (img <> nil) then begin
- if (img^.Picture <> nil) then img^.Picture.Free;
- img^.HyperlinkTarget := '';
- img^.HyperlinkToolTip := '';
- end;
- Dispose(img);
- FImages.Delete(AIndex);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Removes all image from the internal image list.
- The image streams (stored by the workbook), however, are retained because
- images may also be used as header/footer images.
--------------------------------------------------------------------------------}
-procedure TsWorksheet.RemoveAllImages;
-var
- i: Integer;
-begin
- for i := FImages.Count-1 downto 0 do
- RemoveImage(i);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Removes the comment from a cell and releases the memory occupied by the node.
--------------------------------------------------------------------------------}
-procedure TsWorksheet.RemoveComment(ACell: PCell);
-begin
- if HasComment(ACell) then
- begin
- FComments.DeleteComment(ACell^.Row, ACell^.Col);
- Exclude(ACell^.Flags, cfHasComment);
- end;
-end;
{@@ ----------------------------------------------------------------------------
Removes a cell from its tree container. DOES NOT RELEASE ITS MEMORY!
@@ -5669,138 +4699,6 @@ begin
WriteDateTime(ACell, AValue, nfCustom, ANumFormatStr);
end;
-{@@ ----------------------------------------------------------------------------
- Adds a date/time format to the formatting of a cell
-
- @param ARow The row of the cell
- @param ACol The column of the cell
- @param ANumFormat Identifier of the format to be applied (nfXXXX constant)
- @param ANumFormatString Optional string of formatting codes. Is only considered
- if ANumberFormat is nfCustom.
- @return Pointer to the cell
-
- @see TsNumberFormat
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteDateTimeFormat(ARow, ACol: Cardinal;
- ANumFormat: TsNumberFormat; const ANumFormatString: String = ''): PCell;
-begin
- Result := GetCell(ARow, ACol);
- WriteDateTimeFormat(Result, ANumFormat, ANumFormatString);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Adds a date/time format to the formatting of a cell
-
- @param ACell Pointer to the cell considered
- @param ANumFormat Identifier of the format to be applied (nxXXXX constant)
- @param ANumFormatString optional string of formatting codes. Is only considered
- if ANumberFormat is nfCustom.
-
- @see TsNumberFormat
--------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteDateTimeFormat(ACell: PCell;
- ANumFormat: TsNumberFormat; const ANumFormatString: String = '');
-var
- fmt: TsCellFormat;
- nfs: String;
- nfp: TsNumFormatParams;
- isTextFmt, wasTextFmt: Boolean;
- oldVal: String;
-begin
- if ACell = nil then
- exit;
-
- if not ((ANumFormat in [nfGeneral, nfCustom]) or IsDateTimeFormat(ANumFormat)) then
- raise EFPSpreadsheet.Create('WriteDateTimeFormat can only be called with date/time formats.');
-
- isTextFmt := false;
- wasTextFmt := false;
-
- fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
- fmt.NumberFormat := ANumFormat;
- if (ANumFormat <> nfGeneral) then
- begin
- nfp := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
- wasTextFmt := IsTextFormat(nfp);
- oldval := ReadAsText(ACell);
- Include(fmt.UsedFormattingFields, uffNumberFormat);
- if (ANumFormatString = '') then
- nfs := BuildDateTimeFormatString(ANumFormat, Workbook.FormatSettings)
- else
- nfs := ANumFormatString;
- isTextFmt := (nfs = '@');
- end else
- begin
- Exclude(fmt.UsedFormattingFields, uffNumberFormat);
- fmt.NumberFormatStr := '';
- end;
- fmt.NumberFormat := ANumFormat;
- fmt.NumberFormatStr := nfs;
- fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
- ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt);
-
- if isTextFmt then
- WriteText(ACell, oldval)
- else
- if wasTextFmt then
- WriteCellValueAsString(ACell, ACell^.UTF8StringValue);
-
- ChangedCell(ACell^.Row, ACell^.Col);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Formats the number in a cell to show a given count of decimal places.
- Is ignored for non-decimal formats (such as most date/time formats).
-
- @param ARow Row indows of the cell considered
- @param ACol Column indows of the cell considered
- @param ADecimals Number of decimal places to be displayed
- @return Pointer to the cell
- @see TsNumberFormat
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteDecimals(ARow, ACol: Cardinal; ADecimals: Byte): PCell;
-begin
- Result := FindCell(ARow, ACol);
- WriteDecimals(Result, ADecimals);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Formats the number in a cell to show a given count of decimal places.
- Is ignored for non-decimal formats (such as most date/time formats).
-
- @param ACell Pointer to the cell considered
- @param ADecimals Number of decimal places to be displayed
- @see TsNumberFormat
--------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteDecimals(ACell: PCell; ADecimals: Byte);
-var
- parser: TsNumFormatParser;
- fmt: TsCellFormat;
- numFmt: TsNumFormatParams;
- numFmtStr: String;
-begin
- if (ACell = nil) or (ACell^.ContentType <> cctNumber) then
- exit;
-
- fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
- numFmt := FWorkbook.GetNumberFormat(fmt.NumberFormatIndex);
- if numFmt <> nil then
- numFmtStr := numFmt.NumFormatStr
- else
- numFmtStr := '0.00';
- parser := TsNumFormatParser.Create(numFmtStr, Workbook.FormatSettings);
- try
- parser.Decimals := ADecimals;
- numFmtStr := parser.FormatString;
- fmt.NumberFormatIndex := Workbook.AddNumberFormat(numFmtStr);
- Include(fmt.UsedFormattingFields, uffNumberFormat);
- ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
- ChangedCell(ACell^.Row, ACell^.Col);
- finally
- parser.Free;
- end;
-end;
-
{@@ ----------------------------------------------------------------------------
Writes an error value to a cell.
@@ -5937,203 +4835,6 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
-{@@ ----------------------------------------------------------------------------
- Adds a number format to the formatting of a cell
-
- @param ARow The row of the cell
- @param ACol The column of the cell
- @param ANumFormat Identifier of the format to be applied
- @param ADecimals Number of decimal places
- @param ACurrencySymbol optional currency symbol in case of nfCurrency
- @param APosCurrFormat optional identifier for positive currencies
- @param ANegCurrFormat optional identifier for negative currencies
- @return Pointer to the cell
-
- @see TsNumberFormat
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteNumberFormat(ARow, ACol: Cardinal;
- ANumFormat: TsNumberFormat; ADecimals: Integer; ACurrencySymbol: String = '';
- APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1): PCell;
-begin
- Result := GetCell(ARow, ACol);
- WriteNumberFormat(Result, ANumFormat, ADecimals, ACurrencySymbol,
- APosCurrFormat, ANegCurrFormat);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Adds a number format to the formatting of a cell
-
- @param ARow The row of the cell
- @param ACol The column of the cell
- @param ANumFormat Identifier of the format to be applied
- @param ADecimals Number of decimal places
- @param ACurrencySymbol optional currency symbol in case of nfCurrency
- @param APosCurrFormat optional identifier for positive currencies
- @param ANegCurrFormat optional identifier for negative currencies
-
- @see TsNumberFormat
--------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteNumberFormat(ACell: PCell;
- ANumFormat: TsNumberFormat; ADecimals: Integer; ACurrencySymbol: String = '';
- APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1);
-var
- fmt: TsCellFormat;
- fmtStr: String;
- nfp: TsNumFormatParams;
- wasTextFmt: Boolean;
-begin
- if ACell = nil then
- exit;
-
- wasTextFmt := false;
-
- fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
- fmt.NumberFormat := ANumFormat;
- if ANumFormat <> nfGeneral then begin
- nfp := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
- wasTextFmt := IsTextFormat(nfp);
- Include(fmt.UsedFormattingFields, uffNumberFormat);
- if IsCurrencyFormat(ANumFormat) then
- begin
- RegisterCurrency(ACurrencySymbol);
- fmtStr := BuildCurrencyFormatString(ANumFormat, Workbook.FormatSettings,
- ADecimals, APosCurrFormat, ANegCurrFormat, ACurrencySymbol);
- end else
- fmtStr := BuildNumberFormatString(ANumFormat,
- Workbook.FormatSettings, ADecimals);
- fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmtStr);
- end else begin
- Exclude(fmt.UsedFormattingFields, uffNumberFormat);
- fmt.NumberFormatIndex := -1;
- end;
- ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
-
- if wasTextFmt then
- WriteCellValueAsString(ACell, ACell^.UTF8StringValue);
-
- ChangedCell(ACell^.Row, ACell^.Col);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Formats a number as a fraction
-
- @param ARow Row index of the cell
- @param ACol Column index of the cell
- @param ANumFormat Identifier of the format to be applied. Must be
- either nfFraction or nfMixedFraction
- @param ANumeratorDigts Count of numerator digits
- @param ADenominatorDigits Count of denominator digits
- @return Pointer to the cell
-
- @see TsNumberFormat
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteFractionFormat(ARow, ACol: Cardinal;
- AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer): PCell;
-begin
- Result := GetCell(ARow, ACol);
- WriteFractionFormat(Result, AMixedFraction, ANumeratorDigits, ADenominatorDigits);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Formats a number as a fraction
-
- @param ACell Pointer to the cell to be formatted
- @param ANumFormat Identifier of the format to be applied. Must be
- either nfFraction or nfMixedFraction
- @param ANumeratorDigts Count of numerator digits
- @param ADenominatorDigits Count of denominator digits
-
- @see TsNumberFormat
--------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteFractionFormat(ACell: PCell;
- AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer);
-var
- fmt: TsCellFormat;
- nfs: String;
-begin
- if ACell = nil then
- exit;
-
- fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
- nfs := BuildFractionFormatString(AMixedFraction, ANumeratorDigits, ADenominatorDigits);
- fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
- Include(fmt.UsedFormattingFields, uffNumberFormat);
- ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
-
- ChangedCell(ACell^.Row, ACell^.Col);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Adds a number format to the formatting of a cell
-
- @param ARow The row of the cell
- @param ACol The column of the cell
- @param ANumFormat Identifier of the format to be applied
- @param ANumFormatString Optional string of formatting codes. Is only considered
- if ANumberFormat is nfCustom.
- @return Pointer to the cell
-
- @see TsNumberFormat
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteNumberFormat(ARow, ACol: Cardinal;
- ANumFormat: TsNumberFormat; const ANumFormatString: String = ''): PCell;
-begin
- Result := GetCell(ARow, ACol);
- WriteNumberFormat(Result, ANumFormat, ANumFormatString);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Adds a number format to the formatting of a cell
-
- @param ACell Pointer to the cell considered
- @param ANumFormat Identifier of the format to be applied
- @param ANumFormatString Optional string of formatting codes. Is only considered
- if ANumberFormat is nfCustom.
-
- @see TsNumberFormat
--------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteNumberFormat(ACell: PCell;
- ANumFormat: TsNumberFormat; const ANumFormatString: String = '');
-var
- fmt: TsCellFormat;
- fmtStr: String;
- nfp: TsNumFormatParams;
- oldval: String;
- isTextFmt, wasTextFmt: Boolean;
-begin
- if ACell = nil then
- exit;
-
- isTextFmt := false;
- wasTextFmt := false;
-
- fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
-
- if ANumFormat <> nfGeneral then begin
- nfp := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
- wasTextFmt := IsTextFormat(nfp);
- oldval := ReadAsText(ACell);
- Include(fmt.UsedFormattingFields, uffNumberFormat);
- if (ANumFormatString = '') then
- fmtStr := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings)
- else
- fmtStr := ANumFormatString;
- isTextFmt := (fmtstr = '@');
- fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmtStr);
- end else begin
- Exclude(fmt.UsedFormattingFields, uffNumberFormat);
- fmt.NumberFormatIndex := -1;
- end;
- ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
-
- if isTextFmt then
- WriteText(ACell, oldval)
- else
- if wasTextFmt then
- WriteCellValueAsString(ACell, ACell^.UTF8StringValue);
-
- ChangedCell(ACell^.Row, ACell^.Col);
-end;
{@@ ----------------------------------------------------------------------------
Writes an RPN formula to a cell. An RPN formula is an array of tokens
@@ -7417,9 +6118,6 @@ begin
end;
end;
-{$include fpspreadsheet_fmt.inc} // cell formatting
-{$include fpspreadsheet_cf.inc} // conditional formatting
-
{==============================================================================}
{ TsWorkbook }
@@ -8671,451 +7369,6 @@ begin
end;
-{ Format handling }
-
-{@@ ----------------------------------------------------------------------------
- Adds the specified format record to the internal list and returns the index
- in the list. If the record had already been added before the function only
- returns the index.
--------------------------------------------------------------------------------}
-function TsWorkbook.AddCellFormat(const AValue: TsCellFormat): Integer;
-begin
- Result := FCellFormatList.Add(AValue);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the contents of the format record with the specified index.
--------------------------------------------------------------------------------}
-function TsWorkbook.GetCellFormat(AIndex: Integer): TsCellFormat;
-begin
- Result := FCellFormatList.Items[AIndex]^;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns a string describing the cell format with the specified index.
--------------------------------------------------------------------------------}
-function TsWorkbook.GetCellFormatAsString(AIndex: Integer): String;
-var
- fmt: PsCellFormat;
- cb: TsCellBorder;
- s: String;
- numFmt: TsNumFormatParams;
-begin
- Result := '';
- fmt := GetPointerToCellFormat(AIndex);
- if fmt = nil then
- exit;
-
- if (uffFont in fmt^.UsedFormattingFields) then
- Result := Format('%s; Font%d', [Result, fmt^.FontIndex]);
- if (uffBackground in fmt^.UsedFormattingFields) then begin
- Result := Format('%s; Bg %s', [Result, GetColorName(fmt^.Background.BgColor)]);
- Result := Format('%s; Fg %s', [Result, GetColorName(fmt^.Background.FgColor)]);
- Result := Format('%s; Pattern %s', [Result, GetEnumName(TypeInfo(TsFillStyle), ord(fmt^.Background.Style))]);
- end;
- if (uffHorAlign in fmt^.UsedFormattingfields) then
- Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsHorAlignment), ord(fmt^.HorAlignment))]);
- if (uffVertAlign in fmt^.UsedFormattingFields) then
- Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsVertAlignment), ord(fmt^.VertAlignment))]);
- if (uffWordwrap in fmt^.UsedFormattingFields) then
- Result := Format('%s; Word-wrap', [Result]);
- if (uffNumberFormat in fmt^.UsedFormattingFields) then
- begin
- numFmt := GetNumberFormat(fmt^.NumberFormatIndex);
- if numFmt <> nil then
- Result := Format('%s; %s (%s)', [Result,
- GetEnumName(TypeInfo(TsNumberFormat), ord(numFmt.NumFormat)),
- numFmt.NumFormatStr
- ])
- else
- Result := Format('%s; %s', [Result, 'nfGeneral']);
- end else
- Result := Format('%s; %s', [Result, 'nfGeneral']);
- if (uffBorder in fmt^.UsedFormattingFields) then
- begin
- s := '';
- for cb in fmt^.Border do
- if s = '' then s := GetEnumName(TypeInfo(TsCellBorder), ord(cb))
- else s := s + '+' + GetEnumName(TypeInfo(TsCellBorder), ord(cb));
- Result := Format('%s; %s', [Result, s]);
- end;
- if (uffBiDi in fmt^.UsedFormattingFields) then
- Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsBiDiMode), ord(fmt^.BiDiMode))]);
- if Result <> '' then Delete(Result, 1, 2);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the count of format records used all over the workbook
--------------------------------------------------------------------------------}
-function TsWorkbook.GetNumCellFormats: Integer;
-begin
- Result := FCellFormatList.Count;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns a pointer to the format record with the specified index
--------------------------------------------------------------------------------}
-function TsWorkbook.GetPointerToCellFormat(AIndex: Integer): PsCellFormat;
-begin
- if FCellFormatList.Count = 0 then
- raise Exception.Create('[TsWorkbook.GetPointerToCellFormat]: No format items.');
-
- if (AIndex < 0) or (AIndex >= FCellFormatList.Count) then
- AIndex := 0; // 0 is default format
- Result := FCellFormatList.Items[AIndex];
-end;
-
-{@@ ----------------------------------------------------------------------------
- Removes all cell formats from the workbook.
-
- If AKeepDefaultFormat is true then index 0 containing the default cell format
- is retained.
-
- Use carefully!
--------------------------------------------------------------------------------}
-procedure TsWorkbook.RemoveAllCellFormats(AKeepDefaultFormat: Boolean);
-var
- i: Integer;
-begin
- if AKeepDefaultFormat then
- for i := FCellFormatList.Count-1 downto 1 do
- FCellFormatList.Delete(i)
- else
- FCellFormatList.Clear;
-end;
-
-
-{ Conditional formats }
-
-function TsWorkbook.GetConditionalFormat(AIndex: Integer): TsConditionalFormat;
-begin
- Result := FConditionalFormatList[AIndex] as TsConditionalFormat;
-end;
-
-function TsWorkbook.GetNumConditionalFormats: Integer;
-begin
- Result := FConditionalFormatList.Count;
-end;
-
-
-{ Font handling }
-
-{@@ ----------------------------------------------------------------------------
- Adds a font to the font list. Returns the index in the font list.
-
- @param AFontName Name of the font (like 'Arial')
- @param ASize Size of the font in points
- @param AStyle Style of the font, a combination of TsFontStyle elements
- @param AColor RGB valoe of the font color
- @param APosition Specifies subscript or superscript text.
- @return Index of the font in the workbook's font list
--------------------------------------------------------------------------------}
-function TsWorkbook.AddFont(const AFontName: String; ASize: Single;
- AStyle: TsFontStyles; AColor: TsColor;
- APosition: TsFontPosition = fpNormal): Integer;
-var
- fnt: TsFont;
-begin
- fnt := TsFont.Create;
- fnt.FontName := AFontName;
- fnt.Size := ASize;
- fnt.Style := AStyle;
- fnt.Color := AColor;
- fnt.Position := APosition;
- Result := AddFont(fnt);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Adds a font to the font list. Returns the index in the font list.
-
- @param AFont TsFont record containing all font parameters
- @return Index of the font in the workbook's font list
--------------------------------------------------------------------------------}
-function TsWorkbook.AddFont(const AFont: TsFont): Integer;
-begin
- result := FFontList.Add(AFont);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Creates a new font as a copy of the font at the specified index.
- The new font is NOT YET added to the font list.
- If the user does not add the font to the font list he is responsibile for
- destroying it.
--------------------------------------------------------------------------------}
-function TsWorkbook.CloneFont(const AFontIndex: Integer): TsFont;
-var
- fnt: TsFont;
-begin
- Result := TsFont.Create;
- fnt := GetFont(AFontIndex);
- Result.FontName := fnt.FontName;
- Result.Size := fnt.Size;
- Result.Style := fnt.Style;
- Result.Color := fnt.Color;
- Result.Position := fnt.Position;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Deletes a font.
- Use with caution because this will screw up the font assignment to cells.
- The only legal reason to call this method is from a reader of a file format
- in which the missing font #4 of BIFF does exist.
--------------------------------------------------------------------------------}
-procedure TsWorkbook.DeleteFont(const AFontIndex: Integer);
-var
- fnt: TsFont;
-begin
- if AFontIndex < FFontList.Count then
- begin
- fnt := TsFont(FFontList.Items[AFontIndex]);
- if fnt <> nil then fnt.Free;
- FFontList.Delete(AFontIndex);
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Checks whether the font with the given specification is already contained in
- the font list. Returns the index, or -1 if not found.
-
- @param AFontName Name of the font (like 'Arial')
- @param ASize Size of the font in points
- @param AStyle Style of the font, a combination of TsFontStyle elements
- @param AColor RGB value of the font color
- @param APosition Specified subscript or superscript text.
- @return Index of the font in the font list, or -1 if not found.
--------------------------------------------------------------------------------}
-function TsWorkbook.FindFont(const AFontName: String; ASize: Single;
- AStyle: TsFontStyles; AColor: TsColor; APosition: TsFontPosition = fpNormal): Integer;
-begin
- Result := FindFontInList(FFontList, AFontName, ASize, AStyle, AColor, APosition);
-end;
-{
-const
- EPS = 1e-3;
-var
- fnt: TsFont;
-begin
- for Result := 0 to FFontList.Count-1 do
- begin
- fnt := TsFont(FFontList.Items[Result]);
- if (fnt <> nil) and
- SameText(AFontName, fnt.FontName) and
- SameValue(ASize, fnt.Size, EPS) and // careful when comparing floating point numbers
- (AStyle = fnt.Style) and
- (AColor = fnt.Color) and
- (APosition = fnt.Position)
- then
- exit;
- end;
- Result := -1;
-end;
- }
-
-{@@ ----------------------------------------------------------------------------
- Initializes the font list by adding 5 fonts:
-
- 0: default font
- 1: like default font, but blue and underlined (for hyperlinks)
- 2: like default font, but bold
- 3: like default font, but italic
--------------------------------------------------------------------------------}
-procedure TsWorkbook.InitFonts;
-var
- fntName: String;
- fntSize: Single;
-begin
- // Memorize old default font
- with TsFont(FFontList.Items[0]) do
- begin
- fntName := FontName;
- fntSize := Size;
- end;
-
- // Remove current font list
- RemoveAllFonts;
-
- // Build new font list
- SetDefaultFont(fntName, fntSize); // FONT0: Default font
- AddFont(fntName, fntSize, [fssUnderline], scBlue); // FONT1: Hyperlink font = blue & underlined
- AddFont(fntName, fntSize, [fssBold], scBlack); // FONT2: Bold font
- AddFont(fntName, fntSize, [fssItalic], scBlack); // FONT3: Italic font (not used directly)
-
- FBuiltinFontCount := FFontList.Count;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Clears the list of fonts and releases their memory.
--------------------------------------------------------------------------------}
-procedure TsWorkbook.RemoveAllFonts;
-var
- i: Integer;
- fnt: TsFont;
-begin
- for i := FFontList.Count-1 downto 0 do
- begin
- fnt := TsFont(FFontList.Items[i]);
- fnt.Free;
- FFontList.Delete(i);
- end;
- FBuiltinFontCount := 0;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Replaces the built-in font at a specific index with different font parameters
--------------------------------------------------------------------------------}
-procedure TsWorkbook.ReplaceFont(AFontIndex: Integer; AFontName: String;
- ASize: Single; AStyle: TsFontStyles; AColor: TsColor;
- APosition: TsFontPosition = fpNormal);
-var
- fnt: TsFont;
-begin
- if (AFontIndex < FBuiltinFontCount) then //and (AFontIndex <> 4) then
- begin
- fnt := TsFont(FFontList[AFontIndex]);
- fnt.FontName := AFontName;
- fnt.Size := ASize;
- fnt.Style := AStyle;
- fnt.Color := AColor;
- fnt.Position := APosition;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Defines the default font. This is the font with index 0 in the FontList.
- The next built-in fonts will have the same font name and size
--------------------------------------------------------------------------------}
-procedure TsWorkbook.SetDefaultFont(const AFontName: String; ASize: Single);
-var
- i: Integer;
-begin
- if FFontList.Count = 0 then
- AddFont(AFontName, ASize, [], scBlack)
- else
- for i:=0 to FBuiltinFontCount-1 do
- if (i <> 4) and (i < FFontList.Count) then // wp: why if font #4 relevant here ????
- with TsFont(FFontList[i]) do
- begin
- FontName := AFontName;
- Size := ASize;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the count of built-in fonts (default font, hyperlink font, bold font
- by default).
--------------------------------------------------------------------------------}
-function TsWorkbook.GetBuiltinFontCount: Integer;
-begin
- Result := FBuiltinFontCount;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the default font. This is the first font (index 0) in the font list
--------------------------------------------------------------------------------}
-function TsWorkbook.GetDefaultFont: TsFont;
-begin
- Result := GetFont(0);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the point size of the default font
--------------------------------------------------------------------------------}
-function TsWorkbook.GetDefaultFontSize: Single;
-begin
- Result := GetFont(0).Size;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the font with the given index.
-
- @param AIndex Index of the font to be considered
- @return Record containing all parameters of the font (or nil if not found).
--------------------------------------------------------------------------------}
-function TsWorkbook.GetFont(AIndex: Integer): TsFont;
-begin
- if (AIndex >= 0) and (AIndex < FFontList.Count) then
- Result := FFontList.Items[AIndex]
- else
- Result := nil;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns a string which identifies the font with a given index.
-
- @param AIndex Index of the font
- @return String with font name, font size etc.
--------------------------------------------------------------------------------}
-function TsWorkbook.GetFontAsString(AIndex: Integer): String;
-begin
- Result := fpsUtils.GetFontAsString(GetFont(AIndex));
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the count of registered fonts
--------------------------------------------------------------------------------}
-function TsWorkbook.GetFontCount: Integer;
-begin
- Result := FFontList.Count;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the hypertext font. This is font with index 6 in the font list
--------------------------------------------------------------------------------}
-function TsWorkbook.GetHyperlinkFont: TsFont;
-begin
- Result := GetFont(HYPERLINK_FONTINDEX);
-end;
-
-
-{@@ ----------------------------------------------------------------------------
- Adds a number format to the internal list. Returns the list index if already
- present, or creates a new format item and returns its index.
--------------------------------------------------------------------------------}
-function TsWorkbook.AddNumberFormat(AFormatStr: String): Integer;
-begin
- if AFormatStr = '' then
- Result := -1 // General number format is not stored
- else
- Result := TsNumFormatList(FNumFormatList).AddFormat(AFormatStr);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the parameters of the number format stored in the NumFormatList at the
- specified index.
- "General" number format is returned as nil.
--------------------------------------------------------------------------------}
-function TsWorkbook.GetNumberFormat(AIndex: Integer): TsNumFormatParams;
-begin
- if (AIndex >= 0) and (AIndex < FNumFormatList.Count) then
- Result := TsNumFormatParams(FNumFormatList.Items[AIndex])
- else
- Result := nil;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the count of number format records stored in the NumFormatList
--------------------------------------------------------------------------------}
-function TsWorkbook.GetNumberFormatCount: Integer;
-begin
- Result := FNumFormatList.Count;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Removes all numberformats
- Use carefully!
--------------------------------------------------------------------------------}
-procedure TsWorkbook.RemoveAllNumberFormats;
-var
- i: Integer;
- nfp: TsNumFormatParams;
-begin
- for i:= FEmbeddedObjList.Count-1 downto 0 do begin
- nfp := TsNumFormatParams(FNumFormatList[i]);
- FNumFormatList.Delete(i);
- nfp.Free;
- end;
-end;
-
{@@ ----------------------------------------------------------------------------
Calculates all formulas of the workbook.
@@ -9308,544 +7561,16 @@ begin
FOnChangeWorksheet(Self, GetWorksheetByIndex(AToIndex));
end;
-{@@ ----------------------------------------------------------------------------
- Writes the selected cells to a stream for usage in the clipboard.
- Transfer to the clipboard has do be done by the calling routine since
- fpspreadsheet does not "know" the system's clipboard.
--------------------------------------------------------------------------------}
-procedure TsWorkbook.CopyToClipboardStream(AStream: TStream;
- AFormat: TsSpreadsheetFormat; AParams: TsStreamParams = []);
-var
- clipbook: TsWorkbook;
- clipsheet: TsWorksheet;
- sel: TsCellRange;
- range: TsCellRangeArray;
- r, c: Cardinal;
- srccell, destcell: PCell;
-begin
- if AStream = nil then
- exit;
- if ActiveWorksheet = nil then
- exit;
+{$include fpspreadsheet_fmt.inc} // cell formatting
+{$include fpspreadsheet_fonts.inc} // fonts
+{$include fpspreadsheet_numfmt.inc} // number formats
+{$include fpspreadsheet_cf.inc} // conditional formatting
+{$include fpspreadsheet_comments.inc} // comments
+{$include fpspreadsheet_hyperlinks.inc} // hyperlinks
+{$include fpspreadsheet_embobj.inc} // embedded objects
+{$include fpspreadsheet_clipbrd.inc} // clipboard access
- // Create workbook which will be written to clipboard stream
- // Contains only the selected worksheet and the selected cells.
- clipbook := TsWorkbook.Create;
- try
- clipsheet := clipbook.AddWorksheet(ActiveWorksheet.Name);
- for sel in ActiveWorksheet.GetSelection do
- begin
- for r := sel.Row1 to sel.Row2 do
- for c := sel.Col1 to sel.Col2 do
- begin
- srccell := ActiveWorksheet.FindCell(r, c);
- if ActiveWorksheet.IsMerged(srccell) then
- srccell := ActiveWorksheet.FindMergeBase(srccell);
- if srccell <> nil then begin
- destcell := clipsheet.GetCell(r, c); // wp: why was there AddCell?
- clipsheet.CopyCell(srccell, destcell);
- end;
- end;
- end;
- // Select the same cells as in the source workbook.
- range := ActiveWorksheet.GetSelection;
- clipsheet.SetSelection(range);
- clipsheet.SelectCell(range[0].Row1, range[0].Col1);
-
- // Write this workbook to a stream. Set the parameter spClipboard to
- // indicate that this should be the special clipboard version of the stream.
- clipbook.WriteToStream(AStream, AFormat, AParams + [spClipboard]);
-
- if AFormat = sfCSV then
- AStream.WriteByte(0);
-
- // The calling routine which copies the stream to the clipboard requires
- // the stream to be at its beginning.
- AStream.Position := 0;
- finally
- clipbook.Free;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Copies the cells stored in the specified stream to the active worksheet.
- The provided stream contains data from the system's clipboard.
- Note that transfer from the clipboard to the stream has to be done by the
- calling routine since fpspreadsheet does not "know" the system's clipboard.
--------------------------------------------------------------------------------}
-procedure TsWorkbook.PasteFromClipboardStream(AStream: TStream;
- AFormat: TsSpreadsheetFormat; AOperation: TsCopyOperation;
- AParams: TsStreamParams = []; ATransposed: Boolean = false);
-var
- clipbook: TsWorkbook;
- clipsheet: TsWorksheet;
- sel: TsCellRange;
- selArray: TsCellRangeArray;
- r, c: LongInt;
- dr, dc: LongInt;
- srcCell, destCell: PCell;
- i: Integer; // counter
- ncs, nrs: Integer; // Num cols source, num rows source, ...
- //ncd, nrd: Integer;
- rdest, cdest: Integer; // row and column index at destination
- nselS, nselD: Integer; // count of selected blocks
-begin
- Unused(ATransposed);
-
- if AStream = nil then
- exit;
-
- if ActiveWorksheet = nil then
- exit;
-
- if AOperation = coNone then
- exit;
-
- // Create workbook into which the clipboard stream will write
- clipbook := TsWorkbook.Create;
- try
- clipbook.Options := clipbook.Options + [boReadFormulas];
- // Read stream into this temporary workbook
- // Set last parameter (ClipboardMode) to TRUE to activate special format
- // treatment for clipboard, if needed.
- clipbook.ReadFromStream(AStream, AFormat, AParams + [spClipboard]);
- clipsheet := clipbook.GetWorksheetByIndex(0);
-
- // count of blocks in source (clipboard sheet)
- nselS := clipsheet.GetSelectionCount;
- // count of selected blocks at destination
- nselD := ActiveWorksheet.GetSelectionCount;
-
- // -------------------------------------------------------------------------
- // Case (1): Destination is a single cell, source can be any shape
- // --> Source shape is duplicated starting at destination
- // -------------------------------------------------------------------------
- if (nselD = 1)
- and (ActiveWorksheet.GetSelection[0].Col1 = ActiveWorksheet.GetSelection[0].Col2)
- and (ActiveWorksheet.GetSelection[0].Row1 = ActiveWorksheet.GetSelection[0].Row2)
- then begin
- // Find offset of active cell to left/top cell in clipboard sheet
- dr := LongInt(ActiveWorksheet.ActiveCellRow) - clipsheet.ActiveCellRow;
- dc := LongInt(ActiveWorksheet.ActiveCellCol) - clipsheet.ActiveCellCol;
- // Copy cells from clipboard sheet to active worksheet
- // Shift them such that top/left of clipboard sheet is at active cell
- for srcCell in clipsheet.Cells do
- begin
- r := LongInt(srcCell^.Row) + dr;
- c := LongInt(srcCell^.Col) + dc;
- destcell := ActiveWorksheet.GetCell(r, c);
- case AOperation of
- coCopyCell : ActiveWorksheet.CopyCell(srcCell, destCell);
- coCopyValue : ActiveWorksheet.CopyValue(srcCell, destCell);
- coCopyFormat : ActiveWorksheet.CopyFormat(srcCell, destCell);
- coCopyFormula : ActiveWorksheet.CopyFormula(srcCell, destCell);
- end;
- end;
- // Select all copied cells
- sel := Range(Cardinal(-1), Cardinal(-1), Cardinal(-1), Cardinal(-1));
- SetLength(selArray, nselS);
- for i := 0 to nselS-1 do
- begin
- sel := clipsheet.GetSelection[i];
- selArray[i].Row1 := LongInt(sel.Row1) + dr;
- selArray[i].Col1 := LongInt(sel.Col1) + dc;
- selArray[i].Row2 := LongInt(sel.Row2) + dr;
- selArray[i].Col2 := LongInt(sel.Col2) + dc;
- end;
- ActiveWorksheet.SetSelection(selArray);
- // Select active cell. If not found in the file, let's use the last cell of the selections
- if (clipsheet.ActiveCellRow <> 0) and (clipsheet.ActiveCellCol <> 0) then
- begin
- r := clipsheet.ActiveCellRow;
- c := clipsheet.ActiveCellCol;
- end else
- begin
- r := LongInt(sel.Row2);
- c := LongInt(sel.Col2);
- end;
- if (r <> -1) and (c <> -1) then
- ActiveWorksheet.SelectCell(r + dr, c + dc);
- end
- else
- // -------------------------------------------------------------------------
- // Case (2): Source is a single block (not necessarily a cell), Dest can be
- // any shape --> source is tiled into destination
- // -------------------------------------------------------------------------
-// if nselS = 1 then
- begin
- // size of source block
- with clipsheet do
- begin
- ncs := LongInt(GetLastColIndex(true)) - LongInt(GetFirstColIndex(true)) + 1;
- nrs := LongInt(GetLastRowIndex(true)) - LongInt(GetFirstRowIndex(true)) + 1;
- end;
- // Iterate over all destination blocks
- for i := 0 to nselD-1 do
- begin
- (*
- // size of currently selected block at destination
- with ActiveWorksheet.GetSelection[i] do
- begin
- ncd := Integer(Col2) - Integer(Col1) + 1;
- nrd := Integer(Row2) - Integer(Row1) + 1;
- end;
- *)
- r := ActiveWorksheet.GetSelection[i].Row1;
- while r <= longint(ActiveWorksheet.GetSelection[i].Row2) do begin
- c := ActiveWorksheet.GetSelection[i].Col1;
- while c <= longint(ActiveWorksheet.GetSelection[i].Col2) do begin
- dr := r - clipsheet.GetFirstRowIndex;
- dc := c - clipsheet.GetFirstColIndex;
- for srccell in clipsheet.Cells do
- begin
- rdest := longint(srccell^.Row) + dr;
- if rdest > integer(ActiveWorksheet.GetSelection[i].Row2) then
- Continue;
- cdest := longint(srcCell^.Col) + dc;
- if cdest > integer(ActiveWorksheet.GetSelection[i].Col2) then
- Continue;
- destcell := ActiveWorksheet.GetCell(
- LongInt(srcCell^.Row) + dr,
- LongInt(srcCell^.Col) + dc
- );
- case AOperation of
- coCopyCell : ActiveWorksheet.CopyCell(srcCell, destCell);
- coCopyValue : ActiveWorksheet.CopyValue(srcCell, destCell);
- coCopyFormat : ActiveWorksheet.CopyFormat(srcCell, destCell);
- coCopyFormula : ActiveWorksheet.CopyFormula(srcCell, destCell);
- end;
- end; // for srcCell
- inc(c, ncs);
- end; // while c...
- inc(r, nrs);
- end; // while r...
- end; // for i
- // No need to select copied cells - they already are.
- end ;
- {
- else
- // -------------------------------------------------------------------------
- // Other arrangements of source and destination are not supported
- // -------------------------------------------------------------------------
- raise Exception.Create('This arrangement of source and destination '+
- 'cells in not supported for copy & paste');
- }
- finally
- clipbook.Free;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Creates a new "embedded" stream and loads the specified file.
- Returns the index of the embedded file item.
- Image dimensions are converted to workbook units.
--------------------------------------------------------------------------------}
-function TsWorkbook.AddEmbeddedObj(const AFileName: String): Integer;
-var
- obj: TsEmbeddedObj = nil;
-begin
- if not FileExists(AFileName) then
- begin
- AddErrorMsg(rsFileNotFound, [AFileName]);
- Result := -1;
- exit;
- end;
-
- obj := TsEmbeddedObj.Create;
- if obj.LoadFromFile(AFileName) then
- begin
- obj.ImageWidth := ConvertUnits(obj.ImageWidth, suInches, FUnits);
- obj.ImageHeight := ConvertUnits(obj.ImageHeight, suInches, FUnits);
- Result := FEmbeddedObjList.Add(obj)
- end else
- begin
- AddErrorMsg(rsFileFormatNotSupported, [AFileName]);
- obj.Free;
- Result := -1;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Creates a new "embedded" stream and copies the specified stream to it.
- Returns the index of the embedded object.
--------------------------------------------------------------------------------}
-function TsWorkbook.AddEmbeddedObj(AStream: TStream;
- const AName: String = ''; ASize: Int64 = -1): Integer;
-var
- obj: TsEmbeddedObj = nil;
-begin
- obj := TsEmbeddedObj.Create;
- if obj.LoadFromStream(AStream, AName, ASize) then
- begin
- obj.ImageWidth := ConvertUnits(obj.ImageWidth, suInches, FUnits);
- obj.ImageHeight := ConvertUnits(obj.ImageHeight, suInches, FUnits);
- Result := FEmbeddedObjList.Add(obj)
- end else
- begin
- AddErrorMsg(rsImageFormatNotSupported);
- obj.Free;
- Result := -1;
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Checks whether an embedded object with the specified file name already exists.
- If yes, returns its index in the object list, or -1 if no.
--------------------------------------------------------------------------------}
-function TsWorkbook.FindEmbeddedObj(const AFileName: String): Integer;
-var
- obj: TsEmbeddedObj;
-begin
- for Result:=0 to FEmbeddedObjList.Count-1 do
- begin
- obj := TsEmbeddedObj(FEmbeddedObjList[Result]);
- if obj.FileName = AFileName then
- exit;
- end;
- Result := -1;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the embedded object stored in the embedded object list at the
- specified index.
--------------------------------------------------------------------------------}
-function TsWorkbook.GetEmbeddedObj(AIndex: Integer): TsEmbeddedObj;
-begin
- Result := TsEmbeddedObj(FEmbeddedObjList[AIndex]);
-end;
-
-
-{@@ ----------------------------------------------------------------------------
- Returns the count of embedded objects
--------------------------------------------------------------------------------}
-function TsWorkbook.GetEmbeddedObjCount: Integer;
-begin
- Result := FEmbeddedObjList.Count;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns true if there is at least one worksheet with an embedded images.
--------------------------------------------------------------------------------}
-function TsWorkbook.HasEmbeddedSheetImages: Boolean;
-var
- i: Integer;
- sheet: TsWorksheet;
-begin
- Result := true;
- for i:=0 to FWorksheets.Count-1 do
- begin
- sheet := TsWorksheet(FWorksheets.Items[i]);
- if sheet.GetImageCount > 0 then
- exit;
- end;
- Result := false;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Removes all embedded objects
--------------------------------------------------------------------------------}
-procedure TsWorkbook.RemoveAllEmbeddedObj;
-var
- i: Integer;
-begin
- for i:= 0 to FEmbeddedObjList.Count-1 do
- TsEmbeddedObj(FEmbeddedObjList[i]).Free;
- FEmbeddedObjList.Clear;
-end;
-
-
- (*
-{@@ ----------------------------------------------------------------------------
- Converts a fpspreadsheet color into into a string RRGGBB.
- Note that colors are written to xls files as ABGR (where A is 0).
- if the color is scRGBColor the color value is taken from the argument
- ARGBColor, otherwise from the palette entry for the color index.
--------------------------------------------------------------------------------}
-function TsWorkbook.FPSColorToHexString(AColor: TsColor;
- ARGBColor: TFPColor): string;
-type
- TRgba = packed record Red, Green, Blue, A: Byte end;
-var
- colorvalue: TsColorValue;
- r,g,b: Byte;
-begin
- if AColor = scRGBColor then
- begin
- r := ARGBColor.Red div $100;
- g := ARGBColor.Green div $100;
- b := ARGBColor.Blue div $100;
- end else
- begin
- colorvalue := GetPaletteColor(AColor);
- r := TRgba(colorvalue).Red;
- g := TRgba(colorvalue).Green;
- b := TRgba(colorvalue).Blue;
- end;
- Result := Format('%.2x%.2x%.2x', [r, g, b]);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the name of the color pointed to by the given color index.
- If the name is not known the hex string is returned as RRGGBB.
-
- @param AColorIndex Palette index of the color considered
- @return String identifying the color (a color name or, if unknown, a
- string showing the rgb components
--------------------------------------------------------------------------------}
-function TsWorkbook.GetColorName(AColorIndex: TsColor): string;
-begin
- case AColorIndex of
- scTransparent:
- Result := 'transparent';
- scNotDefined:
- Result := 'not defined';
- else
- GetColorName(GetPaletteColor(AColorIndex), Result);
- end;
-end;
-
-{@@ ----------------------------------------------------------------------------
- Returns the name of an rgb color value.
- If the name is not known the hex string is returned as RRGGBB.
-
- @param AColorValue rgb value of the color considered
- @param AName String identifying the color (a color name or, if
- unknown, a string showing the rgb components
--------------------------------------------------------------------------------}
-procedure TsWorkbook.GetColorName(AColorValue: TsColorValue; out AName: String);
-type
- TRgba = packed record R,G,B,A: Byte; end;
-var
- i: Integer;
-begin
- // Find color value in default palette
- for i:=0 to High(DEFAULT_PALETTE) do
- // if found: get the color name from the default color names array
- if DEFAULT_PALETTE[i] = AColorValue then
- begin
- AName := DEFAULT_COLORNAMES[i];
- exit;
- end;
-
- // if not found: construct a string from rgb byte values.
- with TRgba(AColorValue) do
- AName := Format('%.2x%.2x%.2x', [R, G, B]);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Converts the palette color of the given index to a string that can be used
- in HTML code. For ODS.
-
- @param AColorIndex Index of the color considered
- @return A HTML-compatible string identifying the color.
- "Red", for example, is returned as '#FF0000';
--------------------------------------------------------------------------------}
-function TsWorkbook.GetPaletteColorAsHTMLStr(AColorIndex: TsColor): String;
-begin
- Result := ColorToHTMLColorStr(GetPaletteColor(AColorIndex));
-end;
-
-{@@ ----------------------------------------------------------------------------
- Instructs the workbook to take colors from the default palette. Is called
- from ODS reader because ODS does not have a palette. Without a palette the
- color constants (scRed etc.) would not be correct any more.
--------------------------------------------------------------------------------}
-procedure TsWorkbook.UseDefaultPalette;
-begin
- UsePalette(@DEFAULT_PALETTE, Length(DEFAULT_PALETTE), false);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Instructs the Workbook to take colors from the palette pointed to by the
- parameter APalette
- This palette is only used for writing. When reading the palette found in the
- file is used.
-
- @param APalette Pointer to the array of TsColorValue numbers which will
- become the new palette
- @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.
--------------------------------------------------------------------------------}
-procedure TsWorkbook.UsePalette(APalette: PsPalette; APaletteCount: Word;
- ABigEndian: Boolean);
-var
- i: Integer;
-begin
- if APaletteCount > 64 then
- raise EFPSpreadsheet.Create('Due to Excel-compatibility, palettes cannot have more then 64 colors.');
-
- {$IFOPT R+}
- {$DEFINE RNGCHECK}
- {$ENDIF}
- SetLength(FPalette, APaletteCount);
- if ABigEndian then
- for i:=0 to APaletteCount-1 do
- {$IFDEF RNGCHECK}
- {$R-}
- {$ENDIF}
- FPalette[i] := LongRGBToExcelPhysical(APalette^[i])
- {$IFDEF RNGCHECK}
- {$R+}
- {$ENDIF}
- else
- for i:=0 to APaletteCount-1 do
- {$IFDEF RNGCHECK}
- {$R-}
- {$ENDIF}
- FPalette[i] := APalette^[i];
- {$IFDEF RNGCHECK}
- {$R+}
- {$ENDIF}
-
- if Assigned(FOnChangePalette) then FOnChangePalette(self);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Checks whether a given color is used somewhere within the entire workbook
-
- @param AColorIndex Palette index of the color
- @result True if the color is used by at least one cell, false if not.
--------------------------------------------------------------------------------}
-function TsWorkbook.UsesColor(AColorIndex: TsColor): Boolean;
-var
- sheet: TsWorksheet;
- cell: PCell;
- i: Integer;
- fnt: TsFont;
- b: TsCellBorder;
- fmt: PsCellFormat;
-begin
- Result := true;
- for i:=0 to GetWorksheetCount-1 do
- begin
- sheet := GetWorksheetByIndex(i);
- for cell in sheet.Cells do
- begin
- fmt := GetPointerToCellFormat(cell^.FormatIndex);
- if (uffBackground in fmt^.UsedFormattingFields) then
- begin
- if fmt^.Background.BgColor = AColorIndex then exit;
- if fmt^.Background.FgColor = AColorIndex then exit;
- end;
- if (uffBorder in fmt^.UsedFormattingFields) then
- for b in TsCellBorders do
- if fmt^.BorderStyles[b].Color = AColorIndex then
- exit;
- if (uffFont in fmt^.UsedFormattingFields) then
- begin
- fnt := GetFont(fmt^.FontIndex);
- if fnt.Color = AColorIndex then
- exit;
- end;
- end;
- end;
- Result := false;
-end;
- *)
end. {** End Unit: fpspreadsheet }
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc b/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc
index 5169de677..cc644ff7d 100644
--- a/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc
+++ b/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc
@@ -1,5 +1,11 @@
{ Included by fpspreadsheet.pas }
+{ Code for conditional formatting }
+
+{==============================================================================}
+{ TsWorksheet code for conditional formats }
+{==============================================================================}
+
procedure StoreCFIndexInCells(AWorksheet: TsWorksheet; AIndex: Integer;
ARange: TsCellRange);
var
@@ -17,6 +23,7 @@ begin
end;
end;
+
{@@ ----------------------------------------------------------------------------
Creates a conditional format item for the cells given by ARange.
The condition specified here must not require parameters, e.g. cfcEmpty
@@ -32,6 +39,7 @@ begin
StoreCFIndexInCells(self, Result, ARange);
end;
+
{@@ ----------------------------------------------------------------------------
Creates a conditional format item for the cells given by ARange.
The condition specified must require one parameter, e.g. cfcEqual,
@@ -48,6 +56,7 @@ begin
StoreCFIndexInCells(self, Result, ARange);
end;
+
{@@ ----------------------------------------------------------------------------
Creates a conditional format item for the cells given by ARange.
The condition specified must requored two parameters, e.g. cfcBetween,
@@ -65,6 +74,7 @@ begin
StoreCFIndexInCells(self, Result, ARange);
end;
+
{@@ ----------------------------------------------------------------------------
Writes the conditional format "color range"
-------------------------------------------------------------------------------}
@@ -76,6 +86,7 @@ begin
StoreCFIndexInCells(Self, Result, ARange);
end;
+
function TsWorksheet.WriteColorRange(ARange: TsCellRange;
AStartColor, ACenterColor, AEndColor: TsColor): Integer;
begin
@@ -84,6 +95,7 @@ begin
StoreCFIndexInCells(Self, Result, ARange);
end;
+
function TsWorksheet.WriteColorRange(ARange: TsCellRange;
AStartColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
AEndColor: TsColor; AEndKind: TsCFValueKind; AEndValue: Double): Integer;
@@ -94,6 +106,7 @@ begin
StoreCFIndexInCells(Self, Result, ARange);
end;
+
function TsWorksheet.WriteColorRange(ARange: TsCellRange;
AStartColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
ACenterColor: TsColor; ACenterKind: TsCFValueKind; ACenterValue: Double;
@@ -106,6 +119,7 @@ begin
StoreCFIndexInCells(Self, Result, ARange);
end;
+
{@@ ----------------------------------------------------------------------------
Writes the conditional format "data bars"
-------------------------------------------------------------------------------}
@@ -115,6 +129,7 @@ begin
StoreCFIndexInCells(self, Result, ARange);
end;
+
function TsWorksheet.WriteDataBars(ARange: TscellRange; ABarColor: TsColor;
AStartKind: TsCFValueKind; AStartValue: Double;
AEndKind: TsCFValueKind; AEndValue: Double): Integer;
@@ -127,3 +142,19 @@ begin
StoreCFIndexInCells(self, Result, ARange);
end;
+
+{==============================================================================}
+{ TsWorkbook code for conditional formats }
+{==============================================================================}
+
+function TsWorkbook.GetConditionalFormat(AIndex: Integer): TsConditionalFormat;
+begin
+ Result := FConditionalFormatList[AIndex] as TsConditionalFormat;
+end;
+
+
+function TsWorkbook.GetNumConditionalFormats: Integer;
+begin
+ Result := FConditionalFormatList.Count;
+end;
+
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet_clipbrd.inc b/components/fpspreadsheet/source/common/fpspreadsheet_clipbrd.inc
new file mode 100644
index 000000000..e83a5eec7
--- /dev/null
+++ b/components/fpspreadsheet/source/common/fpspreadsheet_clipbrd.inc
@@ -0,0 +1,218 @@
+{ Included by fpspreadsheet.pas }
+
+{ Clipboard access }
+
+{@@ ----------------------------------------------------------------------------
+ Writes the selected cells to a stream for usage in the clipboard.
+ Transfer to the clipboard has do be done by the calling routine since
+ fpspreadsheet does not "know" the system's clipboard.
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.CopyToClipboardStream(AStream: TStream;
+ AFormat: TsSpreadsheetFormat; AParams: TsStreamParams = []);
+var
+ clipbook: TsWorkbook;
+ clipsheet: TsWorksheet;
+ sel: TsCellRange;
+ range: TsCellRangeArray;
+ r, c: Cardinal;
+ srccell, destcell: PCell;
+begin
+ if AStream = nil then
+ exit;
+
+ if ActiveWorksheet = nil then
+ exit;
+
+ // Create workbook which will be written to clipboard stream
+ // Contains only the selected worksheet and the selected cells.
+ clipbook := TsWorkbook.Create;
+ try
+ clipsheet := clipbook.AddWorksheet(ActiveWorksheet.Name);
+ for sel in ActiveWorksheet.GetSelection do
+ begin
+ for r := sel.Row1 to sel.Row2 do
+ for c := sel.Col1 to sel.Col2 do
+ begin
+ srccell := ActiveWorksheet.FindCell(r, c);
+ if ActiveWorksheet.IsMerged(srccell) then
+ srccell := ActiveWorksheet.FindMergeBase(srccell);
+ if srccell <> nil then begin
+ destcell := clipsheet.GetCell(r, c); // wp: why was there AddCell?
+ clipsheet.CopyCell(srccell, destcell);
+ end;
+ end;
+ end;
+ // Select the same cells as in the source workbook.
+ range := ActiveWorksheet.GetSelection;
+ clipsheet.SetSelection(range);
+ clipsheet.SelectCell(range[0].Row1, range[0].Col1);
+
+ // Write this workbook to a stream. Set the parameter spClipboard to
+ // indicate that this should be the special clipboard version of the stream.
+ clipbook.WriteToStream(AStream, AFormat, AParams + [spClipboard]);
+
+ if AFormat = sfCSV then
+ AStream.WriteByte(0);
+
+ // The calling routine which copies the stream to the clipboard requires
+ // the stream to be at its beginning.
+ AStream.Position := 0;
+ finally
+ clipbook.Free;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Copies the cells stored in the specified stream to the active worksheet.
+ The provided stream contains data from the system's clipboard.
+ Note that transfer from the clipboard to the stream has to be done by the
+ calling routine since fpspreadsheet does not "know" the system's clipboard.
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.PasteFromClipboardStream(AStream: TStream;
+ AFormat: TsSpreadsheetFormat; AOperation: TsCopyOperation;
+ AParams: TsStreamParams = []; ATransposed: Boolean = false);
+var
+ clipbook: TsWorkbook;
+ clipsheet: TsWorksheet;
+ sel: TsCellRange;
+ selArray: TsCellRangeArray;
+ r, c: LongInt;
+ dr, dc: LongInt;
+ srcCell, destCell: PCell;
+ i: Integer; // counter
+ ncs, nrs: Integer; // Num cols source, num rows source, ...
+ //ncd, nrd: Integer;
+ rdest, cdest: Integer; // row and column index at destination
+ nselS, nselD: Integer; // count of selected blocks
+begin
+ Unused(ATransposed);
+
+ if AStream = nil then
+ exit;
+
+ if ActiveWorksheet = nil then
+ exit;
+
+ if AOperation = coNone then
+ exit;
+
+ // Create workbook into which the clipboard stream will write
+ clipbook := TsWorkbook.Create;
+ try
+ clipbook.Options := clipbook.Options + [boReadFormulas];
+ // Read stream into this temporary workbook
+ // Set last parameter (ClipboardMode) to TRUE to activate special format
+ // treatment for clipboard, if needed.
+ clipbook.ReadFromStream(AStream, AFormat, AParams + [spClipboard]);
+ clipsheet := clipbook.GetWorksheetByIndex(0);
+
+ // count of blocks in source (clipboard sheet)
+ nselS := clipsheet.GetSelectionCount;
+ // count of selected blocks at destination
+ nselD := ActiveWorksheet.GetSelectionCount;
+
+ // -------------------------------------------------------------------------
+ // Case (1): Destination is a single cell, source can be any shape
+ // --> Source shape is duplicated starting at destination
+ // -------------------------------------------------------------------------
+ if (nselD = 1)
+ and (ActiveWorksheet.GetSelection[0].Col1 = ActiveWorksheet.GetSelection[0].Col2)
+ and (ActiveWorksheet.GetSelection[0].Row1 = ActiveWorksheet.GetSelection[0].Row2)
+ then begin
+ // Find offset of active cell to left/top cell in clipboard sheet
+ dr := LongInt(ActiveWorksheet.ActiveCellRow) - clipsheet.ActiveCellRow;
+ dc := LongInt(ActiveWorksheet.ActiveCellCol) - clipsheet.ActiveCellCol;
+ // Copy cells from clipboard sheet to active worksheet
+ // Shift them such that top/left of clipboard sheet is at active cell
+ for srcCell in clipsheet.Cells do
+ begin
+ r := LongInt(srcCell^.Row) + dr;
+ c := LongInt(srcCell^.Col) + dc;
+ destcell := ActiveWorksheet.GetCell(r, c);
+ case AOperation of
+ coCopyCell : ActiveWorksheet.CopyCell(srcCell, destCell);
+ coCopyValue : ActiveWorksheet.CopyValue(srcCell, destCell);
+ coCopyFormat : ActiveWorksheet.CopyFormat(srcCell, destCell);
+ coCopyFormula : ActiveWorksheet.CopyFormula(srcCell, destCell);
+ end;
+ end;
+ // Select all copied cells
+ sel := Range(Cardinal(-1), Cardinal(-1), Cardinal(-1), Cardinal(-1));
+ SetLength(selArray, nselS);
+ for i := 0 to nselS-1 do
+ begin
+ sel := clipsheet.GetSelection[i];
+ selArray[i].Row1 := LongInt(sel.Row1) + dr;
+ selArray[i].Col1 := LongInt(sel.Col1) + dc;
+ selArray[i].Row2 := LongInt(sel.Row2) + dr;
+ selArray[i].Col2 := LongInt(sel.Col2) + dc;
+ end;
+ ActiveWorksheet.SetSelection(selArray);
+ // Select active cell. If not found in the file, let's use the last cell of the selections
+ if (clipsheet.ActiveCellRow <> 0) and (clipsheet.ActiveCellCol <> 0) then
+ begin
+ r := clipsheet.ActiveCellRow;
+ c := clipsheet.ActiveCellCol;
+ end else
+ begin
+ r := LongInt(sel.Row2);
+ c := LongInt(sel.Col2);
+ end;
+ if (r <> -1) and (c <> -1) then
+ ActiveWorksheet.SelectCell(r + dr, c + dc);
+ end
+ else
+ // -------------------------------------------------------------------------
+ // Case (2): Source is a single block (not necessarily a cell), Dest can be
+ // any shape --> source is tiled into destination
+ // -------------------------------------------------------------------------
+// if nselS = 1 then
+ begin
+ // size of source block
+ with clipsheet do
+ begin
+ ncs := LongInt(GetLastColIndex(true)) - LongInt(GetFirstColIndex(true)) + 1;
+ nrs := LongInt(GetLastRowIndex(true)) - LongInt(GetFirstRowIndex(true)) + 1;
+ end;
+ // Iterate over all destination blocks
+ for i := 0 to nselD-1 do
+ begin
+ r := ActiveWorksheet.GetSelection[i].Row1;
+ while r <= longint(ActiveWorksheet.GetSelection[i].Row2) do begin
+ c := ActiveWorksheet.GetSelection[i].Col1;
+ while c <= longint(ActiveWorksheet.GetSelection[i].Col2) do begin
+ dr := r - clipsheet.GetFirstRowIndex;
+ dc := c - clipsheet.GetFirstColIndex;
+ for srccell in clipsheet.Cells do
+ begin
+ rdest := longint(srccell^.Row) + dr;
+ if rdest > integer(ActiveWorksheet.GetSelection[i].Row2) then
+ Continue;
+ cdest := longint(srcCell^.Col) + dc;
+ if cdest > integer(ActiveWorksheet.GetSelection[i].Col2) then
+ Continue;
+ destcell := ActiveWorksheet.GetCell(
+ LongInt(srcCell^.Row) + dr,
+ LongInt(srcCell^.Col) + dc
+ );
+ case AOperation of
+ coCopyCell : ActiveWorksheet.CopyCell(srcCell, destCell);
+ coCopyValue : ActiveWorksheet.CopyValue(srcCell, destCell);
+ coCopyFormat : ActiveWorksheet.CopyFormat(srcCell, destCell);
+ coCopyFormula : ActiveWorksheet.CopyFormula(srcCell, destCell);
+ end;
+ end; // for srcCell
+ inc(c, ncs);
+ end; // while c...
+ inc(r, nrs);
+ end; // while r...
+ end; // for i
+ // No need to select copied cells - they already are.
+ end ;
+ finally
+ clipbook.Free;
+ end;
+end;
+
+
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet_comments.inc b/components/fpspreadsheet/source/common/fpspreadsheet_comments.inc
new file mode 100644
index 000000000..62068dccf
--- /dev/null
+++ b/components/fpspreadsheet/source/common/fpspreadsheet_comments.inc
@@ -0,0 +1,120 @@
+{ Included by fpspreadsheet.pas }
+
+{ Contains code for comments }
+
+
+{@@ ----------------------------------------------------------------------------
+ Checks whether a cell contains a comment and returns a pointer to the
+ comment data.
+
+ @param ACell Pointer to the cell
+ @return Pointer to the TsComment record (nil, if the cell does not have a
+ comment)
+-------------------------------------------------------------------------------}
+function TsWorksheet.FindComment(ACell: PCell): PsComment;
+begin
+ if HasComment(ACell) then
+ Result := PsComment(FComments.FindByRowCol(ACell^.Row, ACell^.Col))
+ else
+ Result := nil;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Checks whether a specific cell contains a comment
+-------------------------------------------------------------------------------}
+function TsWorksheet.HasComment(ACell: PCell): Boolean;
+begin
+ Result := (ACell <> nil) and (cfHasComment in ACell^.Flags);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the comment text attached to a specific cell
+
+ @param ARow (0-based) index to the row
+ @param ACol (0-based) index to the column
+ @return Text assigned to the cell as a comment
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadComment(ARow, ACol: Cardinal): String;
+var
+ comment: PsComment;
+begin
+ Result := '';
+ comment := PsComment(FComments.FindByRowCol(ARow, ACol));
+ if comment <> nil then
+ Result := comment^.Text;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the comment text attached to a specific cell
+
+ @param ACell Pointer to the cell
+ @return Text assigned to the cell as a comment
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadComment(ACell: PCell): String;
+var
+ comment: PsComment;
+begin
+ Result := '';
+ comment := FindComment(ACell);
+ if comment <> nil then
+ Result := comment^.Text;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Removes the comment from a cell and releases the memory occupied by the node.
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.RemoveComment(ACell: PCell);
+begin
+ if HasComment(ACell) then
+ begin
+ FComments.DeleteComment(ACell^.Row, ACell^.Col);
+ Exclude(ACell^.Flags, cfHasComment);
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds a comment to a specific cell
+
+ @param ARow (0-based) row index of the cell
+ @param ACol (0-based) column index of the cell
+ @param AText Comment text
+ @return Pointer to the cell containing the comment
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteComment(ARow, ACol: Cardinal; AText: String): PCell;
+begin
+ Result := GetCell(ARow, ACol);
+ WriteComment(Result, AText);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds a comment to a specific cell
+
+ @param ACell Pointer to the cell
+ @param AText Comment text
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.WriteComment(ACell: PCell; AText: String);
+begin
+ if ACell = nil then
+ exit;
+
+ // Remove the comment if an empty string is passed
+ if AText = '' then
+ begin
+ RemoveComment(ACell);
+ exit;
+ end;
+
+ // Add new comment record
+ FComments.AddComment(ACell^.Row, ACell^.Col, AText);
+ Include(ACell^.Flags, cfHasComment);
+
+ ChangedCell(ACell^.Row, ACell^.Col);
+
+end;
+
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet_embobj.inc b/components/fpspreadsheet/source/common/fpspreadsheet_embobj.inc
new file mode 100644
index 000000000..4b553f6e0
--- /dev/null
+++ b/components/fpspreadsheet/source/common/fpspreadsheet_embobj.inc
@@ -0,0 +1,456 @@
+{ Included by fpspreadsheet.pas }
+
+{ Code for embedded objects (images) }
+
+{==============================================================================}
+{ TsWorksheet code for embedded objects }
+{==============================================================================}
+
+{@@ ----------------------------------------------------------------------------
+ Calculates the position of the image with given index relative to the cell
+ containing the top/left corner of the image.
+
+ @@param x worksheet-relative coordinate of the left image edge, in workbook units
+ @@param y worksheet-relative coordinate of the top image edge, in workbook units
+ @@param ARow Index of the row containing the top/left corner of the image
+ @@param ACol Index of the column containing the top/left corner of the image
+ @@param ARowOffset Distance, in workbook units, between top cell and image borders
+ @@param AColOffset Distance, in workbook units, between left cell and image borders
+ @@param AScaleX Scaling factor for the image width
+ @@param AScaleY Scaling factor for the image height
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.CalcImageCell(AIndex: Integer; x, y, AWidth, AHeight: Double;
+ out ARow, ACol: Cardinal; out ARowOffs, AColOffs, AScaleX, AScaleY: Double);
+// All lengths are in workbook units!
+var
+ colW, rowH, sum: Double;
+ embobj: TsEmbeddedObj;
+begin
+ ACol := 0;
+ sum := 0;
+ colW := GetColWidth(0, FWorkbook.Units);
+ while (sum + colW < x) do begin
+ sum := sum + colW;
+ inc(ACol);
+ colW := GetColWidth(ACol, FWorkbook.Units);
+ end;
+ AColOffs := x - sum;
+
+ ARow := 0;
+ sum := 0;
+ rowH := CalcRowHeight(0);
+ while (sum + rowH < y) do begin
+ sum := sum + rowH;
+ inc(ARow);
+ rowH := CalcRowHeight(ARow);
+ end;
+ ARowOffs := y - sum;
+
+ embObj := FWorkbook.GetEmbeddedObj(AIndex);
+ AScaleX := AWidth / embObj.ImageWidth;
+ AScaleY := AHeight / embObj.ImageHeight;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Calculates image extent
+
+ @param AIndex Index of the image into the worksheet's image list
+ @param UsePixels if TRUE then pixels are used for calculation - this improves
+ the display of the images in Excel
+ @param ARow1 Index of the row containing the top edge of the image
+ @param ACol1 Index of the column containing the left edege of the image
+ @param ARow2 Index of the row containing the right edge of the image
+ @param ACol2 Index of the column containing the bottom edge of the image
+ @param ARowOffs1 Distance between the top edge of image and row 1
+ @param AColOffs1 Distance between the left edge of image and column 1
+ @param ARowOffs2 Distance between the bottom edge of image and top of row 2
+ @param AColOffs2 Distance between the right edge of image and left of col 2
+ @param x Absolute coordinate of left edge of image
+ @param y Absolute coordinate of top edge of image
+ @param AWidth Width of the image
+ @param AHeight Height of the image
+
+ All dimensions are in workbook units
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.CalcImageExtent(AIndex: Integer; UsePixels: Boolean;
+ out ARow1, ACol1, ARow2, ACol2: Cardinal;
+ out ARowOffs1, AColOffs1, ARowOffs2, AColOffs2: Double;
+ out x,y, AWidth, AHeight: Double);
+var
+ img: TsImage;
+ obj: TsEmbeddedObj;
+ colW, rowH: Double;
+ totH: Double;
+ r, c: Integer;
+ w_px, h_px: Integer;
+ totH_px, rowH_px: Integer;
+ totW_px, colW_px: Integer;
+ ppi: Integer;
+ u: TsSizeUnits;
+begin
+ // Abbreviations
+ ppi := ScreenPixelsPerInch;
+ u := FWorkbook.Units;
+
+ img := GetImage(AIndex);
+ ARow1 := img.Row;
+ ACol1 := img.Col;
+ ARowOffs1 := img.OffsetX; // in workbook units
+ AColOffs1 := img.OffsetY; // in workbook units
+
+ obj := FWorkbook.GetEmbeddedObj(img.Index);
+ AWidth := obj.ImageWidth * img.ScaleX; // in workbook units
+ AHeight := obj.ImageHeight * img.ScaleY; // in workbook units
+
+ // Find x coordinate of left image edge, in workbook units
+ x := AColOffs1;
+ for c := 0 to ACol1-1 do
+ begin
+ colW := GetColWidth(c, u);
+ x := x + colW;
+ end;
+ // Find y coordinate of top image edge, in workbook units.
+ y := ARowOffs1;
+ for r := 0 to ARow1 - 1 do
+ begin
+ rowH := CalcRowHeight(r);
+ y := y + rowH;
+ end;
+
+ if UsePixels then
+ // Use pixels for calculation. Better for Excel, maybe due to rounding error?
+ begin
+ // If we don't know the ppi of the screen the calculation is not exact!
+ w_px := ptsToPx(FWorkbook.ConvertUnits(AWidth, u, suPoints), ppi);
+ h_px := ptsToPx(FWorkbook.ConvertUnits(AHeight, u, suPoints), ppi);
+ // Find cell with right image edge. Find horizontal within-cell-offsets
+ totW_px := -ptsToPx(FWorkbook.ConvertUnits(AColOffs1, u, suPoints), ppi);
+ ACol2 := ACol1;
+ while (totW_px < w_px) do
+ begin
+ colW := GetColWidth(ACol2, u);
+ colW_px := ptsToPx(FWorkbook.ConvertUnits(colW, u, suPoints), ppi);
+ totW_px := totW_px + colW_px;
+ if totW_px > w_px then
+ begin
+ AColOffs2 := FWorkbook.ConvertUnits(pxToPts(colW_px - (totW_px - w_px), ppi), suPoints, u);
+ break;
+ end;
+ inc(ACol2);
+ end;
+ // Find cell with bottom image edge. Find vertical within-cell-offset.
+ totH_px := -ptsToPx(FWorkbook.ConvertUnits(ARowOffs1, u, suPoints), ppi);
+ ARow2 := ARow1;
+ while (totH_px < h_px) do
+ begin
+ rowH := CalcRowHeight(ARow2);
+ rowH_px := ptsToPx(FWorkbook.ConvertUnits(rowH, u, suPoints), ppi);
+ totH_px := totH_px + rowH_px;
+ if totH_px > h_px then
+ begin
+ ARowOffs2 := FWorkbook.ConvertUnits(pxToPts(rowH_px - (totH_px - h_px), ppi), suPoints, u);
+ break;
+ end;
+ inc(ARow2);
+ end;
+ end
+ else // Use workbook units for calculation
+ begin
+ // Find cell with right image edge. Find horizontal within-cell-offsets
+ totH := -ARowOffs1;
+ ARow2 := ARow1;
+ while (totH < AHeight) do
+ begin
+ rowH := CalcRowHeight(ARow2);
+ totH := totH + rowH;
+ if totH >= AHeight then
+ begin
+ ARowOffs2 := rowH - (totH - AHeight);
+ break;
+ end;
+ inc(ARow2);
+ end;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the parameters of the image stored in the internal image list at
+ the specified index.
+
+ @param AIndex Index of the image to be retrieved
+ @return TsImage record with all image parameters.
+-------------------------------------------------------------------------------}
+function TsWorksheet.GetImage(AIndex: Integer): TsImage;
+var
+ img: PsImage;
+begin
+ img := PsImage(FImages[AIndex]);
+ Result := img^;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the count of images that are embedded into this sheet.
+-------------------------------------------------------------------------------}
+function TsWorksheet.GetImageCount: Integer;
+begin
+ Result := FImages.Count;
+end;
+
+
+function TsWorksheet.GetPointerToImage(AIndex: Integer): PsImage;
+begin
+ Result := PsImage(FImages[AIndex]);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Removes all image from the internal image list.
+ The image streams (stored by the workbook), however, are retained because
+ images may also be used as header/footer images.
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.RemoveAllImages;
+var
+ i: Integer;
+begin
+ for i := FImages.Count-1 downto 0 do
+ RemoveImage(i);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Removes an image from the internal image list.
+ The image is identified by its index.
+ The image stream (stored by the workbook) is retained.
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.RemoveImage(AIndex: Integer);
+var
+ img: PsImage;
+begin
+ img := PsImage(FImages[AIndex]);
+ if (img <> nil) then begin
+ if (img^.Picture <> nil) then img^.Picture.Free;
+ img^.HyperlinkTarget := '';
+ img^.HyperlinkToolTip := '';
+ end;
+ Dispose(img);
+ FImages.Delete(AIndex);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds an embedded image to the worksheet
+
+ @param ARow Index of the row at which the image begins (top edge)
+ @param ACol Index of the column at which the image begins (left edge)
+ @param AFileName Name of the image file
+ @param AOffsetX The image is offset horizontally from the left edge of
+ the anchor cell. May reach into another cell.
+ Value is in workbook units.
+ @param AOffsetY The image is offset vertically from the top edge of the
+ anchor cell. May reach into another cell.
+ Value is in workbook units.
+ @param AScaleX Horizontal scaling factor of the image
+ @param AScaleY Vertical scaling factor of the image
+ @return Index into the internal image list.
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AFileName: String;
+ AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
+ AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
+var
+ idx: Integer;
+begin
+ // Does the image already exist?
+ idx := Workbook.FindEmbeddedObj(AFileName);
+ // No? Open and store in embedded object list.
+ if idx = -1 then
+ idx := Workbook.AddEmbeddedObj(AFileName);
+ // An error has occured? Error is already logged. Just exit.
+ if idx = -1 then
+ exit;
+
+ // Everything ok here...
+ Result := WriteImage(ARow, ACol, idx, AOffsetX, AOffsetY, AScaleX, AScaleY);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds an embedded image to the worksheet. The image passed in a stream.
+
+ @param ARow Index of the row at which the image begins (top edge)
+ @param ACol Index of the column at which the image begins (left edge)
+ @param AStream Stream which contains the image data
+ @param AOffsetX The image is offset horizontally from the left edge of
+ the anchor cell. May reach into another cell.
+ Value is in workbook units.
+ @param AOffsetY The image is offset vertically from the top edge of the
+ anchor cell. May reach into another cell.
+ Value is in workbook units.
+ @param AScaleX Horizontal scaling factor of the image
+ @param AScaleY Vertical scaling factor of the image
+ @param ASize Number ob bytes to be read from the input stream.
+ @return Index into the internal image list.
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AStream: TStream;
+ AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
+ AScaleX: Double = 1.0; AScaleY: Double = 1.0;
+ ASize: Int64 = -1): Integer;
+var
+ idx: Integer;
+begin
+ // Copy the stream to a new item in embedded object list.
+ idx := Workbook.AddEmbeddedObj(AStream, '', ASize);
+
+ // An error has occured? Error is already logged. Just exit.
+ if idx = -1 then
+ exit;
+
+ // Everything ok here...
+ Result := WriteImage(ARow, ACol, idx, AOffsetX, AOffsetY, AScaleX, AScaleY);
+end;
+
+
+function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AImageIndex: Integer;
+ AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
+ AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
+var
+ img: PsImage;
+begin
+ New(img);
+ InitImageRecord(img^, ARow, ACol, AOffsetX, AOffsetY, AScaleX, AScaleY);
+ img^.Index := AImageIndex;
+ Result := FImages.Add(img);
+end;
+
+
+
+{==============================================================================}
+{ TsWorkbook code for embedded objects }
+{==============================================================================}
+
+{@@ ----------------------------------------------------------------------------
+ Creates a new "embedded" stream and loads the specified file.
+ Returns the index of the embedded file item.
+ Image dimensions are converted to workbook units.
+-------------------------------------------------------------------------------}
+function TsWorkbook.AddEmbeddedObj(const AFileName: String): Integer;
+var
+ obj: TsEmbeddedObj = nil;
+begin
+ if not FileExists(AFileName) then
+ begin
+ AddErrorMsg(rsFileNotFound, [AFileName]);
+ Result := -1;
+ exit;
+ end;
+
+ obj := TsEmbeddedObj.Create;
+ if obj.LoadFromFile(AFileName) then
+ begin
+ obj.ImageWidth := ConvertUnits(obj.ImageWidth, suInches, FUnits);
+ obj.ImageHeight := ConvertUnits(obj.ImageHeight, suInches, FUnits);
+ Result := FEmbeddedObjList.Add(obj)
+ end else
+ begin
+ AddErrorMsg(rsFileFormatNotSupported, [AFileName]);
+ obj.Free;
+ Result := -1;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Creates a new "embedded" stream and copies the specified stream to it.
+ Returns the index of the embedded object.
+-------------------------------------------------------------------------------}
+function TsWorkbook.AddEmbeddedObj(AStream: TStream;
+ const AName: String = ''; ASize: Int64 = -1): Integer;
+var
+ obj: TsEmbeddedObj = nil;
+begin
+ obj := TsEmbeddedObj.Create;
+ if obj.LoadFromStream(AStream, AName, ASize) then
+ begin
+ obj.ImageWidth := ConvertUnits(obj.ImageWidth, suInches, FUnits);
+ obj.ImageHeight := ConvertUnits(obj.ImageHeight, suInches, FUnits);
+ Result := FEmbeddedObjList.Add(obj)
+ end else
+ begin
+ AddErrorMsg(rsImageFormatNotSupported);
+ obj.Free;
+ Result := -1;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Checks whether an embedded object with the specified file name already exists.
+ If yes, returns its index in the object list, or -1 if no.
+-------------------------------------------------------------------------------}
+function TsWorkbook.FindEmbeddedObj(const AFileName: String): Integer;
+var
+ obj: TsEmbeddedObj;
+begin
+ for Result:=0 to FEmbeddedObjList.Count-1 do
+ begin
+ obj := TsEmbeddedObj(FEmbeddedObjList[Result]);
+ if obj.FileName = AFileName then
+ exit;
+ end;
+ Result := -1;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the embedded object stored in the embedded object list at the
+ specified index.
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetEmbeddedObj(AIndex: Integer): TsEmbeddedObj;
+begin
+ Result := TsEmbeddedObj(FEmbeddedObjList[AIndex]);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the count of embedded objects
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetEmbeddedObjCount: Integer;
+begin
+ Result := FEmbeddedObjList.Count;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns true if there is at least one worksheet with an embedded images.
+-------------------------------------------------------------------------------}
+function TsWorkbook.HasEmbeddedSheetImages: Boolean;
+var
+ i: Integer;
+ sheet: TsWorksheet;
+begin
+ Result := true;
+ for i:=0 to FWorksheets.Count-1 do
+ begin
+ sheet := TsWorksheet(FWorksheets.Items[i]);
+ if sheet.GetImageCount > 0 then
+ exit;
+ end;
+ Result := false;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Removes all embedded objects
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.RemoveAllEmbeddedObj;
+var
+ i: Integer;
+begin
+ for i:= 0 to FEmbeddedObjList.Count-1 do
+ TsEmbeddedObj(FEmbeddedObjList[i]).Free;
+ FEmbeddedObjList.Clear;
+end;
+
+
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet_fmt.inc b/components/fpspreadsheet/source/common/fpspreadsheet_fmt.inc
index 5ca909df8..781dedc6b 100644
--- a/components/fpspreadsheet/source/common/fpspreadsheet_fmt.inc
+++ b/components/fpspreadsheet/source/common/fpspreadsheet_fmt.inc
@@ -1,6 +1,10 @@
{ Included by fpspreadsheet.pas }
{ Contains code for cell formatting }
+{==============================================================================}
+{ TsWorksheet code for format handling }
+{==============================================================================}
+
{@@ ----------------------------------------------------------------------------
Modifies the background parameters of the format record stored at the
specified index.
@@ -40,6 +44,251 @@ begin
Result := Workbook.AddCellFormat(fmt);
end;
+
+{@@ ----------------------------------------------------------------------------
+ Returns the background fill pattern and colors of a cell.
+
+ @param ACell Pointer to the cell
+ @return TsFillPattern record (or EMPTY_FILL, if the cell does not have a
+ filled background
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadBackground(ACell: PCell): TsFillPattern;
+var
+ fmt : PsCellFormat;
+begin
+ Result := EMPTY_FILL;
+ if ACell <> nil then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ if (uffBackground in fmt^.UsedFormattingFields) then
+ Result := fmt^.Background;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the background color of a cell as rbg value
+
+ @param ACell Pointer to the cell
+ @return Value containing the rgb bytes in little-endian order
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadBackgroundColor(ACell: PCell): TsColor;
+begin
+ Result := scTransparent;
+ if ACell <> nil then
+ Result := ReadBackgroundColor(ACell^.FormatIndex);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the background color stored at the specified index in the format
+ list of the workkbok.
+
+ @param AFormatIndex Index of the format record
+ @return Value containing the rgb bytes in little-endian order
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadBackgroundColor(AFormatIndex: Integer): TsColor;
+var
+ fmt: PsCellFormat;
+begin
+ Result := scTransparent;
+ if AFormatIndex > -1 then begin
+ fmt := Workbook.GetPointerToCellFormat(AFormatIndex);
+ if (uffBackground in fmt^.UsedFormattingFields) then
+ begin
+ if fmt^.Background.Style = fsSolidFill then
+ Result := fmt^.Background.FgColor
+ else
+ Result := fmt^.Background.BgColor;
+ end;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the BiDi mode of the cell (right-to-left or left-to-right)
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadBiDiMode(ACell: PCell): TsBiDiMode;
+var
+ fmt: PsCellFormat;
+begin
+ Result := bdDefault;
+ if (ACell <> nil) then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ if (uffBiDi in fmt^.UsedFormattingFields) then
+ Result := fmt^.BiDiMode;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Determines which borders are drawn around a specific cell
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadCellBorders(ACell: PCell): TsCellBorders;
+var
+ fmt: PsCellFormat;
+begin
+ Result := [];
+ if ACell <> nil then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ if (uffBorder in fmt^.UsedFormattingFields) then
+ Result := fmt^.Border;
+ end;
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Determines which the style of a particular cell border
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadCellBorderStyle(ACell: PCell;
+ ABorder: TsCelLBorder): TsCellBorderStyle;
+var
+ fmt: PsCellFormat;
+begin
+ Result := DEFAULT_BORDERSTYLES[ABorder];
+ if ACell <> nil then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ Result := fmt^.BorderStyles[ABorder];
+ end;
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Determines which all border styles of a given cell
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadCellBorderStyles(ACell: PCell): TsCellBorderStyles;
+var
+ fmt: PsCellFormat;
+begin
+ Result := DEFAULT_BORDERSTYLES;
+ if ACell <> nil then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ Result := Fmt^.BorderStyles;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the format record that is assigned to a specified cell
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadCellFormat(ACell: PCell): TsCellFormat;
+begin
+ Result := Workbook.GetCellFormat(ACell^.FormatIndex);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the protection flags of the cell.
+
+ NOTE: These flags are active only if sheet protection is active, i.e.
+ soProtected in Worksheet.Options.
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadCellProtection(ACell: PCell): TsCellProtections;
+var
+ fmt: PsCellFormat;
+begin
+ Result := DEFAULT_CELL_PROTECTION;
+ if (ACell <> nil) then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ if fmt <> nil then
+ Result := fmt^.Protection;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the horizontal alignment of a specific cell
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadHorAlignment(ACell: PCell): TsHorAlignment;
+var
+ fmt: PsCellFormat;
+begin
+ Result := haDefault;
+ if (ACell <> nil) then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ if (uffHorAlign in fmt^.UsedFormattingFields) then
+ Result := fmt^.HorAlignment;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the text orientation of a specific cell
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadTextRotation(ACell: PCell): TsTextRotation;
+var
+ fmt: PsCellFormat;
+begin
+ Result := trHorizontal;
+ if ACell <> nil then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ if (uffTextRotation in fmt^.UsedFormattingFields) then
+ Result := fmt^.TextRotation;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Reads the set of used formatting fields of a cell.
+
+ Each cell contains a set of "used formatting fields". Formatting is applied
+ only if the corresponding element is contained in the set.
+
+ @param ACell Pointer to the cell
+ @return Set of elements used in formatting the cell
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadUsedFormatting(ACell: PCell): TsUsedFormattingFields;
+var
+ fmt: PsCellFormat;
+begin
+ if ACell = nil then
+ begin
+ Result := [];
+ Exit;
+ end;
+ fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ Result := fmt^.UsedFormattingFields;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the vertical alignment of a specific cell
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadVertAlignment(ACell: PCell): TsVertAlignment;
+var
+ fmt: PsCellFormat;
+begin
+ Result := vaDefault;
+ if (ACell <> nil) then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ if (uffVertAlign in fmt^.UsedFormattingFields) then
+ Result := fmt^.VertAlignment;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns whether a specific cell support word-wrapping.
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadWordwrap(ACell: PCell): boolean;
+var
+ fmt: PsCellFormat;
+begin
+ Result := false;
+ if (ACell <> nil) then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ Result := uffWordwrap in fmt^.UsedFormattingFields;
+ end;
+end;
+
+
{@@ ----------------------------------------------------------------------------
Defines a background pattern for a cell
@@ -63,6 +312,7 @@ begin
WriteBackground(Result, AStyle, APatternColor, ABackgroundColor);
end;
+
{@@ ----------------------------------------------------------------------------
Defines a background pattern for a cell
@@ -89,6 +339,7 @@ begin
end;
end;
+
{@@ ----------------------------------------------------------------------------
Sets a uniform background color of a cell.
@@ -106,6 +357,7 @@ begin
WriteBackgroundColor(Result, AColor);
end;
+
{@@ ----------------------------------------------------------------------------
Sets a uniform background color of a cell.
@@ -124,12 +376,14 @@ begin
end;
end;
+
function TsWorksheet.WriteBiDiMode(ARow, ACol: Cardinal; AValue: TsBiDiMode): PCell;
begin
Result := GetCell(ARow, ACol);
WriteBiDiMode(Result, AValue);
end;
+
procedure TsWorksheet.WriteBiDiMode(ACell: PCell; AValue: TsBiDiMode);
var
fmt: TsCellFormat;
@@ -146,6 +400,7 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
+
{@@ ----------------------------------------------------------------------------
Sets the color of a cell border line.
Note: the border must be included in Borders set in order to be shown!
@@ -164,6 +419,7 @@ begin
WriteBorderColor(Result, ABorder, AColor);
end;
+
{@@ ----------------------------------------------------------------------------
Sets the color of a cell border line.
Note: the border must be included in Borders set in order to be shown!
@@ -186,6 +442,7 @@ begin
end;
end;
+
{@@ ----------------------------------------------------------------------------
Sets the linestyle of a cell border.
Note: the border must be included in the "Borders" set in order to be shown!
@@ -206,6 +463,7 @@ begin
WriteBorderLineStyle(Result, ABorder, ALineStyle);
end;
+
{@@ ----------------------------------------------------------------------------
Sets the linestyle of a cell border.
Note: the border must be included in the "Borders" set in order to be shown!
@@ -230,6 +488,7 @@ begin
end;
end;
+
{@@ ----------------------------------------------------------------------------
Shows the cell borders included in the set ABorders. No border lines are drawn
for those not included.
@@ -248,6 +507,7 @@ begin
WriteBorders(Result, ABorders);
end;
+
{@@ ----------------------------------------------------------------------------
Shows the cell borders included in the set ABorders. No border lines are drawn
for those not included.
@@ -292,6 +552,7 @@ begin
WriteBorderStyle(Result, ABorder, AStyle);
end;
+
{@@ ----------------------------------------------------------------------------
Sets the style of a cell border, i.e. line style and line color.
Note: the border must be included in the "Borders" set in order to be shown!
@@ -314,6 +575,7 @@ begin
end;
end;
+
{@@ ----------------------------------------------------------------------------
Sets line style and line color of a cell border.
Note: the border must be included in the "Borders" set in order to be shown!
@@ -334,6 +596,7 @@ begin
WriteBorderStyle(Result, ABorder, ALineStyle, AColor);
end;
+
{@@ ----------------------------------------------------------------------------
Sets line style and line color of a cell border.
Note: the border must be included in the "Borders" set in order to be shown!
@@ -359,6 +622,7 @@ begin
end;
end;
+
{@@ ----------------------------------------------------------------------------
Sets the style of all cell border of a cell, i.e. line style and line color.
Note: Only those borders included in the "Borders" set are shown!
@@ -377,6 +641,7 @@ begin
WriteBorderStyles(Result, AStyles);
end;
+
{@@ ----------------------------------------------------------------------------
Sets the style of all cell border of a cell, i.e. line style and line color.
Note: Only those borders included in the "Borders" set are shown!
@@ -401,6 +666,7 @@ begin
end;
end;
+
{@@ ----------------------------------------------------------------------------
Assigns a complete cell format record to a cell
@@ -418,6 +684,7 @@ begin
WriteCellFormatIndex(ACell, idx);
end;
+
{@@ ----------------------------------------------------------------------------
Formats a cell to the cell format stored at the specified index in the
workbook's cell format list.
@@ -440,6 +707,7 @@ begin
end;
end;
+
{@@ ----------------------------------------------------------------------------
Defines how the cell at the specified row and column is protected: lock
cell modification and/or hide formulas. Note that this is activated only after
@@ -456,6 +724,7 @@ begin
WriteCellProtection(Result, AValue);
end;
+
procedure TsWorksheet.WriteCellProtection(ACell: PCell;
AValue: TsCellProtections);
var
@@ -473,259 +742,6 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
-{@@ ----------------------------------------------------------------------------
- Adds font specification to the formatting of a cell. Looks in the workbook's
- FontList and creates an new entry if the font is not used so far. Returns the
- index of the font in the font list.
-
- @param ARow The row of the cell
- @param ACol The column of the cell
- @param AFontName Name of the font
- @param AFontSize Size of the font, in points
- @param AFontStyle Set with font style attributes
- (don't use those of unit "graphics" !)
- @param AFontColor RGB value of the font's color
- @param APosition Specifies sub- or superscript text
- @return Index of the font in the workbook's font list.
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteFont(ARow, ACol: Cardinal; const AFontName: String;
- AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor;
- APosition: TsFontPosition = fpNormal): Integer;
-begin
- Result := WriteFont(GetCell(ARow, ACol), AFontName, AFontSize, AFontStyle,
- AFontColor, APosition);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Adds font specification to the formatting of a cell. Looks in the workbook's
- FontList and creates an new entry if the font is not used so far. Returns the
- index of the font in the font list.
-
- @param ACell Pointer to the cell considered
- @param AFontName Name of the font
- @param AFontSize Size of the font, in points
- @param AFontStyle Set with font style attributes
- (don't use those of unit "graphics" !)
- @param AFontColor RGB value of the font's color
- @param APosition Specified subscript or superscript text.
- @return Index of the font in the workbook's font list.
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteFont(ACell: PCell; const AFontName: String;
- AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor;
- APosition: TsFontPosition = fpNormal): Integer;
-var
- fmt: TsCellFormat;
-begin
- if ACell = nil then
- begin
- Result := -1;
- Exit;
- end;
-
- Result := FWorkbook.FindFont(AFontName, AFontSize, AFontStyle, AFontColor, APosition);
- if Result = -1 then
- result := FWorkbook.AddFont(AFontName, AFontSize, AFontStyle, AFontColor, APosition);
-
- fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
- Include(fmt.UsedFormattingFields, uffFont);
- fmt.FontIndex := Result;
- ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
-
- ChangedFont(ACell^.Row, ACell^.Col);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Applies a font to the formatting of a cell. The font is determined by its
- index in the workbook's font list:
-
- @param ARow The row of the cell
- @param ACol The column of the cell
- @param AFontIndex Index of the font in the workbook's font list
- @return Pointer to the cell
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer): PCell;
-begin
- Result := GetCell(ARow, ACol);
- WriteFont(Result, AFontIndex);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Applies a font to the formatting of a cell. The font is determined by its
- index in the workbook's font list:
-
- @param ACell Pointer to the cell considered
- @param AFontIndex Index of the font in the workbook's font list
--------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteFont(ACell: PCell; AFontIndex: Integer);
-var
- fmt: TsCellFormat;
-begin
- if ACell = nil then
- exit;
-
- if (AFontIndex < 0) or (AFontIndex >= Workbook.GetFontCount) then
- raise EFPSpreadsheet.Create(rsInvalidFontIndex);
-
- fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
- Include(fmt.UsedFormattingFields, uffFont);
- fmt.FontIndex := AFontIndex;
- ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
-
- ChangedFont(ACell^.Row, ACell^.Col);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Replaces the text color used 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.
-
- @param ARow The row of the cell
- @param ACol The column of the cell
- @param AFontColor RGB value of the new text color
- @return Index of the font in the workbook's font list.
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
-begin
- Result := WriteFontColor(GetCell(ARow, ACol), AFontColor);
-end;
-
-{@@ ----------------------------------------------------------------------------
- Replaces the text color used 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.
-
- @param ACell Pointer to the cell
- @param AFontColor RGB value of the new text color
- @return Index of the font in the workbook's font list.
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteFontColor(ACell: PCell; AFontColor: TsColor): Integer;
-var
- fnt: TsFont;
-begin
- if ACell = nil then begin
- Result := 0;
- exit;
- end;
- fnt := ReadCellFont(ACell);
- 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
- is created. Returns the index of this font in the font list.
-
- @param ARow The row of the cell
- @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
- is created. Returns the index of this font in the font list.
-
- @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;
-begin
- if ACell = nil then begin
- Result := 0;
- exit;
- end;
- fnt := ReadCellFont(ACell);
- 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.
-
- @param ARow The row of the cell
- @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.
-
- @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;
-begin
- if ACell = nil then begin
- Result := 0;
- exit;
- end;
- fnt := ReadCellFont(ACell);
- 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.
- Returns the index of this font in the font list.
-
- @param ARow The row of the cell
- @param ACol The column of the cell
- @param AStyle New font style to be used
- @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.
- Returns the index of this font in the font list.
-
- @param ACell Pointer to the cell considered
- @param AStyle New font style to be used
- @return Index of the font in the workbook's font list.
-
- @see TsFontStyle
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer;
-var
- fnt: TsFont;
-begin
- if ACell = nil then begin
- Result := -1;
- exit;
- end;
- fnt := ReadCellFont(ACell);
- Result := WriteFont(ACell, fnt.FontName, fnt.Size, AStyle, fnt.Color);
-end;
{@@ ----------------------------------------------------------------------------
Defines the horizontal alignment of text in a cell.
@@ -927,3 +943,124 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
+
+{==============================================================================}
+{ TsWorkbook code for format handling }
+{==============================================================================}
+
+{@@ ----------------------------------------------------------------------------
+ Adds the specified format record to the internal list and returns the index
+ in the list. If the record had already been added before the function only
+ returns the index.
+-------------------------------------------------------------------------------}
+function TsWorkbook.AddCellFormat(const AValue: TsCellFormat): Integer;
+begin
+ Result := FCellFormatList.Add(AValue);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the contents of the format record with the specified index.
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetCellFormat(AIndex: Integer): TsCellFormat;
+begin
+ Result := FCellFormatList.Items[AIndex]^;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns a string describing the cell format with the specified index.
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetCellFormatAsString(AIndex: Integer): String;
+var
+ fmt: PsCellFormat;
+ cb: TsCellBorder;
+ s: String;
+ numFmt: TsNumFormatParams;
+begin
+ Result := '';
+ fmt := GetPointerToCellFormat(AIndex);
+ if fmt = nil then
+ exit;
+
+ if (uffFont in fmt^.UsedFormattingFields) then
+ Result := Format('%s; Font%d', [Result, fmt^.FontIndex]);
+ if (uffBackground in fmt^.UsedFormattingFields) then begin
+ Result := Format('%s; Bg %s', [Result, GetColorName(fmt^.Background.BgColor)]);
+ Result := Format('%s; Fg %s', [Result, GetColorName(fmt^.Background.FgColor)]);
+ Result := Format('%s; Pattern %s', [Result, GetEnumName(TypeInfo(TsFillStyle), ord(fmt^.Background.Style))]);
+ end;
+ if (uffHorAlign in fmt^.UsedFormattingfields) then
+ Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsHorAlignment), ord(fmt^.HorAlignment))]);
+ if (uffVertAlign in fmt^.UsedFormattingFields) then
+ Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsVertAlignment), ord(fmt^.VertAlignment))]);
+ if (uffWordwrap in fmt^.UsedFormattingFields) then
+ Result := Format('%s; Word-wrap', [Result]);
+ if (uffNumberFormat in fmt^.UsedFormattingFields) then
+ begin
+ numFmt := GetNumberFormat(fmt^.NumberFormatIndex);
+ if numFmt <> nil then
+ Result := Format('%s; %s (%s)', [Result,
+ GetEnumName(TypeInfo(TsNumberFormat), ord(numFmt.NumFormat)),
+ numFmt.NumFormatStr
+ ])
+ else
+ Result := Format('%s; %s', [Result, 'nfGeneral']);
+ end else
+ Result := Format('%s; %s', [Result, 'nfGeneral']);
+ if (uffBorder in fmt^.UsedFormattingFields) then
+ begin
+ s := '';
+ for cb in fmt^.Border do
+ if s = '' then s := GetEnumName(TypeInfo(TsCellBorder), ord(cb))
+ else s := s + '+' + GetEnumName(TypeInfo(TsCellBorder), ord(cb));
+ Result := Format('%s; %s', [Result, s]);
+ end;
+ if (uffBiDi in fmt^.UsedFormattingFields) then
+ Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsBiDiMode), ord(fmt^.BiDiMode))]);
+ if Result <> '' then Delete(Result, 1, 2);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the count of format records used all over the workbook
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetNumCellFormats: Integer;
+begin
+ Result := FCellFormatList.Count;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns a pointer to the format record with the specified index
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetPointerToCellFormat(AIndex: Integer): PsCellFormat;
+begin
+ if FCellFormatList.Count = 0 then
+ raise Exception.Create('[TsWorkbook.GetPointerToCellFormat]: No format items.');
+
+ if (AIndex < 0) or (AIndex >= FCellFormatList.Count) then
+ AIndex := 0; // 0 is default format
+ Result := FCellFormatList.Items[AIndex];
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Removes all cell formats from the workbook.
+
+ If AKeepDefaultFormat is true then index 0 containing the default cell format
+ is retained.
+
+ Use carefully!
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.RemoveAllCellFormats(AKeepDefaultFormat: Boolean);
+var
+ i: Integer;
+begin
+ if AKeepDefaultFormat then
+ for i := FCellFormatList.Count-1 downto 1 do
+ FCellFormatList.Delete(i)
+ else
+ FCellFormatList.Clear;
+end;
+
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet_fonts.inc b/components/fpspreadsheet/source/common/fpspreadsheet_fonts.inc
new file mode 100644
index 000000000..60b166c81
--- /dev/null
+++ b/components/fpspreadsheet/source/common/fpspreadsheet_fonts.inc
@@ -0,0 +1,566 @@
+{ Included by fpspreadsheet.pas }
+
+{ Code for font handling }
+
+{==============================================================================}
+{ TsWorksheet code for fonts }
+{==============================================================================}
+
+{@@ ----------------------------------------------------------------------------
+ Determines the font used by a specified cell. Returns the workbook's default
+ font if the cell does not exist.
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadCellFont(ACell: PCell): TsFont;
+var
+ fmt: PsCellFormat;
+begin
+ Result := nil;
+ if ACell <> nil then begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ Result := Workbook.GetFont(fmt^.FontIndex);
+ end;
+ if Result = nil then
+ Result := Workbook.GetDefaultFont;
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Determines the index of the font used by a specified cell, referring to the
+ workbooks font list. Returns 0 (the default font index) if the cell does not
+ exist.
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadCellFontIndex(ACell: PCell): Integer;
+var
+ fmt: PsCellFormat;
+begin
+ Result := DEFAULT_FONTINDEX;
+ if ACell <> nil then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ Result := fmt^.FontIndex;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds font specification to the formatting of a cell. Looks in the workbook's
+ FontList and creates an new entry if the font is not used so far. Returns the
+ index of the font in the font list.
+
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param AFontName Name of the font
+ @param AFontSize Size of the font, in points
+ @param AFontStyle Set with font style attributes
+ (don't use those of unit "graphics" !)
+ @param AFontColor RGB value of the font's color
+ @param APosition Specifies sub- or superscript text
+ @return Index of the font in the workbook's font list.
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteFont(ARow, ACol: Cardinal; const AFontName: String;
+ AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor;
+ APosition: TsFontPosition = fpNormal): Integer;
+begin
+ Result := WriteFont(GetCell(ARow, ACol), AFontName, AFontSize, AFontStyle,
+ AFontColor, APosition);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds font specification to the formatting of a cell. Looks in the workbook's
+ FontList and creates an new entry if the font is not used so far. Returns the
+ index of the font in the font list.
+
+ @param ACell Pointer to the cell considered
+ @param AFontName Name of the font
+ @param AFontSize Size of the font, in points
+ @param AFontStyle Set with font style attributes
+ (don't use those of unit "graphics" !)
+ @param AFontColor RGB value of the font's color
+ @param APosition Specified subscript or superscript text.
+ @return Index of the font in the workbook's font list.
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteFont(ACell: PCell; const AFontName: String;
+ AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor;
+ APosition: TsFontPosition = fpNormal): Integer;
+var
+ fmt: TsCellFormat;
+begin
+ if ACell = nil then
+ begin
+ Result := -1;
+ Exit;
+ end;
+
+ Result := FWorkbook.FindFont(AFontName, AFontSize, AFontStyle, AFontColor, APosition);
+ if Result = -1 then
+ result := FWorkbook.AddFont(AFontName, AFontSize, AFontStyle, AFontColor, APosition);
+
+ fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
+ Include(fmt.UsedFormattingFields, uffFont);
+ fmt.FontIndex := Result;
+ ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
+
+ ChangedFont(ACell^.Row, ACell^.Col);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Applies a font to the formatting of a cell. The font is determined by its
+ index in the workbook's font list:
+
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param AFontIndex Index of the font in the workbook's font list
+ @return Pointer to the cell
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer): PCell;
+begin
+ Result := GetCell(ARow, ACol);
+ WriteFont(Result, AFontIndex);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Applies a font to the formatting of a cell. The font is determined by its
+ index in the workbook's font list:
+
+ @param ACell Pointer to the cell considered
+ @param AFontIndex Index of the font in the workbook's font list
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.WriteFont(ACell: PCell; AFontIndex: Integer);
+var
+ fmt: TsCellFormat;
+begin
+ if ACell = nil then
+ exit;
+
+ if (AFontIndex < 0) or (AFontIndex >= Workbook.GetFontCount) then
+ raise EFPSpreadsheet.Create(rsInvalidFontIndex);
+
+ fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
+ Include(fmt.UsedFormattingFields, uffFont);
+ fmt.FontIndex := AFontIndex;
+ ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
+
+ ChangedFont(ACell^.Row, ACell^.Col);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Replaces the text color used 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.
+
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param AFontColor RGB value of the new text color
+ @return Index of the font in the workbook's font list.
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
+begin
+ Result := WriteFontColor(GetCell(ARow, ACol), AFontColor);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Replaces the text color used 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.
+
+ @param ACell Pointer to the cell
+ @param AFontColor RGB value of the new text color
+ @return Index of the font in the workbook's font list.
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteFontColor(ACell: PCell; AFontColor: TsColor): Integer;
+var
+ fnt: TsFont;
+begin
+ if ACell = nil then begin
+ Result := 0;
+ exit;
+ end;
+ fnt := ReadCellFont(ACell);
+ 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
+ is created. Returns the index of this font in the font list.
+
+ @param ARow The row of the cell
+ @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
+ is created. Returns the index of this font in the font list.
+
+ @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;
+begin
+ if ACell = nil then begin
+ Result := 0;
+ exit;
+ end;
+ fnt := ReadCellFont(ACell);
+ 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.
+
+ @param ARow The row of the cell
+ @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.
+
+ @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;
+begin
+ if ACell = nil then begin
+ Result := 0;
+ exit;
+ end;
+ fnt := ReadCellFont(ACell);
+ 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.
+ Returns the index of this font in the font list.
+
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param AStyle New font style to be used
+ @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.
+ Returns the index of this font in the font list.
+
+ @param ACell Pointer to the cell considered
+ @param AStyle New font style to be used
+ @return Index of the font in the workbook's font list.
+
+ @see TsFontStyle
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer;
+var
+ fnt: TsFont;
+begin
+ if ACell = nil then begin
+ Result := -1;
+ exit;
+ end;
+ fnt := ReadCellFont(ACell);
+ Result := WriteFont(ACell, fnt.FontName, fnt.Size, AStyle, fnt.Color);
+end;
+
+
+
+{==============================================================================}
+{ TsWorkbook code for fonts }
+{==============================================================================}
+
+{@@ ----------------------------------------------------------------------------
+ Adds a font to the font list. Returns the index in the font list.
+
+ @param AFontName Name of the font (like 'Arial')
+ @param ASize Size of the font in points
+ @param AStyle Style of the font, a combination of TsFontStyle elements
+ @param AColor RGB valoe of the font color
+ @param APosition Specifies subscript or superscript text.
+ @return Index of the font in the workbook's font list
+-------------------------------------------------------------------------------}
+function TsWorkbook.AddFont(const AFontName: String; ASize: Single;
+ AStyle: TsFontStyles; AColor: TsColor;
+ APosition: TsFontPosition = fpNormal): Integer;
+var
+ fnt: TsFont;
+begin
+ fnt := TsFont.Create;
+ fnt.FontName := AFontName;
+ fnt.Size := ASize;
+ fnt.Style := AStyle;
+ fnt.Color := AColor;
+ fnt.Position := APosition;
+ Result := AddFont(fnt);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds a font to the font list. Returns the index in the font list.
+
+ @param AFont TsFont record containing all font parameters
+ @return Index of the font in the workbook's font list
+-------------------------------------------------------------------------------}
+function TsWorkbook.AddFont(const AFont: TsFont): Integer;
+begin
+ result := FFontList.Add(AFont);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Creates a new font as a copy of the font at the specified index.
+ The new font is NOT YET added to the font list.
+ If the user does not add the font to the font list he is responsibile for
+ destroying it.
+-------------------------------------------------------------------------------}
+function TsWorkbook.CloneFont(const AFontIndex: Integer): TsFont;
+var
+ fnt: TsFont;
+begin
+ Result := TsFont.Create;
+ fnt := GetFont(AFontIndex);
+ Result.FontName := fnt.FontName;
+ Result.Size := fnt.Size;
+ Result.Style := fnt.Style;
+ Result.Color := fnt.Color;
+ Result.Position := fnt.Position;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Deletes a font.
+ Use with caution because this will screw up the font assignment to cells.
+ The only legal reason to call this method is from a reader of a file format
+ in which the missing font #4 of BIFF does exist.
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.DeleteFont(const AFontIndex: Integer);
+var
+ fnt: TsFont;
+begin
+ if AFontIndex < FFontList.Count then
+ begin
+ fnt := TsFont(FFontList.Items[AFontIndex]);
+ if fnt <> nil then fnt.Free;
+ FFontList.Delete(AFontIndex);
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Checks whether the font with the given specification is already contained in
+ the font list. Returns the index, or -1 if not found.
+
+ @param AFontName Name of the font (like 'Arial')
+ @param ASize Size of the font in points
+ @param AStyle Style of the font, a combination of TsFontStyle elements
+ @param AColor RGB value of the font color
+ @param APosition Specified subscript or superscript text.
+ @return Index of the font in the font list, or -1 if not found.
+-------------------------------------------------------------------------------}
+function TsWorkbook.FindFont(const AFontName: String; ASize: Single;
+ AStyle: TsFontStyles; AColor: TsColor; APosition: TsFontPosition = fpNormal): Integer;
+begin
+ Result := FindFontInList(FFontList, AFontName, ASize, AStyle, AColor, APosition);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the count of built-in fonts (default font, hyperlink font, bold font
+ by default).
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetBuiltinFontCount: Integer;
+begin
+ Result := FBuiltinFontCount;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the default font. This is the first font (index 0) in the font list
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetDefaultFont: TsFont;
+begin
+ Result := GetFont(0);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the point size of the default font
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetDefaultFontSize: Single;
+begin
+ Result := GetFont(0).Size;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the font with the given index.
+
+ @param AIndex Index of the font to be considered
+ @return Record containing all parameters of the font (or nil if not found).
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetFont(AIndex: Integer): TsFont;
+begin
+ if (AIndex >= 0) and (AIndex < FFontList.Count) then
+ Result := FFontList.Items[AIndex]
+ else
+ Result := nil;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns a string which identifies the font with a given index.
+
+ @param AIndex Index of the font
+ @return String with font name, font size etc.
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetFontAsString(AIndex: Integer): String;
+begin
+ Result := fpsUtils.GetFontAsString(GetFont(AIndex));
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the count of registered fonts
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetFontCount: Integer;
+begin
+ Result := FFontList.Count;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Initializes the font list by adding 5 fonts:
+
+ 0: default font
+ 1: like default font, but blue and underlined (for hyperlinks)
+ 2: like default font, but bold
+ 3: like default font, but italic
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.InitFonts;
+var
+ fntName: String;
+ fntSize: Single;
+begin
+ // Memorize old default font
+ with TsFont(FFontList.Items[0]) do
+ begin
+ fntName := FontName;
+ fntSize := Size;
+ end;
+
+ // Remove current font list
+ RemoveAllFonts;
+
+ // Build new font list
+ SetDefaultFont(fntName, fntSize); // FONT0: Default font
+ AddFont(fntName, fntSize, [fssUnderline], scBlue); // FONT1: Hyperlink font = blue & underlined
+ AddFont(fntName, fntSize, [fssBold], scBlack); // FONT2: Bold font
+ AddFont(fntName, fntSize, [fssItalic], scBlack); // FONT3: Italic font (not used directly)
+
+ FBuiltinFontCount := FFontList.Count;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Clears the list of fonts and releases their memory.
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.RemoveAllFonts;
+var
+ i: Integer;
+ fnt: TsFont;
+begin
+ for i := FFontList.Count-1 downto 0 do
+ begin
+ fnt := TsFont(FFontList.Items[i]);
+ fnt.Free;
+ FFontList.Delete(i);
+ end;
+ FBuiltinFontCount := 0;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Replaces the built-in font at a specific index with different font parameters
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.ReplaceFont(AFontIndex: Integer; AFontName: String;
+ ASize: Single; AStyle: TsFontStyles; AColor: TsColor;
+ APosition: TsFontPosition = fpNormal);
+var
+ fnt: TsFont;
+begin
+ if (AFontIndex < FBuiltinFontCount) then //and (AFontIndex <> 4) then
+ begin
+ fnt := TsFont(FFontList[AFontIndex]);
+ fnt.FontName := AFontName;
+ fnt.Size := ASize;
+ fnt.Style := AStyle;
+ fnt.Color := AColor;
+ fnt.Position := APosition;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Defines the default font. This is the font with index 0 in the FontList.
+ The next built-in fonts will have the same font name and size
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.SetDefaultFont(const AFontName: String; ASize: Single);
+var
+ i: Integer;
+begin
+ if FFontList.Count = 0 then
+ AddFont(AFontName, ASize, [], scBlack)
+ else
+ for i:=0 to FBuiltinFontCount-1 do
+ if (i <> 4) and (i < FFontList.Count) then // wp: why if font #4 relevant here ????
+ with TsFont(FFontList[i]) do
+ begin
+ FontName := AFontName;
+ Size := ASize;
+ end;
+end;
+
+
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet_hyperlinks.inc b/components/fpspreadsheet/source/common/fpspreadsheet_hyperlinks.inc
new file mode 100644
index 000000000..a2751a67e
--- /dev/null
+++ b/components/fpspreadsheet/source/common/fpspreadsheet_hyperlinks.inc
@@ -0,0 +1,228 @@
+{ Included by fpspreadsheet.pas }
+
+{ Contains code for hyperlinks }
+
+{@@ ----------------------------------------------------------------------------
+ Checks whether the specified cell contains a hyperlink and returns a pointer
+ to the hyperlink data.
+
+ @param ACell Pointer to the cell
+ @return Pointer to the TsHyperlink record, or NIL if the cell does not contain
+ a hyperlink.
+-------------------------------------------------------------------------------}
+function TsWorksheet.FindHyperlink(ACell: PCell): PsHyperlink;
+begin
+ if HasHyperlink(ACell) then
+ Result := PsHyperlink(FHyperlinks.FindByRowCol(ACell^.Row, ACell^.Col))
+ else
+ Result := nil;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Reads the hyperlink information of a specified cell.
+
+ @param ACell Pointer to the cell considered
+ @returns Record with the hyperlink data assigned to the cell.
+ If the cell is not a hyperlink the result field Kind is hkNone.
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadHyperlink(ACell: PCell): TsHyperlink;
+var
+ hyperlink: PsHyperlink;
+begin
+ hyperlink := FindHyperlink(ACell);
+ if hyperlink <> nil then
+ Result := hyperlink^
+ else
+ begin
+ Result.Row := ACell^.Row;
+ Result.Col := ACell^.Col;
+ Result.Target := '';
+ Result.Tooltip := '';
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Removes a hyperlink from the specified cell. Releaes memory occupied by
+ the associated TsHyperlink record. Cell content type is converted to
+ cctUTF8String.
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.RemoveHyperlink(ACell: PCell);
+begin
+ if HasHyperlink(ACell) then
+ begin
+ FHyperlinks.DeleteHyperlink(ACell^.Row, ACell^.Col);
+ Exclude(ACell^.Flags, cfHyperlink);
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Checks whether the passed string represents a valid hyperlink target
+
+ @param AValue String to be checked. Must be either a fully qualified URI,
+ a local relative (!) file name, or a # followed by a cell
+ address in the current workbook
+ @param AErrMsg Error message in case that the string is not correct.
+ @returns TRUE if the string is correct, FALSE otherwise
+-------------------------------------------------------------------------------}
+function TsWorksheet.ValidHyperlink(AValue: String; out AErrMsg: String): Boolean;
+var
+ u: TUri;
+ sheet: TsWorksheet;
+ r, c: Cardinal;
+begin
+ Result := false;
+ AErrMsg := '';
+ if AValue = '' then
+ begin
+ AErrMsg := rsEmptyHyperlink;
+ exit;
+ end else
+ if (AValue[1] = '#') then
+ begin
+ Delete(AValue, 1, 1);
+ if not FWorkbook.TryStrToCell(AValue, sheet, r, c) then
+ begin
+ AErrMsg := Format(rsNoValidHyperlinkInternal, ['#'+AValue]);
+ exit;
+ end;
+ end else
+ begin
+ u := ParseURI(AValue);
+ if SameText(u.Protocol, 'mailto') then
+ begin
+ Result := true; // To do: Check email address here...
+ exit;
+ end else
+ if SameText(u.Protocol, 'file') then
+ begin
+ if FilenameIsAbsolute(u.Path + u.Document) then
+ begin
+ Result := true;
+ exit;
+ end else
+ begin
+ AErrMsg := Format(rsLocalfileHyperlinkAbs, [AValue]);
+ exit;
+ end;
+ end else
+ begin
+ Result := true;
+ exit;
+ end;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Assigns a hyperlink to the cell at the specified row and column
+ Cell content is not affected by the presence of a hyperlink.
+
+ @param ARow Row index of the cell considered
+ @param ACol Column index of the cell considered
+ @param ATarget Hyperlink address given as a fully qualitifed URI for
+ external links, or as a # followed by a cell address
+ for internal links.
+ @param ATooltip Text for popup tooltip hint used by Excel
+ @returns Pointer to the cell with the hyperlink
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteHyperlink(ARow, ACol: Cardinal; ATarget: String;
+ ATooltip: String = ''): PCell;
+begin
+ Result := GetCell(ARow, ACol);
+ WriteHyperlink(Result, ATarget, ATooltip);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Assigns a hyperlink to the specified cell.
+
+ @param ACell Pointer to the cell considered
+ @param ATarget Hyperlink address given as a fully qualitifed URI for
+ external links, or as a # followed by a cell address
+ for internal links. Local files can be specified also
+ by their name relative to the workbook.
+ An existing hyperlink is removed if ATarget is empty.
+ @param ATooltip Text for popup tooltip hint used by Excel
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.WriteHyperlink(ACell: PCell; ATarget: String;
+ ATooltip: String = '');
+
+ function GetDisplayText(ATarget: String): String;
+ var
+ target, bm: String;
+ begin
+ SplitHyperlink(ATarget, target, bm);
+ if pos('file:', lowercase(ATarget))=1 then
+ begin
+ URIToFilename(target, Result);
+ ForcePathDelims(Result);
+ if bm <> '' then Result := Result + '#' + bm;
+ end else
+ if target = '' then
+ Result := bm
+ else
+ Result := ATarget;
+ end;
+
+var
+ fmt: TsCellFormat;
+ noCellText: Boolean = false;
+begin
+ if ACell = nil then
+ exit;
+
+ fmt := ReadCellFormat(ACell);
+
+ // Empty target string removes the hyperlink. Resets the font from hyperlink
+ // to default font.
+ if ATarget = '' then begin
+ RemoveHyperlink(ACell);
+ if fmt.FontIndex = HYPERLINK_FONTINDEX then
+ WriteFont(ACell, DEFAULT_FONTINDEX);
+ exit;
+ end;
+
+ // Detect whether the cell already has a hyperlink, but has no other content.
+ if HasHyperlink(ACell) then
+ noCellText := (ACell^.ContentType = cctUTF8String) and
+ (GetDisplayText(ReadHyperlink(ACell).Target) = ReadAsText(ACell));
+
+ // Attach the hyperlink to the cell
+ FHyperlinks.AddHyperlink(ACell^.Row, ACell^.Col, ATarget, ATooltip);
+ Include(ACell^.Flags, cfHyperlink);
+
+ // If there is no other cell content use the target as cell label string.
+ if (ACell^.ContentType = cctEmpty) or noCellText then
+ begin
+ ACell^.ContentType := cctUTF8String;
+ ACell^.UTF8StringValue := GetDisplayText(ATarget);
+ end;
+
+ // Select the hyperlink font.
+ if fmt.FontIndex = DEFAULT_FONTINDEX then
+ begin
+ fmt.FontIndex := HYPERLINK_FONTINDEX;
+ Include(fmt.UsedFormattingFields, uffFont);
+ ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt);
+ end;
+
+ ChangedCell(ACell^.Row, ACell^.Col);
+end;
+
+
+{==============================================================================}
+{ TsWorkbook code for hyperlinls }
+{==============================================================================}
+
+{@@ ----------------------------------------------------------------------------
+ Returns the hypertext font. This is font with index 6 in the font list
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetHyperlinkFont: TsFont;
+begin
+ Result := GetFont(HYPERLINK_FONTINDEX);
+end;
+
+
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet_numfmt.inc b/components/fpspreadsheet/source/common/fpspreadsheet_numfmt.inc
new file mode 100644
index 000000000..cc9f8289f
--- /dev/null
+++ b/components/fpspreadsheet/source/common/fpspreadsheet_numfmt.inc
@@ -0,0 +1,490 @@
+{ Included by fpspreadsheet.pas }
+
+{ Code for number format }
+
+{==============================================================================}
+{ TsWorksheet code for number format }
+{==============================================================================}
+
+{@@ ----------------------------------------------------------------------------
+ Determines some number format attributes (decimal places, currency symbol) of
+ a cell
+
+ @param ACell Pointer to the cell under investigation
+ @param ADecimals Number of decimal places that can be extracted from
+ the formatting string, e.g. in case of '0.000' this
+ would be 3.
+ @param ACurrencySymbol String representing the currency symbol extracted from
+ the formatting string.
+
+ @return true if the the format string could be analyzed successfully, false if not
+-------------------------------------------------------------------------------}
+function TsWorksheet.GetNumberFormatAttributes(ACell: PCell; out ADecimals: byte;
+ out ACurrencySymbol: String): Boolean;
+var
+ parser: TsNumFormatParser;
+ nf: TsNumberFormat;
+ nfs: String;
+begin
+ Result := false;
+ if ACell <> nil then
+ begin
+ ReadNumFormat(ACell, nf, nfs);
+ parser := TsNumFormatParser.Create(nfs, FWorkbook.FormatSettings);
+ try
+ if parser.Status = psOK then
+ begin
+ nf := parser.NumFormat;
+ if (nf = nfGeneral) and (ACell^.ContentType = cctNumber) then
+ begin
+ ADecimals := GetDisplayedDecimals(ACell);
+ ACurrencySymbol := '';
+ end else
+ if IsDateTimeFormat(nf) then
+ begin
+ ADecimals := 2;
+ ACurrencySymbol := '?';
+ end
+ else
+ begin
+ ADecimals := parser.Decimals;
+ ACurrencySymbol := parser.CurrencySymbol;
+ end;
+ Result := true;
+ end;
+ finally
+ parser.Free;
+ end;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the number format type and format string used in a specific cell
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.ReadNumFormat(ACell: PCell; out ANumFormat: TsNumberFormat;
+ out ANumFormatStr: String);
+var
+ fmt: PsCellFormat;
+ numFmt: TsNumFormatParams;
+begin
+ ANumFormat := nfGeneral;
+ ANumFormatStr := '';
+ if ACell <> nil then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ if (uffNumberFormat in fmt^.UsedFormattingFields) then
+ begin
+ numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
+ if numFmt <> nil then
+ begin
+ ANumFormat := numFmt.NumFormat;
+ ANumFormatStr := numFmt.NumFormatStr;
+ end else
+ begin
+ ANumFormat := nfGeneral;
+ ANumFormatStr := '';
+ end;
+ end;
+ end;
+end;
+
+
+ {@@ ----------------------------------------------------------------------------
+ Adds a date/time format to the formatting of a cell
+
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param ANumFormat Identifier of the format to be applied (nfXXXX constant)
+ @param ANumFormatString Optional string of formatting codes. Is only considered
+ if ANumberFormat is nfCustom.
+ @return Pointer to the cell
+
+ @see TsNumberFormat
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteDateTimeFormat(ARow, ACol: Cardinal;
+ ANumFormat: TsNumberFormat; const ANumFormatString: String = ''): PCell;
+begin
+ Result := GetCell(ARow, ACol);
+ WriteDateTimeFormat(Result, ANumFormat, ANumFormatString);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds a date/time format to the formatting of a cell
+
+ @param ACell Pointer to the cell considered
+ @param ANumFormat Identifier of the format to be applied (nxXXXX constant)
+ @param ANumFormatString optional string of formatting codes. Is only considered
+ if ANumberFormat is nfCustom.
+
+ @see TsNumberFormat
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.WriteDateTimeFormat(ACell: PCell;
+ ANumFormat: TsNumberFormat; const ANumFormatString: String = '');
+var
+ fmt: TsCellFormat;
+ nfs: String;
+ nfp: TsNumFormatParams;
+ isTextFmt, wasTextFmt: Boolean;
+ oldVal: String;
+begin
+ if ACell = nil then
+ exit;
+
+ if not ((ANumFormat in [nfGeneral, nfCustom]) or IsDateTimeFormat(ANumFormat)) then
+ raise EFPSpreadsheet.Create('WriteDateTimeFormat can only be called with date/time formats.');
+
+ isTextFmt := false;
+ wasTextFmt := false;
+
+ fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
+ fmt.NumberFormat := ANumFormat;
+ if (ANumFormat <> nfGeneral) then
+ begin
+ nfp := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
+ wasTextFmt := IsTextFormat(nfp);
+ oldval := ReadAsText(ACell);
+ Include(fmt.UsedFormattingFields, uffNumberFormat);
+ if (ANumFormatString = '') then
+ nfs := BuildDateTimeFormatString(ANumFormat, Workbook.FormatSettings)
+ else
+ nfs := ANumFormatString;
+ isTextFmt := (nfs = '@');
+ end else
+ begin
+ Exclude(fmt.UsedFormattingFields, uffNumberFormat);
+ fmt.NumberFormatStr := '';
+ end;
+ fmt.NumberFormat := ANumFormat;
+ fmt.NumberFormatStr := nfs;
+ fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
+ ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt);
+
+ if isTextFmt then
+ WriteText(ACell, oldval)
+ else
+ if wasTextFmt then
+ WriteCellValueAsString(ACell, ACell^.UTF8StringValue);
+
+ ChangedCell(ACell^.Row, ACell^.Col);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Formats the number in a cell to show a given count of decimal places.
+ Is ignored for non-decimal formats (such as most date/time formats).
+
+ @param ARow Row indows of the cell considered
+ @param ACol Column indows of the cell considered
+ @param ADecimals Number of decimal places to be displayed
+ @return Pointer to the cell
+ @see TsNumberFormat
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteDecimals(ARow, ACol: Cardinal; ADecimals: Byte): PCell;
+begin
+ Result := FindCell(ARow, ACol);
+ WriteDecimals(Result, ADecimals);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Formats the number in a cell to show a given count of decimal places.
+ Is ignored for non-decimal formats (such as most date/time formats).
+
+ @param ACell Pointer to the cell considered
+ @param ADecimals Number of decimal places to be displayed
+ @see TsNumberFormat
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.WriteDecimals(ACell: PCell; ADecimals: Byte);
+var
+ parser: TsNumFormatParser;
+ fmt: TsCellFormat;
+ numFmt: TsNumFormatParams;
+ numFmtStr: String;
+begin
+ if (ACell = nil) or (ACell^.ContentType <> cctNumber) then
+ exit;
+
+ fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
+ numFmt := FWorkbook.GetNumberFormat(fmt.NumberFormatIndex);
+ if numFmt <> nil then
+ numFmtStr := numFmt.NumFormatStr
+ else
+ numFmtStr := '0.00';
+ parser := TsNumFormatParser.Create(numFmtStr, Workbook.FormatSettings);
+ try
+ parser.Decimals := ADecimals;
+ numFmtStr := parser.FormatString;
+ fmt.NumberFormatIndex := Workbook.AddNumberFormat(numFmtStr);
+ Include(fmt.UsedFormattingFields, uffNumberFormat);
+ ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
+ ChangedCell(ACell^.Row, ACell^.Col);
+ finally
+ parser.Free;
+ end;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Formats a number as a fraction
+
+ @param ARow Row index of the cell
+ @param ACol Column index of the cell
+ @param ANumFormat Identifier of the format to be applied. Must be
+ either nfFraction or nfMixedFraction
+ @param ANumeratorDigts Count of numerator digits
+ @param ADenominatorDigits Count of denominator digits
+ @return Pointer to the cell
+
+ @see TsNumberFormat
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteFractionFormat(ARow, ACol: Cardinal;
+ AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer): PCell;
+begin
+ Result := GetCell(ARow, ACol);
+ WriteFractionFormat(Result, AMixedFraction, ANumeratorDigits, ADenominatorDigits);
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Formats a number as a fraction
+
+ @param ACell Pointer to the cell to be formatted
+ @param ANumFormat Identifier of the format to be applied. Must be
+ either nfFraction or nfMixedFraction
+ @param ANumeratorDigts Count of numerator digits
+ @param ADenominatorDigits Count of denominator digits
+
+ @see TsNumberFormat
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.WriteFractionFormat(ACell: PCell;
+ AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer);
+var
+ fmt: TsCellFormat;
+ nfs: String;
+begin
+ if ACell = nil then
+ exit;
+
+ fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
+ nfs := BuildFractionFormatString(AMixedFraction, ANumeratorDigits, ADenominatorDigits);
+ fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
+ Include(fmt.UsedFormattingFields, uffNumberFormat);
+ ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
+
+ ChangedCell(ACell^.Row, ACell^.Col);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds a number format to the formatting of a cell
+
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param ANumFormat Identifier of the format to be applied
+ @param ADecimals Number of decimal places
+ @param ACurrencySymbol optional currency symbol in case of nfCurrency
+ @param APosCurrFormat optional identifier for positive currencies
+ @param ANegCurrFormat optional identifier for negative currencies
+ @return Pointer to the cell
+
+ @see TsNumberFormat
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteNumberFormat(ARow, ACol: Cardinal;
+ ANumFormat: TsNumberFormat; ADecimals: Integer; ACurrencySymbol: String = '';
+ APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1): PCell;
+begin
+ Result := GetCell(ARow, ACol);
+ WriteNumberFormat(Result, ANumFormat, ADecimals, ACurrencySymbol,
+ APosCurrFormat, ANegCurrFormat);
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Adds a number format to the formatting of a cell
+
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param ANumFormat Identifier of the format to be applied
+ @param ADecimals Number of decimal places
+ @param ACurrencySymbol optional currency symbol in case of nfCurrency
+ @param APosCurrFormat optional identifier for positive currencies
+ @param ANegCurrFormat optional identifier for negative currencies
+
+ @see TsNumberFormat
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.WriteNumberFormat(ACell: PCell;
+ ANumFormat: TsNumberFormat; ADecimals: Integer; ACurrencySymbol: String = '';
+ APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1);
+var
+ fmt: TsCellFormat;
+ fmtStr: String;
+ nfp: TsNumFormatParams;
+ wasTextFmt: Boolean;
+begin
+ if ACell = nil then
+ exit;
+
+ wasTextFmt := false;
+
+ fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
+ fmt.NumberFormat := ANumFormat;
+ if ANumFormat <> nfGeneral then
+ begin
+ nfp := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
+ wasTextFmt := IsTextFormat(nfp);
+ Include(fmt.UsedFormattingFields, uffNumberFormat);
+ if IsCurrencyFormat(ANumFormat) then
+ begin
+ RegisterCurrency(ACurrencySymbol);
+ fmtStr := BuildCurrencyFormatString(ANumFormat, Workbook.FormatSettings,
+ ADecimals, APosCurrFormat, ANegCurrFormat, ACurrencySymbol);
+ end else
+ fmtStr := BuildNumberFormatString(ANumFormat,
+ Workbook.FormatSettings, ADecimals);
+ fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmtStr);
+ end else
+ begin
+ Exclude(fmt.UsedFormattingFields, uffNumberFormat);
+ fmt.NumberFormatIndex := -1;
+ end;
+ ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
+
+ if wasTextFmt then
+ WriteCellValueAsString(ACell, ACell^.UTF8StringValue);
+
+ ChangedCell(ACell^.Row, ACell^.Col);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds a number format to the formatting of a cell
+
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param ANumFormat Identifier of the format to be applied
+ @param ANumFormatString Optional string of formatting codes. Is only considered
+ if ANumberFormat is nfCustom.
+ @return Pointer to the cell
+
+ @see TsNumberFormat
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteNumberFormat(ARow, ACol: Cardinal;
+ ANumFormat: TsNumberFormat; const ANumFormatString: String = ''): PCell;
+begin
+ Result := GetCell(ARow, ACol);
+ WriteNumberFormat(Result, ANumFormat, ANumFormatString);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Adds a number format to the formatting of a cell
+
+ @param ACell Pointer to the cell considered
+ @param ANumFormat Identifier of the format to be applied
+ @param ANumFormatString Optional string of formatting codes. Is only considered
+ if ANumberFormat is nfCustom.
+
+ @see TsNumberFormat
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.WriteNumberFormat(ACell: PCell;
+ ANumFormat: TsNumberFormat; const ANumFormatString: String = '');
+var
+ fmt: TsCellFormat;
+ fmtStr: String;
+ nfp: TsNumFormatParams;
+ oldval: String;
+ isTextFmt, wasTextFmt: Boolean;
+begin
+ if ACell = nil then
+ exit;
+
+ isTextFmt := false;
+ wasTextFmt := false;
+
+ fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
+
+ if ANumFormat <> nfGeneral then begin
+ nfp := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
+ wasTextFmt := IsTextFormat(nfp);
+ oldval := ReadAsText(ACell);
+ Include(fmt.UsedFormattingFields, uffNumberFormat);
+ if (ANumFormatString = '') then
+ fmtStr := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings)
+ else
+ fmtStr := ANumFormatString;
+ isTextFmt := (fmtstr = '@');
+ fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmtStr);
+ end else begin
+ Exclude(fmt.UsedFormattingFields, uffNumberFormat);
+ fmt.NumberFormatIndex := -1;
+ end;
+ ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
+
+ if isTextFmt then
+ WriteText(ACell, oldval)
+ else
+ if wasTextFmt then
+ WriteCellValueAsString(ACell, ACell^.UTF8StringValue);
+
+ ChangedCell(ACell^.Row, ACell^.Col);
+end;
+
+
+
+{==============================================================================}
+{ TsWorkbook code for number format }
+{==============================================================================}
+
+{@@ ----------------------------------------------------------------------------
+ Adds a number format to the internal list. Returns the list index if already
+ present, or creates a new format item and returns its index.
+-------------------------------------------------------------------------------}
+function TsWorkbook.AddNumberFormat(AFormatStr: String): Integer;
+begin
+ if AFormatStr = '' then
+ Result := -1 // General number format is not stored
+ else
+ Result := TsNumFormatList(FNumFormatList).AddFormat(AFormatStr);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the parameters of the number format stored in the NumFormatList at the
+ specified index.
+ "General" number format is returned as nil.
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetNumberFormat(AIndex: Integer): TsNumFormatParams;
+begin
+ if (AIndex >= 0) and (AIndex < FNumFormatList.Count) then
+ Result := TsNumFormatParams(FNumFormatList.Items[AIndex])
+ else
+ Result := nil;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Returns the count of number format records stored in the NumFormatList
+-------------------------------------------------------------------------------}
+function TsWorkbook.GetNumberFormatCount: Integer;
+begin
+ Result := FNumFormatList.Count;
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ Removes all numberformats
+ Use carefully!
+-------------------------------------------------------------------------------}
+procedure TsWorkbook.RemoveAllNumberFormats;
+var
+ i: Integer;
+ nfp: TsNumFormatParams;
+begin
+ for i:= FEmbeddedObjList.Count-1 downto 0 do begin
+ nfp := TsNumFormatParams(FNumFormatList[i]);
+ FNumFormatList.Delete(i);
+ nfp.Free;
+ end;
+end;
+
+