diff --git a/components/fpspreadsheet/examples/excel2demo/excel2write.lpr b/components/fpspreadsheet/examples/excel2demo/excel2write.lpr
index 3d967880a..16c40cded 100644
--- a/components/fpspreadsheet/examples/excel2demo/excel2write.lpr
+++ b/components/fpspreadsheet/examples/excel2demo/excel2write.lpr
@@ -33,7 +33,7 @@ begin
//MyWorksheet.WriteColWidth(0, 5);
//MyWorksheet.WriteColWidth(1, 30);
- MyWorksheet.WriteRowHeight(0, 30); // 30 mm
+ MyWorksheet.WriteRowHeight(0, 3); // 3 lines
// Turn off grid lines and hide headers
//MyWorksheet.Options := MyWorksheet.Options - [soShowGridLines, soShowHeaders];
@@ -367,16 +367,16 @@ begin
inc(r);
// Set width of columns 0 to 3
- MyWorksheet.WriteColWidth(0, 50);
- lCol.Width := 15;
+ MyWorksheet.WriteColWidth(0, 48); // 48 characters, default is 12 --> 4x default width
+ lCol.Width := 24; // 24 characters, default is 12 --> 2x default width
MyWorksheet.WriteColInfo(1, lCol);
MyWorksheet.WriteColInfo(2, lCol);
MyWorksheet.WriteColInfo(3, lCol);
// Set height of rows 5 and 6
- lRow.Height := 10;
+ lRow.Height := 4; // 4 lines
MyWorksheet.WriteRowInfo(5, lRow);
- lRow.Height := 5;
+ lRow.Height := 2; // 2 lines
MyWorksheet.WriteRowInfo(6, lRow);
// Save the spreadsheet to a file
diff --git a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr
index c4db79c3b..7b83e2b9f 100644
--- a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr
+++ b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr
@@ -45,7 +45,7 @@ begin
MyWorkbook.AddFont('Calibri', 20, [], scRed);
// Change row height
- MyWorksheet.WriteRowHeight(0, 20); // modify height of row 0 to 20 mm
+ MyWorksheet.WriteRowHeight(0, 1.1); // modify height of row 0 to 3 lines
// Change colum widths
MyWorksheet.WriteColWidth(0, 40);
diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
index a02252bc4..d8668c4b4 100644
--- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
+++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
@@ -383,7 +383,7 @@ begin
MyWorksheet.WriteColInfo(5, lCol);
// Set height of rows 0
- MyWorksheet.WriteRowHeight(0, 30); // 30 mm
+ MyWorksheet.WriteRowHeight(0, 5); // 5 lines
// Creates a new worksheet
MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2);
diff --git a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr
index 23885550b..5a3d120d4 100644
--- a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr
+++ b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr
@@ -32,6 +32,7 @@ begin
MyWorksheet.WriteUTF8Text(4, 2, 'Total:');// C5
MyWorksheet.WriteNumber(4, 3, 10); // D5
MyWorksheet.WriteDateTime(5, 0, now);
+
// Add some formatting
MyWorksheet.WriteUsedFormatting(0, 0, [uffBold]);
diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas
index 9d58f83ad..6eca158ae 100755
--- a/components/fpspreadsheet/fpsopendocument.pas
+++ b/components/fpspreadsheet/fpsopendocument.pas
@@ -61,7 +61,11 @@ type
FCellStyleList: TFPList;
FColumnStyleList: TFPList;
FColumnList: TFPList;
+ FRowStyleList: TFPList;
+ FRowList: TFPList;
FDateMode: TDateMode;
+ // Applies internally stored column widths to current worksheet
+ procedure ApplyColWidths;
// Applies a style to a cell
procedure ApplyStyleToCell(ARow, ACol: Cardinal; AStyleName: String);
// Searches a style by its name in the StyleList
@@ -69,13 +73,16 @@ type
// Searches a column style by its column index or its name in the StyleList
function FindColumnByCol(AColIndex: Integer): Integer;
function FindColStyleByName(AStyleName: String): integer;
+ function FindRowStyleByName(AStyleName: String): Integer;
// Gets value for the specified attribute. Returns empty string if attribute
// not found.
function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
- procedure ReadCells(ATableNode: TDOMNode);
procedure ReadColumns(ATableNode: TDOMNode);
+ procedure ReadColumnStyle(AStyleNode: TDOMNode);
// Figures out the base year for times in this file (dates are unambiguous)
procedure ReadDateMode(SpreadSheetNode: TDOMNode);
+ procedure ReadRowsAndCells(ATableNode: TDOMNode);
+ procedure ReadRowStyle(AStyleNode: TDOMNode);
protected
procedure CreateNumFormatList; override;
procedure ReadNumFormats(AStylesNode: TDOMNode);
@@ -97,22 +104,36 @@ type
TsSpreadOpenDocWriter = class(TsCustomSpreadWriter)
private
+ FColumnStyleList: TFPList;
+ FRowStyleList: TFPList;
+
+ // Routines to write parts of files
+ function WriteCellStylesXMLAsString: string;
+ function WriteColStylesXMLAsString: String;
+ function WriteRowStylesXMLAsString: String;
+
+ function WriteColumnsXMLAsString(ASheet: TsWorksheet): String;
+ function WriteRowsAndCellsXMLAsString(ASheet: TsWorksheet): String;
+
function WriteBackgroundColorStyleXMLAsString(const AFormat: TCell): String;
function WriteBorderStyleXMLAsString(const AFormat: TCell): String;
function WriteHorAlignmentStyleXMLAsString(const AFormat: TCell): String;
function WriteTextRotationStyleXMLAsString(const AFormat: TCell): String;
function WriteVertAlignmentStyleXMLAsString(const AFormat: TCell): String;
function WriteWordwrapStyleXMLAsString(const AFormat: TCell): String;
+
protected
FPointSeparatorSettings: TFormatSettings;
// Strings with the contents of files
- FMeta, FSettings, FStyles, FContent, FMimetype: string;
+ FMeta, FSettings, FStyles, FContent, FCellContent, FMimetype: string;
FMetaInfManifest: string;
// Streams with the contents of files
FSMeta, FSSettings, FSStyles, FSContent, FSMimetype: TStringStream;
FSMetaInfManifest: TStringStream;
// Helpers
procedure CreateNumFormatList; override;
+ procedure ListAllColumnStyles;
+ procedure ListAllRowStyles;
// Routines to write those files
procedure WriteMimetype;
procedure WriteMetaInfManifest;
@@ -121,8 +142,6 @@ type
procedure WriteStyles;
procedure WriteContent;
procedure WriteWorksheet(CurSheet: TsWorksheet);
- // Routines to write parts of those files
- function WriteStylesXMLAsString: string;
{ Record writing methods }
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
@@ -136,6 +155,7 @@ type
const AValue: TDateTime; ACell: PCell); override;
public
constructor Create(AWorkbook: TsWorkbook); override;
+ destructor Destroy; override;
{ General writing methods }
procedure WriteStringToFile(AString, AFileName: string);
procedure WriteToFile(const AFileName: string;
@@ -202,6 +222,9 @@ const
BORDER_LINEWIDTHS: array[TsLinestyle] of string =
('0.002cm', '2pt', '0.002cm', '0.002cm', '3pt', '0.039cm', '0.002cm');
+ COLWIDTH_EPS = 1e-2; // for mm
+ ROWHEIGHT_EPS = 1e-2; // for lines
+
type
{ Cell style items relevant to FPSpreadsheet. Stored in the CellStyleList of the reader. }
TCellStyleData = class
@@ -222,10 +245,10 @@ type
TColumnStyleData = class
public
Name: String;
- ColWidth: Double;
+ ColWidth: Double; // in mm
end;
- { Column data items stored in the ColList of the reader }
+ { Column data items stored in the ColumnList }
TColumnData = class
public
Col: Integer;
@@ -233,6 +256,21 @@ type
DefaultCellStyleIndex: Integer; // Index of default cell style in FCellStyleList of reader
end;
+ { Row style items stored in RowStyleList of the reader }
+ TRowStyleData = class
+ public
+ Name: String;
+ RowHeight: Double; // in mm
+ AutoRowHeight: Boolean;
+ end;
+
+ { Row data items stored in the RowList of the reader }
+ TRowData = class
+ Row: Integer;
+ RowStyleIndex: Integer; // index into FRowStyleList of reader
+ DefaultCellStyleIndex: Integer; // Index of default row style in FCellStyleList of reader
+ end;
+
{ TsSpreadOpenDocNumFormatList }
@@ -250,6 +288,8 @@ begin
FCellStyleList := TFPList.Create;
FColumnStyleList := TFPList.Create;
FColumnList := TFPList.Create;
+ FRowStyleList := TFPList.Create;
+ FRowList := TFPList.Create;
// Set up the default palette in order to have the default color names correct.
Workbook.UseDefaultPalette;
// Initial base date in case it won't be read from file
@@ -266,12 +306,49 @@ begin
for j := FColumnStyleList.Count-1 downto 0 do TObject(FColumnStyleList[j]).Free;
FColumnStyleList.Free;
+ for j := FRowList.Count-1 downto 0 do TObject(FRowList[j]).Free;
+ FRowList.Free;
+
+ for j := FRowStyleList.Count-1 downto 0 do TObject(FRowStyleList[j]).Free;
+ FRowStyleList.Free;
+
for j := FCellStyleList.Count-1 downto 0 do TObject(FCellStyleList[j]).Free;
FCellStyleList.Free;
inherited Destroy;
end;
+{ Creates for each non-default column width stored internally in FColumnList
+ a TCol record in the current worksheet. }
+procedure TsSpreadOpenDocReader.ApplyColWidths;
+var
+ colIndex: Integer;
+ colWidth: Single;
+ colStyleIndex: Integer;
+ colStyle: TColumnStyleData;
+ factor: Double;
+ col: PCol;
+ i: Integer;
+begin
+ factor := FWorkbook.GetFont(0).Size/2;
+ for i:=0 to FColumnList.Count-1 do begin
+ colIndex := TColumnData(FColumnList[i]).Col;
+ colStyleIndex := TColumnData(FColumnList[i]).ColStyleIndex;
+ colStyle := TColumnStyleData(FColumnStyleList[colStyleIndex]);
+ { The column width stored in colStyle is in mm (see ReadColumnStyles).
+ We convert it to character count by converting it to points and then by
+ dividing the points by the approximate width of the '0' character which
+ is assumed to be 50% of the default font point size. }
+ colWidth := mmToPts(colStyle.ColWidth)/factor;
+ { Add only column records to the worksheet if their width is different from
+ the default column width. }
+ if not SameValue(colWidth, Workbook.DefaultColWidth, COLWIDTH_EPS) then begin
+ col := FWorksheet.GetCol(colIndex);
+ col^.Width := colWidth;
+ end;
+ end;
+end;
+
{ Applies the style data referred to by the style name to the specified cell }
procedure TsSpreadOpenDocReader.ApplyStyleToCell(ARow, ACol: Cardinal;
AStyleName: String);
@@ -313,20 +390,19 @@ begin
cell^.FontIndex := styleData.FontIndex;
}
- // Alignment
- cell^.HorAlignment := styleData.HorAlignment;
- cell^.VertAlignment := styleData.VertAlignment;
- // Word wrap
+ // Word wrap
if styleData.WordWrap then
Include(cell^.UsedFormattingFields, uffWordWrap)
else
Exclude(cell^.UsedFormattingFields, uffWordWrap);
- // Text rotation
+
+ // Text rotation
if styleData.TextRotation > trHorizontal then
Include(cell^.UsedFormattingFields, uffTextRotation)
else
Exclude(cell^.UsedFormattingFields, uffTextRotation);
cell^.TextRotation := styledata.TextRotation;
+
// Text alignment
if styleData.HorAlignment <> haDefault then begin
Include(cell^.UsedFormattingFields, uffHorAlign);
@@ -338,6 +414,7 @@ begin
cell^.VertAlignment := styleData.VertAlignment;
end else
Exclude(cell^.UsedFormattingFields, uffVertAlign);
+
// Borders
cell^.BorderStyles := styleData.BorderStyles;
if styleData.Borders <> [] then begin
@@ -345,6 +422,7 @@ begin
cell^.Border := styleData.Borders;
end else
Exclude(cell^.UsedFormattingFields, uffBorder);
+
// Background color
if styleData.BackgroundColor <> scNotDefined then begin
Include(cell^.UsedFormattingFields, uffBackgroundColor);
@@ -398,6 +476,14 @@ begin
Result := -1;
end;
+function TsSpreadOpenDocReader.FindRowStyleByName(AStyleName: String): Integer;
+begin
+ for Result := 0 to FRowStyleList.Count-1 do
+ if TRowStyleData(FRowStyleList[Result]).Name = AStyleName then
+ exit;
+ Result := -1;
+end;
+
function TsSpreadOpenDocReader.GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
var
i : integer;
@@ -425,55 +511,6 @@ begin
ApplyStyleToCell(ARow, ACol, stylename);
end;
-{ Reads the cells in the given table. Loops through all rows, and then finds all
- cells of each row. }
-procedure TsSpreadOpenDocReader.ReadCells(ATableNode: TDOMNode);
-var
- row: Integer;
- col: Integer;
- cellNode, rowNode: TDOMNode;
- paramValueType, paramFormula, tableStyleName: String;
- paramColsRepeated, paramRowsRepeated: String;
-begin
- row := 0;
- rowNode := ATableNode.FindNode('table:table-row');
- while Assigned(rowNode) do begin
- col := 0;
-
- //process each cell of the row
- cellNode := rowNode.FindNode('table:table-cell');
- while Assigned(cellNode) do begin
- // select this cell value's type
- paramValueType := GetAttrValue(CellNode, 'office:value-type');
- paramFormula := GetAttrValue(CellNode, 'table:formula');
- tableStyleName := GetAttrValue(CellNode, 'table:style-name');
-
- if paramValueType = 'string' then
- ReadLabel(row, col, cellNode)
- else if (paramValueType = 'float') or (paramValueType = 'percentage') then
- ReadNumber(row, col, cellNode)
- else if (paramValueType = 'date') or (paramValueType = 'time') then
- ReadDate(row, col, cellNode)
- else if (paramValueType = '') and (tableStyleName <> '') then
- ReadBlank(row, col, cellNode)
- else if ParamFormula <> '' then
- ReadLabel(row, col, cellNode);
-
- paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated');
- if paramColsRepeated = '' then paramColsRepeated := '1';
- col := col + StrToInt(paramColsRepeated);
-
- cellNode := cellNode.NextSibling;
- end; //while Assigned(cellNode)
-
- paramRowsRepeated := GetAttrValue(RowNode, 'table:number-rows-repeated');
- if paramRowsRepeated = '' then paramRowsRepeated := '1';
- row := row + StrToInt(paramRowsRepeated);
-
- rowNode := rowNode.NextSibling;
- end; // while Assigned(rowNode)
-end;
-
{ Collection columns used in the given table. The columns contain links to
styles that must be used when cells in that columns are without styles. }
procedure TsSpreadOpenDocReader.ReadColumns(ATableNode: TDOMNode);
@@ -481,10 +518,17 @@ var
col: Integer;
colNode: TDOMNode;
s: String;
+ defCellStyleIndex: Integer;
colStyleIndex: Integer;
colStyleData: TColumnStyleData;
colData: TColumnData;
+ colsRepeated: Integer;
+ j: Integer;
begin
+ // clear previous column list (from other sheets)
+ for j:=FColumnList.Count-1 downto 0 do TObject(FColumnList[j]).Free;
+ FColumnList.Clear;
+
col := 0;
colNode := ATableNode.FindNode('table:table-column');
while Assigned(colNode) do begin
@@ -492,26 +536,68 @@ begin
s := GetAttrValue(colNode, 'table:style-name');
colStyleIndex := FindColStyleByName(s);
if colStyleIndex <> -1 then begin
+ defCellStyleIndex := -1;
colStyleData := TColumnStyleData(FColumnStyleList[colStyleIndex]);
s := GetAttrValue(ColNode, 'table:default-cell-style-name');
if s <> '' then begin
+ defCellStyleIndex := FindCellStyleByName(s);
colData := TColumnData.Create;
colData.Col := col;
colData.ColStyleIndex := colStyleIndex;
- colData.DefaultCellStyleIndex := FindCellStyleByName(s);
+ colData.DefaultCellStyleIndex := defCellStyleIndex;
FColumnList.Add(colData);
end;
+ s := GetAttrValue(ColNode, 'table:number-columns-repeated');
+ if s = '' then
+ inc(col)
+ else begin
+ colsRepeated := StrToInt(s);
+ if defCellStyleIndex > -1 then
+ for j:=1 to colsRepeated-1 do begin
+ colData := TColumnData.Create;
+ colData.Col := col + j;
+ colData.ColStyleIndex := colStyleIndex;
+ colData.DefaultCellStyleIndex := defCellStyleIndex;
+ FColumnList.Add(colData);
+ end;
+ inc(col, colsRepeated);
+ end;
end;
- s := GetAttrValue(ColNode, 'table:number-columns-repeated');
- if s = '' then
- inc(col)
- else
- inc(col, StrToInt(s));
end;
colNode := colNode.NextSibling;
end;
end;
+{ Reads the column styles and stores them in the FColumnStyleList for later use }
+procedure TsSpreadOpenDocReader.ReadColumnStyle(AStyleNode: TDOMNode);
+var
+ colStyle: TColumnStyleData;
+ styleName: String;
+ styleChildNode: TDOMNode;
+ colWidth: double;
+ s: String;
+begin
+ styleName := GetAttrValue(AStyleNode, 'style:name');
+ styleChildNode := AStyleNode.FirstChild;
+ colWidth := -1;
+
+ while Assigned(styleChildNode) do begin
+ if styleChildNode.NodeName = 'style:table-column-properties' then begin
+ s := GetAttrValue(styleChildNode, 'style:column-width');
+ if s <> '' then begin
+ colWidth := PtsToMM(HTMLLengthStrToPts(s)); // convert to mm
+ break;
+ end;
+ end;
+ styleChildNode := styleChildNode.NextSibling;
+ end;
+
+ colStyle := TColumnStyleData.Create;
+ colStyle.Name := styleName;
+ colStyle.ColWidth := colWidth;
+ FColumnStyleList.Add(colStyle);
+end;
+
procedure TsSpreadOpenDocReader.ReadDateMode(SpreadSheetNode: TDOMNode);
var
CalcSettingsNode, NullDateNode: TDOMNode;
@@ -592,7 +678,8 @@ begin
// Collect column styles used
ReadColumns(TableNode);
// Process each row inside the sheet and process each cell of the row
- ReadCells(TableNode);
+ ReadRowsAndCells(TableNode);
+ ApplyColWidths;
// Continue with next table
TableNode := TableNode.NextSibling;
end; //while Assigned(TableNode)
@@ -664,11 +751,12 @@ begin
fmt.TimeSeparator:=':';
Value:=GetAttrValue(ACellNode,'office:date-value');
if Value<>'' then
- begin
+ begin (* // confuses fpc!
{$IFDEF FPSPREADDEBUG}
end;
writeln('Row (1based): ',ARow+1,'office:date-value: '+Value);
- {$ENDIF}
+ {$ENDIF} *)
+
// Date or date/time string
Value:=StringReplace(Value,'T',' ',[rfIgnoreCase,rfReplaceAll]);
// Strip milliseconds?
@@ -877,6 +965,117 @@ begin
end;
end;
+{ Reads the cells in the given table. Loops through all rows, and then finds all
+ cells of each row. }
+procedure TsSpreadOpenDocReader.ReadRowsAndCells(ATableNode: TDOMNode);
+var
+ row: Integer;
+ col: Integer;
+ cellNode, rowNode: TDOMNode;
+ paramValueType, paramFormula, tableStyleName: String;
+ paramColsRepeated, paramRowsRepeated: String;
+ colsRepeated, rowsRepeated: Integer;
+ rowStyleName: String;
+ rowStyleIndex: Integer;
+ rowStyle: TRowStyleData;
+ rowHeight: Single;
+ autoRowHeight: Boolean;
+ i: Integer;
+ lRow: PRow;
+begin
+ rowsRepeated := 0;
+ row := 0;
+ rowNode := ATableNode.FindNode('table:table-row');
+ while Assigned(rowNode) do begin
+ // Read rowstyle
+ rowStyleName := GetAttrValue(rowNode, 'table:style-name');
+ rowStyleIndex := FindRowStyleByName(rowStyleName);
+ rowStyle := TRowStyleData(FRowStyleList[rowStyleIndex]);
+ rowHeight := rowStyle.RowHeight; // in mm (see ReadRowStyles)
+ rowHeight := mmToPts(rowHeight) / Workbook.GetDefaultFontSize;
+ if rowHeight > ROW_HEIGHT_CORRECTION
+ then rowHeight := rowHeight - ROW_HEIGHT_CORRECTION // in "lines"
+ else rowHeight := 0;
+ autoRowHeight := rowStyle.AutoRowHeight;
+
+ col := 0;
+
+ //process each cell of the row
+ cellNode := rowNode.FindNode('table:table-cell');
+ while Assigned(cellNode) do begin
+ // select this cell value's type
+ paramValueType := GetAttrValue(CellNode, 'office:value-type');
+ paramFormula := GetAttrValue(CellNode, 'table:formula');
+ tableStyleName := GetAttrValue(CellNode, 'table:style-name');
+
+ if paramValueType = 'string' then
+ ReadLabel(row, col, cellNode)
+ else if (paramValueType = 'float') or (paramValueType = 'percentage') then
+ ReadNumber(row, col, cellNode)
+ else if (paramValueType = 'date') or (paramValueType = 'time') then
+ ReadDate(row, col, cellNode)
+ else if (paramValueType = '') and (tableStyleName <> '') then
+ ReadBlank(row, col, cellNode)
+ else if ParamFormula <> '' then
+ ReadLabel(row, col, cellNode);
+
+ paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated');
+ if paramColsRepeated = '' then paramColsRepeated := '1';
+ col := col + StrToInt(paramColsRepeated);
+
+ cellNode := cellNode.NextSibling;
+ end; //while Assigned(cellNode)
+
+ paramRowsRepeated := GetAttrValue(RowNode, 'table:number-rows-repeated');
+ if paramRowsRepeated = '' then
+ rowsRepeated := 1
+ else
+ rowsRepeated := StrToInt(paramRowsRepeated);
+
+ // Transfer non-default row heights to sheet's rows
+ if not autoRowHeight then
+ for i:=1 to rowsRepeated do
+ FWorksheet.WriteRowHeight(row + i - 1, rowHeight);
+
+ row := row + rowsRepeated;
+
+ rowNode := rowNode.NextSibling;
+ end; // while Assigned(rowNode)
+end;
+
+procedure TsSpreadOpenDocReader.ReadRowStyle(AStyleNode: TDOMNode);
+var
+ styleName: String;
+ styleChildNode: TDOMNode;
+ rowHeight: Double;
+ auto: Boolean;
+ s: String;
+ rowStyle: TRowStyleData;
+begin
+ styleName := GetAttrValue(AStyleNode, 'style:name');
+ styleChildNode := AStyleNode.FirstChild;
+ rowHeight := -1;
+ auto := false;
+
+ while Assigned(styleChildNode) do begin
+ if styleChildNode.NodeName = 'style:table-row-properties' then begin
+ s := GetAttrValue(styleChildNode, 'style:row-height');
+ if s <> '' then
+ rowHeight := PtsToMm(HTMLLengthStrToPts(s)); // convert to mm
+ s := GetAttrValue(styleChildNode, 'style:use-optimal-row-height');
+ if s = 'true' then
+ auto := true;
+ end;
+ styleChildNode := styleChildNode.NextSibling;
+ end;
+
+ rowStyle := TRowStyleData.Create;
+ rowStyle.Name := styleName;
+ rowStyle.RowHeight := rowHeight;
+ rowStyle.AutoRowHeight := auto;
+ FRowStyleList.Add(rowStyle);
+end;
+
procedure TsSpreadOpenDocReader.ReadStyles(AStylesNode: TDOMNode);
var
fs: TFormatSettings;
@@ -983,26 +1182,12 @@ begin
family := GetAttrValue(styleNode, 'style:family');
// Column styles
- if family = 'table-column' then begin
- styleName := GetAttrValue(styleNode, 'style:name');
- styleChildNode := styleNode.FirstChild;
- colWidth := -1;
- while Assigned(styleChildNode) do begin
- if styleChildNode.NodeName = 'style:table-column-properties' then begin
- s := GetAttrValue(styleChildNode, 'style:column-width');
- if s <> '' then begin
- s := Copy(s, 1, Length(s)-2); // TO DO: use correct units!
- colWidth := StrToFloat(s, fs);
- break;
- end;
- end;
- styleChildNode := styleChildNode.NextSibling;
- end;
- colStyle := TColumnStyleData.Create;
- colStyle.Name := styleName;
- colStyle.ColWidth := colWidth;
- FColumnStyleList.Add(colStyle);
- end;
+ if family = 'table-column' then
+ ReadColumnStyle(styleNode);
+
+ // Row styles
+ if family = 'table-row' then
+ ReadRowStyle(styleNode);
// Cell styles
if family = 'table-cell' then begin
@@ -1122,6 +1307,108 @@ begin
FNumFormatList := TsSpreadOpenDocNumFormatList.Create(Workbook);
end;
+procedure TsSpreadOpenDocWriter.ListAllColumnStyles;
+var
+ i, j, c: Integer;
+ sheet: TsWorksheet;
+ found: Boolean;
+ colstyle: TColumnStyleData;
+ w: Double;
+ multiplier: Double;
+begin
+ { At first, add the default column width }
+ colStyle := TColumnStyleData.Create;
+ colStyle.Name := 'co1';
+ colStyle.ColWidth := Workbook.DefaultColWidth;
+ FColumnStyleList.Add(colStyle);
+
+ for i:=0 to Workbook.GetWorksheetCount-1 do begin
+ sheet := Workbook.GetWorksheetByIndex(i);
+ for c:=0 to sheet.GetLastColIndex do begin
+ w := sheet.GetColWidth(c);
+ // Look for this width in the current ColumnStyleList
+ found := false;
+ for j := 0 to FColumnStyleList.Count-1 do
+ if SameValue(TColumnStyleData(FColumnStyleList[j]).ColWidth, w, COLWIDTH_EPS)
+ then begin
+ found := true;
+ break;
+ end;
+ // Not found? Then add the column as new column style
+ if not found then begin
+ colStyle := TColumnStyleData.Create;
+ colStyle.Name := Format('co%d', [FColumnStyleList.Count+1]);
+ colStyle.ColWidth := w;
+ FColumnStyleList.Add(colStyle);
+ end;
+ end;
+ end;
+
+ { fpspreadsheet's column width is the count of '0' characters of the
+ default font. On average, the width of the '0' is about half of the
+ point size of the font. --> we can convert the fps col width to pts and
+ then to millimeters. }
+ multiplier := Workbook.GetFont(0).Size / 2;
+ for i:=0 to FColumnStyleList.Count-1 do begin
+ w := TColumnStyleData(FColumnStyleList[i]).ColWidth * multiplier;
+ TColumnStyleData(FColumnStyleList[i]).ColWidth := PtsToMM(w);
+ end;
+end;
+
+procedure TsSpreadOpenDocWriter.ListAllRowStyles;
+var
+ i, j, r: Integer;
+ sheet: TsWorksheet;
+ row: PRow;
+ found: Boolean;
+ rowstyle: TRowStyleData;
+ h, multiplier: Double;
+begin
+ { At first, add the default row height }
+ { Initially, row height units will be the same as in the sheet, i.e. in "lines" }
+ rowStyle := TRowStyleData.Create;
+ rowStyle.Name := 'ro1';
+ rowStyle.RowHeight := Workbook.DefaultRowHeight;
+ rowStyle.AutoRowHeight := true;
+ FRowStyleList.Add(rowStyle);
+
+ for i:=0 to Workbook.GetWorksheetCount-1 do begin
+ sheet := Workbook.GetWorksheetByIndex(i);
+ for r:=0 to sheet.GetLastRowIndex do begin
+ row := sheet.FindRow(r);
+ if row <> nil then begin
+ h := sheet.GetRowHeight(r);
+ // Look for this height in the current RowStyleList
+ found := false;
+ for j:=0 to FRowStyleList.Count-1 do
+ if SameValue(TRowStyleData(FRowStyleList[j]).RowHeight, h, ROWHEIGHT_EPS) and
+ (not TRowStyleData(FRowStyleList[j]).AutoRowHeight)
+ then begin
+ found := true;
+ break;
+ end;
+ // Not found? Then add the row as a new row style
+ if not found then begin
+ rowStyle := TRowStyleData.Create;
+ rowStyle.Name := Format('ro%d', [FRowStyleList.Count+1]);
+ rowStyle.RowHeight := h;
+ rowStyle.AutoRowHeight := false;
+ FRowStyleList.Add(rowStyle);
+ end;
+ end;
+ end;
+ end;
+
+ { fpspreadsheet's row heights are measured as line count of the default font.
+ Using the default font size (which is in points) we convert the line count
+ to points and then to millimeters as needed by ods. }
+ multiplier := Workbook.GetDefaultFontSize;;
+ for i:=0 to FRowStyleList.Count-1 do begin
+ h := (TRowStyleData(FRowStyleList[i]).RowHeight + ROW_HEIGHT_CORRECTION) * multiplier;
+ TRowStyleData(FRowStyleList[i]).RowHeight := PtsToMM(h);
+ end;
+end;
+
procedure TsSpreadOpenDocWriter.WriteMimetype;
begin
FMimetype := 'application/vnd.oasis.opendocument.spreadsheet';
@@ -1229,11 +1516,27 @@ end;
procedure TsSpreadOpenDocWriter.WriteContent;
var
i: Integer;
- lStylesCode: string;
+ lCellStylesCode: string;
+ lColStylesCode: String;
+ lRowStylesCode: String;
begin
+ ListAllColumnStyles;
+ ListAllRowStyles;
ListAllFormattingStyles;
- lStylesCode := WriteStylesXMLAsString;
+ lColStylesCode := WriteColStylesXMLAsString;
+ if lColStylesCode = '' then lColStylesCode :=
+ ' ' + LineEnding +
+ ' ' + LineEnding +
+ ' ' + LineEnding;
+
+ lRowStylesCode := WriteRowStylesXMLAsString;
+ if lRowStylesCode = '' then lRowStylesCode :=
+ ' ' + LineEnding +
+ ' ' + LineEnding +
+ ' ' + LineEnding;
+
+ lCellStylesCode := WriteCellStylesXMLAsString;
FContent :=
XML_HEADER + LineEnding +
@@ -1266,17 +1569,14 @@ begin
// Automatic styles
' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
+ lColStylesCode +
+ lRowStylesCode +
' ' + LineEnding +
' ' + LineEnding +
' ' + LineEnding +
+
// Automatically Generated Styles
- lStylesCode +
+ lCellStylesCode +
' ' + LineEnding +
// Body
@@ -1301,45 +1601,35 @@ var
LastColIndex: Cardinal;
LCell: TCell;
AVLNode: TAVLTreeNode;
+ defFontSize: Single;
+ h, h_mm: Double;
+ styleName: String;
+ rowStyleData: TRowStyleData;
+ row: PRow;
begin
LastColIndex := CurSheet.GetLastColIndex;
+ defFontSize := Workbook.GetFont(0).Size;
// Header
FContent := FContent +
- ' ' + LineEnding +
- ' ' + LineEnding;
+ ' ' + LineEnding;
+ // columns
+ FContent := FContent + WriteColumnsXMLAsString(CurSheet);
+
+ // rows and cells
// The cells need to be written in order, row by row, cell by cell
- for j := 0 to CurSheet.GetLastRowIndex do
- begin
- FContent := FContent +
- ' ' + LineEnding;
-
- // Write cells from this row.
- for k := 0 to LastColIndex do
- begin
- LCell.Row := j;
- LCell.Col := k;
- AVLNode := CurSheet.Cells.Find(@LCell);
- if Assigned(AVLNode) then
- WriteCellCallback(PCell(AVLNode.Data), nil)
- else
- FContent := FContent + '' + LineEnding;
- end;
-
- FContent := FContent +
- ' ' + LineEnding;
- end;
+ FContent := FContent + WriteRowsAndCellsXMLAsString(CurSheet);
// Footer
FContent := FContent +
' ' + LineEnding;
end;
-function TsSpreadOpenDocWriter.WriteStylesXMLAsString: string;
+function TsSpreadOpenDocWriter.WriteCellStylesXMLAsString: string;
var
i: Integer;
+ s: String;
begin
Result := '';
@@ -1357,29 +1647,20 @@ begin
' ' + LineEnding;
// style:table-cell-properties
- if (FFormattingStyles[i].UsedFormattingFields *
- [uffBorder, uffBackgroundColor, uffWordWrap, uffTextRotation, uffVertAlign] <> [])
- then begin
+ s := WriteBorderStyleXMLAsString(FFormattingStyles[i]) +
+ WriteBackgroundColorStyleXMLAsString(FFormattingStyles[i]) +
+ WriteWordwrapStyleXMLAsString(FFormattingStyles[i]) +
+ WriteTextRotationStyleXMLAsString(FFormattingStyles[i]) +
+ WriteVertAlignmentStyleXMLAsString(FFormattingStyles[i]);
+ if s <> '' then
Result := Result +
- ' ' + LineEnding;
- end;
+ ' ' + LineEnding;
// style:paragraph-properties
- if (uffHorAlign in FFormattingStyles[i].UsedFormattingFields) and
- (FFormattingStyles[i].HorAlignment <> haDefault)
- then begin
+ s := WriteHorAlignmentStyleXMLAsString(FFormattingStyles[i]);
+ if s <> '' then
Result := Result +
- ' ' + LineEnding;
- end;
-
+ ' ' + LineEnding;
// End
Result := Result +
@@ -1387,14 +1668,260 @@ begin
end;
end;
+function TsSpreadOpenDocWriter.WriteColStylesXMLAsString: string;
+var
+ i: Integer;
+ s: String;
+ colstyle: TColumnStyleData;
+begin
+ Result := '';
+
+ for i := 0 to FColumnStyleList.Count-1 do begin
+ colStyle := TColumnStyleData(FColumnStyleList[i]);
+
+ // Start and Name
+ Result := Result +
+ ' ' + LineEnding;
+
+ // Column width
+ Result := Result +
+ ' ' + LineEnding;
+
+ // End
+ Result := Result +
+ ' ' + LineEnding;
+
+ Result := Format(Result, [colStyle.Name, colStyle.ColWidth], FPointSeparatorSettings);
+ end;
+end;
+
+function TsSpreadOpenDocWriter.WriteColumnsXMLAsString(ASheet: TsWorksheet): String;
+var
+ lastCol: Integer;
+ j, k: Integer;
+ w, w_mm: Double;
+ widthMultiplier: Double;
+ styleName: String;
+ colsRepeated: Integer;
+ colsRepeatedStr: String;
+begin
+ Result := '';
+
+ widthMultiplier := Workbook.GetFont(0).Size / 2;
+ lastCol := ASheet.GetLastColIndex;
+
+ j := 0;
+ while (j <= lastCol) do begin
+ w := ASheet.GetColWidth(j);
+ // Convert to mm
+ w_mm := PtsToMM(w * widthMultiplier);
+
+ // Find width in ColumnStyleList to retrieve corresponding style name
+ styleName := '';
+ for k := 0 to FColumnStyleList.Count-1 do
+ if SameValue(TColumnStyleData(FColumnStyleList[k]).ColWidth, w_mm, COLWIDTH_EPS) then begin
+ styleName := TColumnStyleData(FColumnStyleList[k]).Name;
+ break;
+ end;
+ if stylename = '' then
+ raise Exception.Create('Column style not found.');
+
+ // Determine value for "number-columns-repeated"
+ colsRepeated := 1;
+ k := j+1;
+ while (k <= lastCol) do begin
+ if ASheet.GetColWidth(k) = w then
+ inc(colsRepeated)
+ else
+ break;
+ inc(k);
+ end;
+ colsRepeatedStr := IfThen(colsRepeated = 1, '', Format(' table:number-columns-repeated="%d"', [colsRepeated]));
+
+ Result := Result + Format(
+ ' ',
+ [styleName, colsRepeatedStr]) + LineEnding;
+
+ j := j + colsRepeated;
+ end;
+end;
+
+function TsSpreadOpenDocWriter.WriteRowsAndCellsXMLAsString(ASheet: TsWorksheet): String;
+var
+ r, rr: Cardinal; // row index in sheet
+ c, cc: Cardinal; // column index in sheet
+ row: PRow; // sheet row record
+ cell: PCell; // current cell
+ styleName: String;
+ k: Integer;
+ h, h_mm: Single; // row height in "lines" and millimeters, respectively
+ h1: Single;
+ colsRepeated: Integer;
+ rowsRepeated: Integer;
+ colsRepeatedStr: String;
+ rowsRepeatedStr: String;
+ lastCol, lastRow: Cardinal;
+ rowStyleData: TRowStyleData;
+ colData: TColumnData;
+ colStyleData: TColumnStyleData;
+ defFontSize: Single;
+ sameRowStyle: Boolean;
+begin
+ Result := '';
+
+ // some abbreviations...
+ lastCol := ASheet.GetLastColIndex;
+ lastRow := ASheet.GetLastRowIndex;
+ defFontSize := Workbook.GetFont(0).Size;
+
+ // Now loop through all rows
+ r := 0;
+ while (r <= lastRow) do begin
+ // Look for the row style of the current row (r)
+ row := ASheet.FindRow(r);
+ if row = nil then
+ styleName := 'ro1'
+ else begin
+ styleName := '';
+
+ h := row^.Height; // row height in "lines"
+ h_mm := PtsToMM((h + ROW_HEIGHT_CORRECTION) * defFontSize); // in mm
+ for k := 0 to FRowStyleList.Count-1 do begin
+ rowStyleData := TRowStyleData(FRowStyleList[k]);
+ // Compare row heights, but be aware of rounding errors
+ if SameValue(rowStyleData.RowHeight, h_mm, 1E-3) then begin
+ styleName := rowStyleData.Name;
+ break;
+ end;
+ end;
+ if styleName = '' then
+ raise Exception.Create('Row style not found.');
+ end;
+
+ // Look for empty rows with the same style, they need the "number-rows-repeated" element.
+ rowsRepeated := 1;
+ if ASheet.GetCellCountInRow(r) = 0 then begin
+ rr := r + 1;
+ while (rr <= lastRow) do begin
+ if ASheet.GetCellCountInRow(rr) > 0 then begin
+ break;
+ end;
+ h1 := ASheet.GetRowHeight(rr);
+ if not SameValue(h, h1, ROWHEIGHT_EPS) then
+ break;
+ inc(rr);
+ end;
+ rowsRepeated := rr - r;
+ rowsRepeatedStr := IfThen(rowsRepeated = 1, '',
+ Format('table:number-rows-repeated="%d"', [rowsRepeated]));
+ colsRepeated := lastCol+1;
+ colsRepeatedStr := IfThen(colsRepeated = 1, '',
+ Format('table:number-columns-repeated="%d"', [colsRepeated]));
+ Result := Result + Format(
+ ' ' + LineEnding +
+ ' ' + LineEnding +
+ ' ' + LineEnding,
+ [styleName, rowsRepeatedStr, colsRepeatedStr]);
+ r := rr;
+ continue;
+ end;
+
+ // Now we know that there are cells.
+ // Write the row XML
+ Result := Result + Format(
+ ' ', [styleName]) + LineEnding;
+
+ // Loop along the row and find the cells.
+ c := 0;
+ while c <= lastCol do begin
+ // Get the cell from the sheet
+ cell := ASheet.FindCell(r, c);
+ // Empty cell? Need to count how many to add "table:number-columns-repeated"
+ colsRepeated := 1;
+ if cell = nil then begin
+ cc := c + 1;
+ while (cc <= lastCol) do begin
+ cell := ASheet.FindCell(r, cc);
+ if cell <> nil then
+ break;
+ inc(cc)
+ end;
+ colsRepeated := cc - c;
+ colsRepeatedStr := IfThen(colsRepeated = 1, '',
+ Format('table:number-columns-repeated="%d"', [colsRepeated]));
+ Result := Result + Format(
+ ' ', [colsRepeatedStr]) + LineEnding;
+ end
+ else begin
+ WriteCellCallback(cell, nil);
+ Result := Result + FCellContent;
+ end;
+ inc(c, colsRepeated);
+ end;
+
+ Result := Result +
+ ' ' + LineEnding;
+
+ // Next row
+ inc(r, rowsRepeated);
+ end;
+end;
+
+function TsSpreadOpenDocWriter.WriteRowStylesXMLAsString: string;
+const
+ FALSE_TRUE: array[boolean] of string = ('false', 'true');
+var
+ i: Integer;
+ s: String;
+ rowstyle: TRowStyleData;
+begin
+ Result := '';
+
+ for i := 0 to FRowStyleList.Count-1 do begin
+ rowStyle := TRowStyleData(FRowStyleList[i]);
+
+ // Start and Name
+ Result := Result +
+ ' ' + LineEnding;
+
+ // Column width
+ Result := Result +
+ ' ' + LineEnding;
+
+ // End
+ Result := Result +
+ ' ' + LineEnding;
+
+ Result := Format(Result,
+ [rowStyle.Name, rowStyle.RowHeight, FALSE_TRUE[rowStyle.AutoRowHeight]],
+ FPointSeparatorSettings
+ );
+ end;
+end;
+
+
constructor TsSpreadOpenDocWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
+ FColumnStyleList := TFPList.Create;
+ FRowStyleList := TFPList.Create;
+
FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator:='.';
end;
+destructor TsSpreadOpenDocWriter.Destroy;
+var
+ j: Integer;
+begin
+ for j:=FColumnStyleList.Count-1 downto 0 do TObject(FColumnStyleList[j]).Free;
+ FColumnStyleList.Free;
+
+ for j:=FRowStyleList.Count-1 downto 0 do TObject(FRowStyleList[j]).Free;
+ FRowStyleList.Free;
+end;
+
{
Writes a string to a file. Helper convenience method.
}
@@ -1495,10 +2022,11 @@ begin
if ACell^.UsedFormattingFields <> [] then begin
lIndex := FindFormattingInList(ACell);
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
- FContent := FContent +
+ FCellContent :=
' ' + LineEnding +
' ' + LineEnding;
- end;
+ end else
+ FCellContent := '';
end;
{ Creates an XML string for inclusion of the background color into the
@@ -1649,14 +2177,14 @@ var
lStyle: string = '';
lIndex: Integer;
begin
- if ACell^.UsedFormattingFields <> [] then
- begin
+ if ACell^.UsedFormattingFields <> [] then begin
lIndex := FindFormattingInList(ACell);
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
- end;
+ end else
+ lStyle := '';
// The row should already be the correct one
- FContent := FContent +
+ FCellContent :=
' ' + LineEnding +
' ' + UTF8TextToXMLText(AValue) + '' + LineEnding +
' ' + LineEnding;
@@ -1670,11 +2198,11 @@ var
lStyle: string = '';
lIndex: Integer;
begin
- if ACell^.UsedFormattingFields <> [] then
- begin
+ if ACell^.UsedFormattingFields <> [] then begin
lIndex := FindFormattingInList(ACell);
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
- end;
+ end else
+ lStyle := '';
// The row should already be the correct one
if IsInfinite(AValue) then begin
@@ -1684,7 +2212,7 @@ begin
StrValue:=FloatToStr(AValue,FPointSeparatorSettings); //Uses '.' as decimal separator
DisplayStr:=FloatToStr(AValue); // Uses locale decimal separator
end;
- FContent := FContent +
+ FCellContent :=
' ' + LineEnding +
' ' + DisplayStr + '' + LineEnding +
' ' + LineEnding;
@@ -1703,14 +2231,14 @@ var
lStyle: string = '';
lIndex: Integer;
begin
- if ACell^.UsedFormattingFields <> [] then
- begin
+ if ACell^.UsedFormattingFields <> [] then begin
lIndex := FindFormattingInList(ACell);
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
- end;
+ end else
+ lStyle := '';
// The row should already be the correct one
- FContent := FContent +
+ FCellContent :=
' ' + LineEnding +
' ' + LineEnding;
end;
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index e8cc117de..6a76b6319 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -335,16 +335,22 @@ type
PCell = ^TCell;
+const
+ // Takes account of effect of cell margins on row height by adding this
+ // value to the nominal row height. Note that this is an empirical value and may be wrong.
+ ROW_HEIGHT_CORRECTION = 0.2;
+
+type
TRow = record
Row: Cardinal;
- Height: Single; // in millimeters
+ Height: Single; // in "lines"
end;
PRow = ^TRow;
TCol = record
Col: Cardinal;
- Width: Single; // in "characters". Excel uses the with of char "0" in 1st font
+ Width: Single; // in "characters". Excel uses the width of char "0" in 1st font
end;
PCol = ^TCol;
@@ -368,7 +374,7 @@ type
FWorkbook: TsWorkbook;
FCells: TAvlTree; // Items are TCell
FCurrentNode: TAVLTreeNode; // For GetFirstCell and GetNextCell
- FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from the standard
+ FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from default
FLeftPaneWidth: Integer;
FTopPaneHeight: Integer;
FOptions: TsSheetOptions;
@@ -475,8 +481,12 @@ type
{ Data manipulation methods - For Rows and Cols }
function FindRow(ARow: Cardinal): PRow;
function FindCol(ACol: Cardinal): PCol;
+ function GetCellCountInRow(ARow: Cardinal): Cardinal;
+ function GetCellCountInCol(ACol: Cardinal): Cardinal;
function GetRow(ARow: Cardinal): PRow;
+ function GetRowHeight(ARow: Cardinal): Single;
function GetCol(ACol: Cardinal): PCol;
+ function GetColWidth(ACol: Cardinal): Single;
procedure RemoveAllRows;
procedure RemoveAllCols;
procedure WriteRowInfo(ARow: Cardinal; AData: TRow);
@@ -511,10 +521,15 @@ type
FBuiltinFontCount: Integer;
FPalette: array of TsColorValue;
FReadFormulas: Boolean;
+ FDefaultColWidth: Single; // in "characters". Excel uses the width of char "0" in 1st font
+ FDefaultRowHeight: Single; // in "character heights", i.e. line count
+
{ Internal methods }
procedure RemoveWorksheetsCallback(data, arg: pointer);
+
public
FormatSettings: TFormatSettings;
+
{ Base methods }
constructor Create;
destructor Destroy; override;
@@ -530,6 +545,7 @@ type
const AOverwriteExisting: Boolean = False); overload;
procedure WriteToFile(const AFileName: String; const AOverwriteExisting: Boolean = False); overload;
procedure WriteToStream(AStream: TStream; AFormat: TsSpreadsheetFormat);
+
{ Worksheet list handling methods }
function AddWorksheet(AName: string): TsWorksheet;
function GetFirstWorksheet: TsWorksheet;
@@ -537,6 +553,7 @@ type
function GetWorksheetByName(AName: String): TsWorksheet;
function GetWorksheetCount: Cardinal;
procedure RemoveAllWorksheets;
+
{ Font handling }
function AddFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor): Integer; overload;
@@ -544,11 +561,13 @@ type
procedure CopyFontList(ASource: TFPList);
function FindFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor): Integer;
+ function GetDefaultFontSize: Single;
function GetFont(AIndex: Integer): TsFont;
function GetFontCount: Integer;
procedure InitFonts;
procedure RemoveAllFonts;
procedure SetDefaultFont(const AFontName: String; ASize: Single);
+
{ Color handling }
function AddColorToPalette(AColorValue: TsColorValue): TsColor;
function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): String;
@@ -560,6 +579,13 @@ type
procedure UseDefaultPalette;
procedure UsePalette(APalette: PsPalette; APaletteCount: Word;
ABigEndian: Boolean = false);
+
+ {@@ The default column width given in "character units" (width of the
+ character "0" in the default font) }
+ property DefaultColWidth: Single read FDefaultColWidth;
+ {@@ The default row height is given in "line count" (height of the
+ default font }
+ property DefaultRowHeight: Single read FDefaultRowHeight;
{@@ This property is only used for formats which don't support unicode
and support a single encoding for the whole document, like Excel 2 to 5 }
property Encoding: TsEncoding read FEncoding write FEncoding;
@@ -1366,6 +1392,7 @@ end;
function TsWorksheet.GetLastColIndex: Cardinal;
var
AVLNode: TAVLTreeNode;
+ i: Integer;
begin
Result := 0;
@@ -1378,6 +1405,12 @@ begin
Result := Math.Max(Result, PCell(AVLNode.Data)^.Col);
AVLNode := FCells.FindSuccessor(AVLNode);
end;
+
+ // In addition, there may be column records defining the column width even
+ // without content
+ for i:=0 to FCols.Count-1 do
+ if FCols[i] <> nil then
+ Result := Math.Max(Result, PCol(FCols[i])^.Col);
end;
function TsWorksheet.GetLastColNumber: Cardinal;
@@ -1424,12 +1457,18 @@ end;
function TsWorksheet.GetLastRowIndex: Cardinal;
var
AVLNode: TAVLTreeNode;
+ i: Integer;
begin
Result := 0;
AVLNode := FCells.FindHighest;
if Assigned(AVLNode) then
Result := PCell(AVLNode.Data).Row;
+
+ // In addition, there may be row records even for empty rows.
+ for i:=0 to FRows.Count-1 do
+ if FRows[i] <> nil then
+ Result := Math.Max(Result, PRow(FRows[i])^.Row);
end;
function TsWorksheet.GetLastRowNumber: Cardinal;
@@ -2243,7 +2282,6 @@ var
AVLNode: TAVGLVLTreeNode;
begin
Result := nil;
-
LElement.Row := ARow;
AVLNode := FRows.Find(@LElement);
if Assigned(AVLNode) then
@@ -2256,7 +2294,6 @@ var
AVLNode: TAVGLVLTreeNode;
begin
Result := nil;
-
LElement.Col := ACol;
AVLNode := FCols.Find(@LElement);
if Assigned(AVLNode) then
@@ -2285,6 +2322,72 @@ begin
end;
end;
+{ Counts how many cells exist in the given column. Blank cells do contribute
+ to the sum, as well as rows with a non-default style. }
+function TsWorksheet.GetCellCountInCol(ACol: Cardinal): Cardinal;
+var
+ cell: PCell;
+ r: Cardinal;
+ row: PRow;
+begin
+ Result := 0;
+ for r := 0 to GetLastRowIndex do begin
+ cell := FindCell(r, ACol);
+ if cell <> nil then
+ inc(Result)
+ else begin
+ row := FindRow(r);
+ if row <> nil then inc(Result);
+ end;
+ end;
+end;
+
+{ Counts how many cells exist in the given row. Blank cells do contribute
+ to the sum, as well as columns with a non-default style. }
+function TsWorksheet.GetCellCountInRow(ARow: Cardinal): Cardinal;
+var
+ cell: PCell;
+ c: Cardinal;
+ col: PCol;
+begin
+ Result := 0;
+ for c := 0 to GetLastColIndex do begin
+ cell := FindCell(ARow, c);
+ if cell <> nil then
+ inc(Result)
+ else begin
+ col := FindCol(c);
+ if col <> nil then inc(Result);
+ end;
+ end;
+end;
+
+{ Returns the width of the given column. If there is no column record then
+ the default column width is returned. }
+function TsWorksheet.GetColWidth(ACol: Cardinal): Single;
+var
+ col: PCol;
+begin
+ col := FindCol(ACol);
+ if col <> nil then
+ Result := col^.Width
+ else
+ Result := FWorkbook.DefaultColWidth;
+end;
+
+{ Returns the height of the given row. If there is no row record then the
+ default row height is returned }
+function TsWorksheet.GetRowHeight(ARow: Cardinal): Single;
+var
+ row: PRow;
+begin
+ row := FindRow(ARow);
+ if row <> nil then
+ Result := row^.Height
+ else
+ Result := FWorkbook.DefaultRowHeight;
+end;
+
procedure TsWorksheet.RemoveAllRows;
var
Node: Pointer;
@@ -2359,6 +2462,8 @@ constructor TsWorkbook.Create;
begin
inherited Create;
FWorksheets := TFPList.Create;
+ FDefaultColWidth := 12;
+ FDefaultRowHeight := 1;
FormatSettings := DefaultFormatSettings;
FFontList := TFPList.Create;
SetDefaultFont('Arial', 10.0);
@@ -2777,7 +2882,6 @@ begin
// FONT4 which does not exist in BIFF is added automatically with nil as place-holder
AddFont(fntName, fntSize, [fssBold, fssItalic], scBlack); // FONT5 for uffBoldItalic
-
FBuiltinFontCount := FFontList.Count;
end;
@@ -2816,6 +2920,14 @@ begin
end;
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.
}
diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas
index ce747981b..4bd9d6496 100644
--- a/components/fpspreadsheet/fpspreadsheetgrid.pas
+++ b/components/fpspreadsheet/fpspreadsheetgrid.pas
@@ -525,10 +525,13 @@ begin
Result := h;
end;
-{ Converts the row height, given in mm, to pixels }
+{ Converts the row height (from a worksheet row), given in lines, to pixels }
function TsCustomWorksheetGrid.CalcRowHeight(AHeight: Single): Integer;
+var
+ h_pts: Single;
begin
- Result := round(AHeight / 25.4 * Screen.PixelsPerInch) + 4;
+ h_pts := AHeight * (Workbook.GetFont(0).Size + ROW_HEIGHT_CORRECTION);
+ Result := PtsToPX(h_pts, Screen.PixelsPerInch) + 4;
end;
procedure TsCustomWorksheetGrid.ChangedCellHandler(ASender: TObject; ARow, ACol:Cardinal);
@@ -1871,7 +1874,7 @@ end;
procedure TsCustomWorksheetGrid.HeaderSized(IsColumn: Boolean; index: Integer);
var
w0: Integer;
- h: Single;
+ h, h_pts: Single;
begin
if FWorksheet = nil then
exit;
@@ -1884,8 +1887,9 @@ begin
FWorksheet.WriteColWidth(GetWorksheetCol(Index), ColWidths[Index] div w0);
end else begin
// The grid's row heights are in "pixels", the worksheet's row heights are
- // in millimeters.
- h := (RowHeights[Index] - 4) / Screen.PixelsPerInch * 25.4;
+ // in "lines"
+ h_pts := PxToPts(RowHeights[Index] - 4, Screen.PixelsPerInch); // in points
+ h := h_pts / (FWorkbook.GetFont(0).Size + ROW_HEIGHT_CORRECTION);
FWorksheet.WriteRowHeight(GetWorksheetRow(Index), h);
end;
end;
@@ -2616,6 +2620,7 @@ end;
initialization
+ fpsutils.ScreenPixelsPerInch := Screen.PixelsPerInch;
finalization
FreeAndNil(FillPattern_BIFF2);
diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas
index dae8e180b..021d463ae 100644
--- a/components/fpspreadsheet/fpsutils.pas
+++ b/components/fpspreadsheet/fpsutils.pas
@@ -66,9 +66,6 @@ function GetErrorValueStr(AErrorValue: TsErrorValue): String;
function UTF8TextToXMLText(AText: ansistring): ansistring;
-function TwipsToMillimeters(AValue: Integer): Single;
-function MillimetersToTwips(AValue: Single): Integer;
-
function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload;
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
@@ -102,12 +99,24 @@ function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string;
+function TwipsToPts(AValue: Integer): Single;
+function PtsToTwips(AValue: Single): Integer;
function cmToPts(AValue: Double): Double;
+function PtsToCm(AValue: Double): Double;
+function InToPts(AValue: Double): Double;
function mmToPts(AValue: Double): Double;
+function PtsToMM(AValue: Double): Double;
+function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double;
+function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer;
+function HTMLLengthStrToPts(AValue: String): Double;
+//function HMTLLengthStrToPts(AValue: String): Double;
function HTMLColorStrToColor(AValue: String): TsColorValue;
function ColorToHTMLColorStr(AValue: TsColorValue): String;
+var
+ ScreenPixelsPerInch: Integer = 96;
+
implementation
uses
@@ -533,19 +542,6 @@ begin
Result:=WrkStr;
end;
-{ Excel's unit of row heights is "twips", i.e. 1/20 point. 72 pts = 1 inch = 25.4 mm
- The procedure TwipsToMillimeters performs the conversion to millimeters. }
-function TwipsToMillimeters(AValue: Integer): Single;
-begin
- Result := 25.4 * AValue / (20 * 72);
-end;
-
-{ Converts Millimeters to Twips, i.e. 1/20 pt }
-function MillimetersToTwips(AValue: Single): Integer;
-begin
- Result := Round((AValue * 20 * 72) / 25.4);
-end;
-
{ Returns either AValue1 or AValue2, depending on the condition.
For reduciton of typing... }
function IfThen(ACondition: Boolean; AValue1, AValue2: TsNumberFormat): TsNumberFormat;
@@ -1296,16 +1292,82 @@ begin
DateTimeToString(Result, FormatStr, DateTime, FormatSettings,Options);
end;
+{ Excel's unit of row heights is "twips", i.e. 1/20 point.
+ Converts Twips to points. }
+function TwipsToPts(AValue: Integer): Single;
+begin
+ Result := AValue / 20;
+end;
+
+{ Converts points to twips (1 twip = 1/20 point) }
+function PtsToTwips(AValue: Single): Integer;
+begin
+ Result := round(AValue * 20);
+end;
+
{ Converts centimeters to points (72 pts = 1 inch) }
function cmToPts(AValue: Double): Double;
begin
- Result := AValue/2.54*72;
+ Result := AValue * 72 / 2.54;
+end;
+
+{ Converts points to centimeters }
+function PtsToCm(AValue: Double): Double;
+begin
+ Result := AValue / 72 * 2.54;
+end;
+
+{ Converts inches to points (72 pts = 1 inch) }
+function InToPts(AValue: Double): Double;
+begin
+ Result := AValue * 72;
end;
{ Converts millimeters to points (72 pts = 1 inch) }
function mmToPts(AValue: Double): Double;
begin
- Result := AValue/25.4*72;
+ Result := AValue * 72 / 25.4;
+end;
+
+{ Converts points to millimeters }
+function PtsToMM(AValue: Double): Double;
+begin
+ Result := AValue / 72 * 25.4;
+end;
+
+{ Converts pixels to points. }
+function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double;
+begin
+ Result := (AValue / AScreenPixelsPerInch) * 72;
+end;
+
+{ Converts points to pixels }
+function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer;
+begin
+ Result := Round(AValue / 72 * AScreenPixelsPerInch);
+end;
+
+{ converts a HTML length string to points. The units are assumed to be the last
+ two digits of the string }
+function HTMLLengthStrToPts(AValue: String): Double;
+var
+ units: String;
+ x: Double;
+ res: Word;
+begin
+ units := lowercase(Copy(AValue, Length(AValue)-1, 2));
+ val(copy(AValue, 1, Length(AValue)-2), x, res);
+ // No hasseling with the decimal point...
+ if units = 'in' then
+ Result := InToPts(x)
+ else if units = 'cm' then
+ Result := cmToPts(x)
+ else if units = 'mm' then
+ Result := mmToPts(x)
+ else if units = 'px' then
+ Result := pxToPts(Round(x), ScreenPixelsPerInch)
+ else
+ raise Exception.Create('Unknown length units');
end;
{ converts a HTML color string to a TsColorValue. For ods }
diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas
index fbcf03657..82402d6a7 100644
--- a/components/fpspreadsheet/tests/formattests.pas
+++ b/components/fpspreadsheet/tests/formattests.pas
@@ -107,6 +107,8 @@ type
procedure TestWriteRead_ODS_Alignment;
procedure TestWriteRead_ODS_Border;
procedure TestWriteRead_ODS_BorderStyles;
+ procedure TestWriteRead_ODS_ColWidths;
+ procedure TestWriteRead_ODS_RowHeights;
procedure TestWriteRead_ODS_TextRotation;
procedure TestWriteRead_ODS_WordWrap;
end;
@@ -203,13 +205,13 @@ begin
end;
// Column width
- SollColWidths[0] := 20; // characters based on width of "0"
+ SollColWidths[0] := 20; // characters based on width of "0" of default font
SollColWidths[1] := 40;
// Row heights
- SollRowHeights[0] := 5;
- SollRowHeights[1] := 10;
- SollRowHeights[2] := 50;
+ SollRowHeights[0] := 1; // Lines of default font
+ SollRowHeights[1] := 2;
+ SollRowHeights[2] := 4;
// Cell borders
SollBorders[0] := [];
@@ -723,6 +725,7 @@ begin
MyWorkSheet:= MyWorkBook.AddWorksheet(ColWidthSheet);
for Col := Low(SollColWidths) to High(SollColWidths) do begin
lCol.Width := SollColWidths[Col];
+ //MyWorksheet.WriteNumber(0, Col, 1);
MyWorksheet.WriteColInfo(Col, lCol);
end;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
@@ -742,8 +745,9 @@ begin
if lpCol = nil then
fail('Error in test code. Failed to return saved column width');
ActualColWidth := lpCol^.Width;
- CheckEquals(SollColWidths[Col], ActualColWidth,
- 'Test saved colwidth mismatch, column '+ColNotation(MyWorkSheet,Col));
+ if abs(SollColWidths[Col] - ActualColWidth) > 1E-2 then // take rounding errors into account
+ CheckEquals(SollColWidths[Col], ActualColWidth,
+ 'Test saved colwidth mismatch, column '+ColNotation(MyWorkSheet,Col));
end;
// Finalization
MyWorkbook.Free;
@@ -766,6 +770,10 @@ begin
TestWriteReadColWidths(sfExcel8);
end;
+procedure TSpreadWriteReadFormatTests.TestWriteRead_ODS_ColWidths;
+begin
+ TestWriteReadColWidths(sfOpenDocument);
+end;
{ --- Row height tests --- }
@@ -801,14 +809,11 @@ begin
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for Row := Low(SollRowHeights) to High(SollRowHeights) do begin
- lpRow := MyWorksheet.GetRow(Row);
- if lpRow = nil then
- fail('Error in test code. Failed to return saved row height');
- // Rounding to twips in Excel would cause severe rounding error if we'd compare millimeters
- // --> go back to twips
- ActualRowHeight := MillimetersToTwips(lpRow^.Height);
- CheckEquals(MillimetersToTwips(SollRowHeights[Row]), ActualRowHeight,
- 'Test saved row height mismatch, row '+RowNotation(MyWorkSheet,Row));
+ ActualRowHeight := MyWorksheet.GetRowHeight(Row);
+ // Take care of rounding errors
+ if abs(ActualRowHeight - SollRowHeights[Row]) > 1e-2 then
+ CheckEquals(SollRowHeights[Row], ActualRowHeight,
+ 'Test saved row height mismatch, row '+RowNotation(MyWorkSheet,Row));
end;
// Finalization
MyWorkbook.Free;
@@ -831,6 +836,11 @@ begin
TestWriteReadRowHeights(sfExcel8);
end;
+procedure TSpreadWriteReadFormatTests.TestWriteRead_ODS_RowHeights;
+begin
+ TestWriteReadRowHeights(sfOpenDocument);
+end;
+
{ --- Text rotation tests --- }
diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas
index 503944a22..b7a806eef 100755
--- a/components/fpspreadsheet/xlsbiff2.pas
+++ b/components/fpspreadsheet/xlsbiff2.pas
@@ -708,7 +708,12 @@ begin
if h and $8000 = 0 then begin // if this bit were set, rowheight would be default
lRow := FWorksheet.GetRow(WordLEToN(rowrec.RowIndex));
// Row height is encoded into the 15 remaining bits in units "twips" (1/20 pt)
- lRow^.Height := TwipsToMillimeters(h and $7FFF);
+ // We need it in "lines" units.
+ lRow^.Height := TwipsToPts(h and $7FFF) / Workbook.GetFont(0).Size;
+ if lRow^.Height > ROW_HEIGHT_CORRECTION then
+ lRow^.Height := lRow^.Height - ROW_HEIGHT_CORRECTION
+ else
+ lRow^.Height := 0;
end;
end;
@@ -1632,6 +1637,7 @@ var
containsXF: Boolean;
rowheight: Word;
w: Word;
+ h: Single;
begin
containsXF := false;
@@ -1649,10 +1655,14 @@ begin
AStream.WriteWord(WordToLE(Word(ALastColIndex) + 1));
{ Row height (in twips, 1/20 point) and info on custom row height }
- if (ARow = nil) or (ARow^.Height = 0) then
- rowheight := round(Workbook.GetFont(0).Size*20)
+ h := Workbook.GetFont(0).Size;
+ if (ARow = nil) or (ARow^.Height = Workbook.DefaultRowHeight) then
+ rowheight := PtsToTwips((Workbook.DefaultRowHeight + ROW_HEIGHT_CORRECTION) * h)
else
- rowheight := MillimetersToTwips(ARow^.Height);
+ if (ARow^.Height = 0) then
+ rowheight := 0
+ else
+ rowheight := PtsToTwips((ARow^.Height + ROW_HEIGHT_CORRECTION) * h);
w := rowheight and $7FFF;
AStream.WriteWord(WordToLE(w));
diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas
index 887ba96c4..f77ea1a29 100644
--- a/components/fpspreadsheet/xlscommon.pas
+++ b/components/fpspreadsheet/xlscommon.pas
@@ -1329,12 +1329,13 @@ begin
if h and $8000 = 0 then begin // if this bit were set, rowheight would be default
lRow := FWorksheet.GetRow(WordLEToN(rowrec.RowIndex));
// Row height is encoded into the 15 remaining bits in units "twips" (1/20 pt)
- lRow^.Height := TwipsToMillimeters(h and $7FFF);
- end else
- lRow^.Height := 0;
- //lRow^.AutoHeight := rowrec.Flags and $00000040 = 0;
- // If this bit is set row height does not change with font height, i.e. has been
- // changed manually.
+ // We need it in "lines", i.e. we divide the points by the point size of the default font
+ lRow^.Height := TwipsToPts(h and $7FFF) / FWorkbook.GetFont(0).Size;
+ if lRow^.Height > ROW_HEIGHT_CORRECTION then
+ lRow^.Height := lRow^.Height - ROW_HEIGHT_CORRECTION
+ else
+ lRow^.Height := 0;
+ end;
end;
{ Reads the cell address used in an RPN formula element. Evaluates the corresponding
@@ -1903,6 +1904,7 @@ var
spaceabove, spacebelow: Boolean;
colindex: Cardinal;
rowheight: Word;
+ h: Single;
begin
// Check for additional space above/below row
spaceabove := false;
@@ -1934,10 +1936,14 @@ begin
AStream.WriteWord(WordToLE(Word(ALastColIndex) + 1));
{ Row height (in twips, 1/20 point) and info on custom row height }
- if (ARow = nil) or (ARow^.Height = 0) then
- rowheight := round(Workbook.GetFont(0).Size*20)
+ h := Workbook.GetFont(0).Size; // Point size of default font
+ if (ARow = nil) or (ARow^.Height = Workbook.DefaultRowHeight) then
+ rowheight := PtsToTwips((Workbook.DefaultRowHeight + ROW_HEIGHT_CORRECTION) * h)
else
- rowheight := MillimetersToTwips(ARow^.Height);
+ if (ARow^.Height = 0) then
+ rowheight := 0
+ else
+ rowheight := PtsToTwips((ARow^.Height + ROW_HEIGHT_CORRECTION)*h);
w := rowheight and $7FFF;
AStream.WriteWord(WordToLE(w));