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

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

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

63
components/fpspreadsheet/fpsopendocument.pas
View File

@ -884,9 +884,60 @@ begin
end;
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
// For now just read the number
ReadNumber(ARow, ACol, ACellNode);
fs := DefaultFormatSettings;
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;
procedure TsSpreadOpenDocReader.ReadLabel(ARow: Word; ACol: Word; ACellNode: TDOMNode);
@ -1336,9 +1387,11 @@ begin
else if (paramValueType = 'date') or (paramValueType = 'time') then
ReadDateTime(row, col, cellNode)
else if (paramValueType = '') and (tableStyleName <> '') then
ReadBlank(row, col, cellNode)
else if ParamFormula <> '' then
ReadLabel(row, col, cellNode);
ReadBlank(row, col, cellNode);
if ParamFormula <> '' then
ReadFormula(row, col, cellNode);
// ReadLabel(row, col, cellNode);
paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated');
if paramColsRepeated = '' then paramColsRepeated := '1';

24
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -416,6 +416,7 @@ type
function ReadAsUTF8Text(ACell: PCell): ansistring; overload;
function ReadAsNumber(ARow, ACol: Cardinal): Double;
function ReadAsDateTime(ARow, ACol: Cardinal; out AResult: TDateTime): Boolean;
function ReadFormulaAsString(ACell: PCell): String;
function ReadRPNFormulaAsString(ACell: PCell): String;
function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;
@ -440,7 +441,8 @@ type
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double;
AFormatString: String); overload;
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 }
procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor);
@ -1628,6 +1630,17 @@ begin
Result := True;
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;
var
fs: TFormatSettings;
@ -1803,9 +1816,16 @@ var
ACell: PCell;
begin
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^.UTF8StringValue := AText;
ChangedCell(ARow, ACol);
ChangedCell(ACell^.Row, ACell^.Col);
end;
{@@

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

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