paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Split more code off of fpspreadsheet.pas to separate include files.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7548 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2020-07-16 23:40:11 +00:00
parent 1339faac5a
commit 6aa2860020
10 changed files with 2531 additions and 2536 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
components/fpspreadsheet/laz_fpspreadsheet.lpk
View File

@ -270,6 +270,30 @@ This package is all you need if you don't want graphical components (like g
<Filename Value="source\common\fpspreadsheet_fmt.inc"/>
<Type Value="Binary"/>
</Item>
<Item>
<Filename Value="source\common\fpspreadsheet_hyperlinks.inc"/>
<Type Value="Binary"/>
</Item>
<Item>
<Filename Value="source\common\fpspreadsheet_comments.inc"/>
<Type Value="Binary"/>
</Item>
<Item>
<Filename Value="source\common\fpspreadsheet_embobj.inc"/>
<Type Value="Binary"/>
</Item>
<Item>
<Filename Value="source\common\fpspreadsheet_numfmt.inc"/>
<Type Value="Binary"/>
</Item>
<Item>
<Filename Value="source\common\fpspreadsheet_fonts.inc"/>
<Type Value="Binary"/>
</Item>
<Item>
<Filename Value="source\common\fpspreadsheet_clipbrd.inc"/>
<Type Value="Binary"/>
</Item>
</Files>
<i18n>
<EnableI18N Value="True"/>

2291
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

File diff suppressed because it is too large Load Diff

31
components/fpspreadsheet/source/common/fpspreadsheet_cf.inc
View File

@ -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;

218
components/fpspreadsheet/source/common/fpspreadsheet_clipbrd.inc Normal file
View File

@ -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;

120
components/fpspreadsheet/source/common/fpspreadsheet_comments.inc Normal file
View File

@ -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;

456
components/fpspreadsheet/source/common/fpspreadsheet_embobj.inc Normal file
View File

@ -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;

643
components/fpspreadsheet/source/common/fpspreadsheet_fmt.inc
View File

@ -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;

566
components/fpspreadsheet/source/common/fpspreadsheet_fonts.inc Normal file
View File

@ -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;

228
components/fpspreadsheet/source/common/fpspreadsheet_hyperlinks.inc Normal file
View File

@ -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;

490
components/fpspreadsheet/source/common/fpspreadsheet_numfmt.inc Normal file
View File

@ -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;