pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Read ods formula and display it in TsWorksheetGrid.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3152 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-06 15:48:02 +00:00
parent 712e0f9f27
commit 12c4a4a2a2
5 changed files with 108 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
components/fpspreadsheet/examples/fpsgrid/mainform.lfm
View File

@ -4,7 +4,7 @@ object Form1: TForm1
Top = 248 Top = 248
Width = 884 Width = 884
Caption = 'fpsGrid' Caption = 'fpsGrid'
ClientHeight = 629 ClientHeight = 624
ClientWidth = 884 ClientWidth = 884
Menu = MainMenu Menu = MainMenu
OnActivate = FormActivate OnActivate = FormActivate
@ -14,7 +14,7 @@ object Form1: TForm1
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 85 Height = 85
Top = 544 Top = 539
Width = 884 Width = 884
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -23,9 +23,9 @@ object Form1: TForm1
TabOrder = 0 TabOrder = 0
object CbShowHeaders: TCheckBox object CbShowHeaders: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 8 Top = 8
Width = 93 Width = 116
Caption = 'Show headers' Caption = 'Show headers'
Checked = True Checked = True
OnClick = CbShowHeadersClick OnClick = CbShowHeadersClick
@ -34,9 +34,9 @@ object Form1: TForm1
end end
object CbShowGridLines: TCheckBox object CbShowGridLines: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 32 Top = 32
Width = 100 Width = 125
Caption = 'Show grid lines' Caption = 'Show grid lines'
Checked = True Checked = True
OnClick = CbShowGridLinesClick OnClick = CbShowGridLinesClick
@ -45,7 +45,7 @@ object Form1: TForm1
end end
object EdFrozenCols: TSpinEdit object EdFrozenCols: TSpinEdit
Left = 389 Left = 389
Height = 23 Height = 28
Top = 8 Top = 8
Width = 52 Width = 52
OnChange = EdFrozenColsChange OnChange = EdFrozenColsChange
@ -53,7 +53,7 @@ object Form1: TForm1
end end
object EdFrozenRows: TSpinEdit object EdFrozenRows: TSpinEdit
Left = 389 Left = 389
Height = 23 Height = 28
Top = 39 Top = 39
Width = 52 Width = 52
OnChange = EdFrozenRowsChange OnChange = EdFrozenRowsChange
@ -61,37 +61,37 @@ object Form1: TForm1
end end
object Label1: TLabel object Label1: TLabel
Left = 304 Left = 304
Height = 15 Height = 20
Top = 13 Top = 13
Width = 62 Width = 77
Caption = 'Frozen cols:' Caption = 'Frozen cols:'
FocusControl = EdFrozenCols FocusControl = EdFrozenCols
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel
Left = 304 Left = 304
Height = 15 Height = 20
Top = 40 Top = 40
Width = 66 Width = 82
Caption = 'Frozen rows:' Caption = 'Frozen rows:'
FocusControl = EdFrozenRows FocusControl = EdFrozenRows
ParentColor = False ParentColor = False
end end
object CbReadFormulas: TCheckBox object CbReadFormulas: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 56 Top = 56
Width = 96 Width = 120
Caption = 'Read formulas' Caption = 'Read formulas'
OnChange = CbReadFormulasChange OnChange = CbReadFormulasChange
TabOrder = 4 TabOrder = 4
end end
object CbHeaderStyle: TComboBox object CbHeaderStyle: TComboBox
Left = 152 Left = 152
Height = 23 Height = 28
Top = 8 Top = 8
Width = 116 Width = 116
ItemHeight = 15 ItemHeight = 20
ItemIndex = 2 ItemIndex = 2
Items.Strings = ( Items.Strings = (
'Lazarus' 'Lazarus'
@ -106,7 +106,7 @@ object Form1: TForm1
end end
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 0 Left = 0
Height = 465 Height = 460
Top = 79 Top = 79
Width = 884 Width = 884
ActivePage = TabSheet1 ActivePage = TabSheet1
@ -116,11 +116,11 @@ object Form1: TForm1
OnChange = PageControl1Change OnChange = PageControl1Change
object TabSheet1: TTabSheet object TabSheet1: TTabSheet
Caption = 'Sheet1' Caption = 'Sheet1'
ClientHeight = 437 ClientHeight = 427
ClientWidth = 876 ClientWidth = 876
object WorksheetGrid: TsWorksheetGrid object WorksheetGrid: TsWorksheetGrid
Left = 0 Left = 0
Height = 437 Height = 427
Top = 0 Top = 0
Width = 876 Width = 876
FrozenCols = 0 FrozenCols = 0
@ -136,7 +136,7 @@ object Form1: TForm1
TitleStyle = tsNative TitleStyle = tsNative
OnSelection = WorksheetGridSelection OnSelection = WorksheetGridSelection
ColWidths = ( ColWidths = (
42 56
64 64
64 64
64 64
@ -244,19 +244,19 @@ object Form1: TForm1
end end
object FontComboBox: TComboBox object FontComboBox: TComboBox
Left = 52 Left = 52
Height = 23 Height = 28
Top = 2 Top = 2
Width = 127 Width = 127
ItemHeight = 15 ItemHeight = 20
OnSelect = FontComboBoxSelect OnSelect = FontComboBoxSelect
TabOrder = 0 TabOrder = 0
end end
object FontSizeComboBox: TComboBox object FontSizeComboBox: TComboBox
Left = 179 Left = 179
Height = 23 Height = 28
Top = 2 Top = 2
Width = 48 Width = 48
ItemHeight = 15 ItemHeight = 20
Items.Strings = ( Items.Strings = (
'8' '8'
'9' '9'

6
components/fpspreadsheet/examples/fpsgrid/mainform.pas
View File

@ -753,6 +753,7 @@ procedure TForm1.WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer);
var var
r, c: Cardinal; r, c: Cardinal;
cell: PCell; cell: PCell;
s: String;
begin begin
if WorksheetGrid.Workbook = nil then if WorksheetGrid.Workbook = nil then
exit; exit;
@ -767,8 +768,9 @@ begin
cell := WorksheetGrid.Worksheet.FindCell(r, c); cell := WorksheetGrid.Worksheet.FindCell(r, c);
if cell <> nil then begin if cell <> nil then begin
if Length(cell^.RPNFormulaValue) > 0 then s := WorksheetGrid.Worksheet.ReadFormulaAsString(cell);
EdFormula.Text := WorksheetGrid.Worksheet.ReadRPNFormulaAsString(cell) if s <> '' then
EdFormula.Text := s
else else
EdFormula.Text := WorksheetGrid.Worksheet.ReadAsUTF8Text(cell); EdFormula.Text := WorksheetGrid.Worksheet.ReadAsUTF8Text(cell);
end else end else

63
components/fpspreadsheet/fpsopendocument.pas
View File

@ -884,9 +884,60 @@ begin
end; end;
procedure TsSpreadOpenDocReader.ReadFormula(ARow: Word; ACol : Word; ACellNode : TDOMNode); procedure TsSpreadOpenDocReader.ReadFormula(ARow: Word; ACol : Word; ACellNode : TDOMNode);
var
cell: PCell;
formula: String;
stylename: String;
txtValue: String;
floatValue: Double;
fs: TFormatSettings;
valueType: String;
valueStr: String;
begin begin
// For now just read the number fs := DefaultFormatSettings;
ReadNumber(ARow, ACol, ACellNode); fs.DecimalSeparator := '.';
// Create cell and apply format
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(ARow, ACol, stylename);
cell := FWorksheet.FindCell(ARow, ACol);
// Read formula, store in the cell's FormulaValue.FormulaStr
formula := GetAttrValue(ACellNode, 'table:formula');
if formula <> '' then Delete(formula, 1, 3); // delete "of:"
cell^.FormulaValue.FormulaStr := formula;
// Read formula results
// ... number value
valueType := GetAttrValue(ACellNode, 'office:value-type');
valueStr := GetAttrValue(ACellNode, 'office:value');
if (valueType = 'float') then begin
if UpperCase(valueStr) = '1.#INF' then
FWorksheet.WriteNumber(cell, 1.0/0.0)
else begin
floatValue := StrToFloat(valueStr, fs);
FWorksheet.WriteNumber(cell, floatValue);
end;
if IsDateTimeFormat(cell^.NumberFormat) then begin
cell^.ContentType := cctDateTime;
// No datemode correction for intervals and for time-only values
if (cell^.NumberFormat = nfTimeInterval) or (cell^.NumberValue < 1) then
cell^.DateTimeValue := cell^.NumberValue
else
case FDateMode of
dm1899: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1899_BASE;
dm1900: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1900_BASE;
dm1904: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1904_BASE;
end;
end;
end else
// Date/time value
if (valueType = 'date') or (valueType = 'time') then begin
floatValue := ExtractDateTimeFromNode(ACellNode, cell^.NumberFormat, cell^.NumberFormatStr);
FWorkSheet.WriteDateTime(cell, floatValue);
end else
// Text
FWorksheet.WriteUTF8Text(cell, valueStr);
end; end;
procedure TsSpreadOpenDocReader.ReadLabel(ARow: Word; ACol: Word; ACellNode: TDOMNode); procedure TsSpreadOpenDocReader.ReadLabel(ARow: Word; ACol: Word; ACellNode: TDOMNode);
@ -1336,9 +1387,11 @@ begin
else if (paramValueType = 'date') or (paramValueType = 'time') then else if (paramValueType = 'date') or (paramValueType = 'time') then
ReadDateTime(row, col, cellNode) ReadDateTime(row, col, cellNode)
else if (paramValueType = '') and (tableStyleName <> '') then else if (paramValueType = '') and (tableStyleName <> '') then
ReadBlank(row, col, cellNode) ReadBlank(row, col, cellNode);
else if ParamFormula <> '' then
ReadLabel(row, col, cellNode); if ParamFormula <> '' then
ReadFormula(row, col, cellNode);
// ReadLabel(row, col, cellNode);
paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated'); paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated');
if paramColsRepeated = '' then paramColsRepeated := '1'; if paramColsRepeated = '' then paramColsRepeated := '1';

24
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -416,6 +416,7 @@ type
function ReadAsUTF8Text(ACell: PCell): ansistring; overload; function ReadAsUTF8Text(ACell: PCell): ansistring; overload;
function ReadAsNumber(ARow, ACol: Cardinal): Double; function ReadAsNumber(ARow, ACol: Cardinal): Double;
function ReadAsDateTime(ARow, ACol: Cardinal; out AResult: TDateTime): Boolean; function ReadAsDateTime(ARow, ACol: Cardinal; out AResult: TDateTime): Boolean;
function ReadFormulaAsString(ACell: PCell): String;
function ReadRPNFormulaAsString(ACell: PCell): String; function ReadRPNFormulaAsString(ACell: PCell): String;
function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;
@ -440,7 +441,8 @@ type
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double; procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double;
AFormatString: String); overload; AFormatString: String); overload;
procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula); procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula);
procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring); procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring); overload;
procedure WriteUTF8Text(ACell: PCell; AText: ansistring); overload;
{ Writing of cell attributes } { Writing of cell attributes }
procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor); procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor);
@ -1628,6 +1630,17 @@ begin
Result := True; Result := True;
end; end;
function TsWorksheet.ReadFormulaAsString(ACell: PCell): String;
begin
Result := '';
if ACell = nil then
exit;
if Length(ACell^.RPNFormulaValue) > 0 then
Result := ReadRPNFormulaAsString(ACell)
else
Result := ACell^.FormulaValue.FormulaStr;
end;
function TsWorksheet.ReadRPNFormulaAsString(ACell: PCell): String; function TsWorksheet.ReadRPNFormulaAsString(ACell: PCell): String;
var var
fs: TFormatSettings; fs: TFormatSettings;
@ -1803,9 +1816,16 @@ var
ACell: PCell; ACell: PCell;
begin begin
ACell := GetCell(ARow, ACol); ACell := GetCell(ARow, ACol);
WriteUTF8Text(ACell, AText);
end;
procedure TsWorksheet.WriteUTF8Text(ACell: PCell; AText: ansistring);
begin
if ACell = nil then
exit;
ACell^.ContentType := cctUTF8String; ACell^.ContentType := cctUTF8String;
ACell^.UTF8StringValue := AText; ACell^.UTF8StringValue := AText;
ChangedCell(ARow, ACol); ChangedCell(ACell^.Row, ACell^.Col);
end; end;
{@@ {@@

1
components/fpspreadsheet/tests/fonttests.pas
View File

@ -340,7 +340,6 @@ begin
TestWriteReadFont(sfExcel8, 'Courier New'); TestWriteReadFont(sfExcel8, 'Courier New');
end; end;
{ ODS } { ODS }
procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Font_Arial; procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Font_Arial;
begin begin