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

fpspreadsheet: Construct Excel-like formula string out of an RPN formula and display it in fpsgrid demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3085 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-05-23 23:13:49 +00:00
parent aad3342021
commit 4271ace593
10 changed files with 902 additions and 690 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpspreadsheet/examples/excel8demo/excel8read.lpr
View File

@ -45,11 +45,15 @@ begin
CurCell := MyWorkSheet.GetFirstCell();
for i := 0 to MyWorksheet.GetCellCount - 1 do
begin
WriteLn('Row: ', CurCell^.Row,
Write('Row: ', CurCell^.Row,
' Col: ', CurCell^.Col, ' Value: ',
UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row,
CurCell^.Col))
);
if Length(CurCell^.RPNFormulaValue) > 0 then
WriteLn(' Formula: ', MyWorkSheet.ReadRPNFormulaAsString(CurCell))
else
WriteLn;
CurCell := MyWorkSheet.GetNextCell();
end;

134
components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
View File

@ -128,8 +128,8 @@
<UnitName Value="mainform"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="818"/>
<CursorPos X="3" Y="825"/>
<TopLine Value="511"/>
<CursorPos X="27" Y="526"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
@ -137,21 +137,24 @@
<Unit2>
<Filename Value="..\..\fpspreadsheet.pas"/>
<UnitName Value="fpspreadsheet"/>
<EditorIndex Value="6"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="145"/>
<CursorPos X="38" Y="163"/>
<TopLine Value="523"/>
<CursorPos X="40" Y="533"/>
<UsageCount Value="100"/>
<Bookmarks Count="1">
<Item0 X="68" Y="3716" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<UnitName Value="fpspreadsheetgrid"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="7"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/>
<TopLine Value="98"/>
<CursorPos X="1" Y="108"/>
<TopLine Value="539"/>
<CursorPos X="42" Y="557"/>
<UsageCount Value="100"/>
<Loaded Value="True"/>
</Unit3>
@ -229,11 +232,11 @@
<Unit13>
<Filename Value="..\..\fpsutils.pas"/>
<UnitName Value="fpsutils"/>
<EditorIndex Value="3"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="44"/>
<CursorPos X="14" Y="70"/>
<UsageCount Value="68"/>
<TopLine Value="62"/>
<CursorPos X="1" Y="63"/>
<UsageCount Value="69"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
@ -261,11 +264,11 @@
<Unit17>
<Filename Value="..\..\xlsbiff8.pas"/>
<UnitName Value="xlsbiff8"/>
<EditorIndex Value="4"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="1920"/>
<CursorPos X="21" Y="1924"/>
<UsageCount Value="98"/>
<UsageCount Value="99"/>
<Loaded Value="True"/>
</Unit17>
<Unit18>
@ -286,14 +289,11 @@
<Unit20>
<Filename Value="..\..\xlscommon.pas"/>
<UnitName Value="xlscommon"/>
<EditorIndex Value="5"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="650"/>
<CursorPos X="24" Y="662"/>
<UsageCount Value="94"/>
<Bookmarks Count="1">
<Item0 X="41" Y="1209" ID="1"/>
</Bookmarks>
<TopLine Value="1112"/>
<CursorPos X="1" Y="1142"/>
<UsageCount Value="95"/>
<Loaded Value="True"/>
</Unit20>
<Unit21>
@ -591,134 +591,132 @@
</Unit59>
<Unit60>
<Filename Value="C:\development\fpc\rtl\inc\astrings.inc"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="104"/>
<CursorPos X="1" Y="120"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit60>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="mainform.pas"/>
<Caret Line="800" Column="1" TopLine="781"/>
<Caret Line="654" Column="3" TopLine="647"/>
</Position1>
<Position2>
<Filename Value="mainform.pas"/>
<Caret Line="799" Column="75" TopLine="781"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="742" Column="12" TopLine="723"/>
</Position2>
<Position3>
<Filename Value="mainform.pas"/>
<Caret Line="796" Column="1" TopLine="781"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="115" Column="1" TopLine="115"/>
</Position3>
<Position4>
<Filename Value="mainform.pas"/>
<Caret Line="797" Column="1" TopLine="781"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="349" Column="12" TopLine="318"/>
</Position4>
<Position5>
<Filename Value="mainform.pas"/>
<Caret Line="798" Column="1" TopLine="781"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="358" Column="25" TopLine="327"/>
</Position5>
<Position6>
<Filename Value="mainform.pas"/>
<Caret Line="799" Column="1" TopLine="781"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="478" Column="34" TopLine="449"/>
</Position6>
<Position7>
<Filename Value="mainform.pas"/>
<Caret Line="802" Column="1" TopLine="781"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="2524" Column="3" TopLine="2520"/>
</Position7>
<Position8>
<Filename Value="mainform.pas"/>
<Caret Line="803" Column="1" TopLine="788"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="2504" Column="46" TopLine="2498"/>
</Position8>
<Position9>
<Filename Value="mainform.pas"/>
<Caret Line="816" Column="29" TopLine="788"/>
<Caret Line="654" Column="3" TopLine="647"/>
</Position9>
<Position10>
<Filename Value="mainform.pas"/>
<Caret Line="798" Column="1" TopLine="788"/>
<Caret Line="661" Column="3" TopLine="654"/>
</Position10>
<Position11>
<Filename Value="mainform.pas"/>
<Caret Line="799" Column="1" TopLine="788"/>
<Caret Line="542" Column="56" TopLine="540"/>
</Position11>
<Position12>
<Filename Value="mainform.pas"/>
<Caret Line="802" Column="1" TopLine="788"/>
<Caret Line="728" Column="1" TopLine="704"/>
</Position12>
<Position13>
<Filename Value="mainform.pas"/>
<Caret Line="803" Column="1" TopLine="788"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1316" Column="1" TopLine="1285"/>
</Position13>
<Position14>
<Filename Value="mainform.pas"/>
<Caret Line="804" Column="1" TopLine="788"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="394" Column="34" TopLine="394"/>
</Position14>
<Position15>
<Filename Value="mainform.pas"/>
<Caret Line="806" Column="19" TopLine="781"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position15>
<Position16>
<Filename Value="mainform.pas"/>
<Caret Line="799" Column="1" TopLine="781"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="501" Column="18" TopLine="470"/>
</Position16>
<Position17>
<Filename Value="mainform.pas"/>
<Caret Line="808" Column="1" TopLine="782"/>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1430" Column="28" TopLine="1430"/>
</Position17>
<Position18>
<Filename Value="mainform.pas"/>
<Caret Line="799" Column="1" TopLine="782"/>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position18>
<Position19>
<Filename Value="mainform.pas"/>
<Caret Line="800" Column="1" TopLine="782"/>
<Caret Line="704" Column="21" TopLine="704"/>
</Position19>
<Position20>
<Filename Value="mainform.pas"/>
<Caret Line="803" Column="1" TopLine="782"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position20>
<Position21>
<Filename Value="mainform.pas"/>
<Caret Line="804" Column="1" TopLine="782"/>
<Caret Line="83" Column="19" TopLine="53"/>
</Position21>
<Position22>
<Filename Value="mainform.pas"/>
<Caret Line="805" Column="1" TopLine="782"/>
<Caret Line="229" Column="29" TopLine="199"/>
</Position22>
<Position23>
<Filename Value="mainform.pas"/>
<Caret Line="806" Column="1" TopLine="782"/>
<Caret Line="540" Column="32" TopLine="509"/>
</Position23>
<Position24>
<Filename Value="mainform.pas"/>
<Caret Line="807" Column="1" TopLine="782"/>
<Caret Line="511" Column="29" TopLine="511"/>
</Position24>
<Position25>
<Filename Value="mainform.pas"/>
<Caret Line="808" Column="1" TopLine="782"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position25>
<Position26>
<Filename Value="mainform.pas"/>
<Caret Line="806" Column="50" TopLine="784"/>
<Caret Line="83" Column="19" TopLine="53"/>
</Position26>
<Position27>
<Filename Value="mainform.pas"/>
<Caret Line="787" Column="104" TopLine="784"/>
<Caret Line="229" Column="29" TopLine="199"/>
</Position27>
<Position28>
<Filename Value="mainform.pas"/>
<Caret Line="243" Column="29" TopLine="227"/>
<Caret Line="540" Column="32" TopLine="509"/>
</Position28>
<Position29>
<Filename Value="mainform.pas"/>
<Caret Line="714" Column="35" TopLine="696"/>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1141" Column="28" TopLine="1111"/>
</Position29>
<Position30>
<Filename Value="mainform.pas"/>
<Caret Line="825" Column="3" TopLine="818"/>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1142" Column="1" TopLine="1112"/>
</Position30>
</JumpHistory>
</ProjectOptions>

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

@ -4,7 +4,7 @@ object Form1: TForm1
Top = 193
Width = 884
Caption = 'fpsGrid'
ClientHeight = 624
ClientHeight = 629
ClientWidth = 884
Menu = MainMenu
OnActivate = FormActivate
@ -13,19 +13,19 @@ object Form1: TForm1
LCLVersion = '1.3'
object Panel1: TPanel
Left = 0
Height = 76
Top = 548
Height = 85
Top = 544
Width = 884
Align = alBottom
BevelOuter = bvNone
ClientHeight = 76
ClientHeight = 85
ClientWidth = 884
TabOrder = 0
object CbShowHeaders: TCheckBox
Left = 8
Height = 24
Top = 11
Width = 116
Height = 19
Top = 8
Width = 93
Caption = 'Show headers'
Checked = True
OnClick = CbShowHeadersClick
@ -34,9 +34,9 @@ object Form1: TForm1
end
object CbShowGridLines: TCheckBox
Left = 8
Height = 24
Top = 36
Width = 125
Height = 19
Top = 32
Width = 100
Caption = 'Show grid lines'
Checked = True
OnClick = CbShowGridLinesClick
@ -45,7 +45,7 @@ object Form1: TForm1
end
object EdFrozenCols: TSpinEdit
Left = 238
Height = 28
Height = 23
Top = 8
Width = 52
OnChange = EdFrozenColsChange
@ -53,7 +53,7 @@ object Form1: TForm1
end
object EdFrozenRows: TSpinEdit
Left = 238
Height = 28
Height = 23
Top = 39
Width = 52
OnChange = EdFrozenRowsChange
@ -61,27 +61,36 @@ object Form1: TForm1
end
object Label1: TLabel
Left = 152
Height = 20
Height = 15
Top = 13
Width = 77
Width = 62
Caption = 'Frozen cols:'
FocusControl = EdFrozenCols
ParentColor = False
end
object Label2: TLabel
Left = 153
Height = 20
Height = 15
Top = 40
Width = 82
Width = 66
Caption = 'Frozen rows:'
FocusControl = EdFrozenRows
ParentColor = False
end
object CbReadFormulas: TCheckBox
Left = 8
Height = 19
Top = 56
Width = 96
Caption = 'Read formulas'
OnChange = CbReadFormulasChange
TabOrder = 4
end
end
object PageControl1: TPageControl
Left = 0
Height = 495
Top = 53
Height = 465
Top = 79
Width = 884
ActivePage = TabSheet1
Align = alClient
@ -90,11 +99,11 @@ object Form1: TForm1
OnChange = PageControl1Change
object TabSheet1: TTabSheet
Caption = 'Sheet1'
ClientHeight = 462
ClientHeight = 437
ClientWidth = 876
object WorksheetGrid: TsWorksheetGrid
Left = 0
Height = 462
Height = 437
Top = 0
Width = 876
FrozenCols = 0
@ -109,7 +118,7 @@ object Form1: TForm1
TitleStyle = tsNative
OnSelection = WorksheetGridSelection
ColWidths = (
56
42
64
)
end
@ -187,19 +196,19 @@ object Form1: TForm1
end
object FontComboBox: TComboBox
Left = 52
Height = 28
Height = 23
Top = 2
Width = 127
ItemHeight = 20
ItemHeight = 15
OnSelect = FontComboBoxSelect
TabOrder = 0
end
object FontSizeComboBox: TComboBox
Left = 179
Height = 28
Height = 23
Top = 2
Width = 48
ItemHeight = 20
ItemHeight = 15
Items.Strings = (
'8'
'9'
@ -332,6 +341,22 @@ object Form1: TForm1
Action = AcCopyFormat
end
end
object FormulaToolBar: TToolBar
Left = 0
Height = 26
Top = 53
Width = 884
Caption = 'FormulaToolBar'
TabOrder = 4
object EdFormula: TEdit
Left = 1
Height = 24
Top = 2
Width = 883
Align = alClient
TabOrder = 0
end
end
object OpenDialog: TOpenDialog
DefaultExt = '.xls'
Filter = 'Excel spreadsheet (*.xls)|*.xls|Excel XML spreadsheet (*.xlsx)|*.xlxs|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Wikitable (pipes) (.wikitable_pipes)|.wikitable_pipes|All files (*.*)|*.*'

1074
components/fpspreadsheet/examples/fpsgrid/mainform.lrs
View File

File diff suppressed because it is too large Load Diff

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

@ -80,6 +80,8 @@ type
CbShowHeaders: TCheckBox;
CbShowGridLines: TCheckBox;
CbBackgroundColor: TColorBox;
CbReadFormulas: TCheckBox;
EdFormula: TEdit;
FontComboBox: TComboBox;
EdFrozenRows: TSpinEdit;
FontDialog: TFontDialog;
@ -178,6 +180,7 @@ type
NumFormatPopupMenu: TPopupMenu;
SaveDialog: TSaveDialog;
EdFrozenCols: TSpinEdit;
FormulaToolBar: TToolBar;
WorksheetGrid: TsWorksheetGrid;
TabSheet1: TTabSheet;
ToolBar1: TToolBar;
@ -223,6 +226,7 @@ type
procedure AcVertAlignmentExecute(Sender: TObject);
procedure AcWordwrapExecute(Sender: TObject);
procedure CbBackgroundColorSelect(Sender: TObject);
procedure CbReadFormulasChange(Sender: TObject);
procedure CbShowHeadersClick(Sender: TObject);
procedure CbShowGridLinesClick(Sender: TObject);
procedure CbBackgroundColorGetColors(Sender: TCustomColorBox; Items: TStrings);
@ -533,6 +537,11 @@ begin
with WorksheetGrid do BackgroundColors[Selection] := CbBackgroundColor.ItemIndex;
end;
procedure TForm1.CbReadFormulasChange(Sender: TObject);
begin
WorksheetGrid.ReadFormulas := CbReadFormulas.Checked;
end;
procedure TForm1.CbShowHeadersClick(Sender: TObject);
begin
WorksheetGrid.ShowHeaders := CbShowHeaders.Checked;
@ -697,17 +706,27 @@ end;
procedure TForm1.WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer);
var
r, c: Cardinal;
cell: PCell;
begin
if WorksheetGrid.Workbook = nil then
exit;
r := WorksheetGrid.GetWorksheetRow(ARow);
c := WorksheetGrid.GetWorksheetCol(ACol);
if AcCopyFormat.Checked then begin
r := WorksheetGrid.GetWorksheetRow(ARow);
c := WorksheetGrid.GetWorksheetCol(ACol);
WorksheetGrid.Worksheet.CopyFormat(@FCopiedFormat, r, c);
AcCopyFormat.Checked := false;
end;
cell := WorksheetGrid.Worksheet.FindCell(r, c);
if cell <> nil then begin
if Length(cell^.RPNFormulaValue) > 0 then
EdFormula.Text := WorksheetGrid.Worksheet.ReadRPNFormulaAsString(cell)
else
EdFormula.Text := WorksheetGrid.Worksheet.ReadAsUTF8Text(cell);
end;
UpdateHorAlignmentActions;
UpdateVertAlignmentActions;
UpdateWordwraps;
@ -718,6 +737,7 @@ begin
UpdateFontStyleActions;
UpdateTextRotationActions;
UpdateNumFormatActions;
end;
procedure TForm1.UpdateBackgroundColorIndex;

183
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -69,7 +69,7 @@ type
TFEKind = (
{ Basic operands }
fekCell, fekCellRef, fekCellRange, fekNum, fekInteger, fekString, fekBool,
fekErr, fekMissingArg,
fekErr, fekMissingArg, fekParen,
{ Basic operations }
fekAdd, fekSub, fekDiv, fekMul, fekPercent, fekPower, fekUMinus, fekUPlus,
fekConcat, // string concatenation
@ -393,11 +393,14 @@ type
function GetLastCellOfRow(ARow: Cardinal): PCell;
function GetLastColNumber: Cardinal;
function GetLastRowNumber: Cardinal;
function ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring;
function ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring; overload;
function ReadAsUTF8Text(ACell: PCell): ansistring; overload;
function ReadAsNumber(ARow, ACol: Cardinal): Double;
function ReadAsDateTime(ARow, ACol: Cardinal; out AResult: TDateTime): Boolean;
function ReadRPNFormulaAsString(ACell: PCell): String;
function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;
procedure RemoveAllCells;
{ Writing of values }
@ -738,6 +741,7 @@ type
function RPNInteger(AValue: Word; ANext: PRPNItem): PRPNItem;
function RPNMissingArg(ANext: PRPNItem): PRPNItem;
function RPNNumber(AValue: Double; ANext: PRPNItem): PRPNItem;
function RPNParenthesis(ANext: PRPNItem): PRPNItem;
function RPNString(AValue: String; ANext: PRPNItem): PRPNItem;
function RPNFunc(AToken: TFEKind; ANext: PRPNItem): PRPNItem; overload;
function RPNFunc(AToken: TFEKind; ANumParams: Byte; ANext: PRPNItem): PRPNItem; overload;
@ -758,7 +762,7 @@ procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
implementation
uses
Math, StrUtils, fpsUtils, fpsNumFormatParser;
Math, StrUtils, TypInfo, fpsUtils, fpsNumFormatParser;
{ Translatable strings }
resourcestring
@ -1258,6 +1262,11 @@ end;
@return The text representation of the cell
}
function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring;
begin
Result := ReadAsUTF8Text(GetCell(ARow, ACol));
end;
function TsWorksheet.ReadAsUTF8Text(ACell: PCell): ansistring;
function FloatToStrNoNaN(const Value: Double;
ANumberFormat: TsNumberFormat; ANumberFormatStr: string; ADecimals: byte): ansistring;
@ -1301,16 +1310,10 @@ function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring;
end;
end;
var
ACell: PCell;
begin
ACell := FindCell(ARow, ACol);
Result := '';
if ACell = nil then
begin
Result := '';
Exit;
end;
with ACell^ do
case ContentType of
@ -1381,6 +1384,126 @@ begin
Result := True;
end;
function TsWorksheet.ReadRPNFormulaAsString(ACell: PCell): String;
var
formula: TsRPNFormula;
elem: TsFormulaElement;
i, j: Integer;
L: TStringList;
s: String;
ptr: Pointer;
fek: TFEKind;
procedure Store(s: String);
begin
L.Clear;
L.Add(s);
end;
begin
Result := '';
if ACell = nil then
exit;
L := TStringList.Create;
try
for i:=0 to Length(ACell^.RPNFormulaValue)-1 do begin
elem := ACell^.RPNFormulaValue[i];
ptr := Pointer(elem.ElementKind);
case elem.ElementKind of
fekNum:
L.AddObject(Format('%g', [elem.DoubleValue]), ptr);
fekInteger:
L.AddObject(IntToStr(elem.IntValue), ptr);
fekString:
L.AddObject('"' + elem.StringValue + '"', ptr);
fekBool:
L.AddObject(IfThen(elem.DoubleValue=0, 'TRUE', 'FALSE'), ptr);
fekCell,
fekCellRef:
L.AddObject(GetCellString(elem.Row, elem.Col, elem.RelFlags), ptr);
fekCellRange:
L.AddObject(GetCellRangeString(elem.Row, elem.Col, elem.Row2, elem.Col2, elem.RelFlags), ptr);
// Operations:
fekAdd : L.AddObject('+', ptr);
fekSub : L.AddObject('-', ptr);
fekMul : L.AddObject('*', ptr);
fekDiv : L.AddObject('/', ptr);
fekPower : L.AddObject('^', ptr);
fekConcat : L.AddObject('&', ptr);
fekParen : L.AddObject('', ptr);
fekEqual : L.AddObject('=', ptr);
fekNotEqual : L.AddObject('<>', ptr);
fekLess : L.AddObject('<', ptr);
fekLessEqual : L.AddObject('<=', ptr);
fekGreater : L.AddObject('>', ptr);
fekGreaterEqual: L.AddObject('>=', ptr);
fekPercent : L.AddObject('%', ptr);
fekUPlus : L.AddObject('+', ptr);
fekUMinus : L.AddObject('-', ptr);
fekCellInfo : L.AddObject('CELL', ptr); // That's the function name!
else
begin
s := GetEnumName(TypeInfo(TFEKind), integer(elem.ElementKind));
Delete(s, 1, 3);
L.AddObject(s, ptr);
end;
end;
end;
i := L.Count-1;
while (L.Count > 0) and (i >= 0) do begin
fek := TFEKind(PtrInt(L.Objects[i]));
case fek of
fekAdd, fekSub, fekMul, fekDiv, fekPower, fekConcat,
fekEqual, fekNotEqual, fekLess, fekLessEqual, fekGreater, fekGreaterEqual:
begin
L.Strings[i] := Format('%s%s%s', [L[i+2], L[i], L[i+1]]);
L.Objects[i] := pointer(fekString);
L.Delete(i+2);
L.Delete(i+1);
end;
fekUPlus, fekUMinus:
begin
L.Strings[i] := L[i]+L[i+1];
L.Objects[i] := Pointer(fekString);
L.Delete(i+1);
end;
fekPercent:
begin
L.Strings[i] := L[i+1]+L[i];
L.Objects[i] := Pointer(fekString);
L.Delete(i+1);
end;
fekParen:
begin
L.Strings[i] := Format('(%s)', [L[i+1]]);
L.Objects[i] := pointer(fekString);
L.Delete(i+1);
end;
else
if fek >= fekAdd then begin
elem := ACell^.RPNFormulaValue[i];
s := '';
for j:= i+elem.ParamsNum downto i+1 do begin
s := s + ',' + L[j];
L.Delete(j);
end;
Delete(s, 1, 1);
L.Strings[i] := Format('%s(%s)', [L[i], s]);
L.Objects[i] := pointer(fekString);
end;
end;
dec(i);
end;
Result := '=' + L[0];
finally
L.Free;
end;
end;
function TsWorksheet.ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
var
ACell: PCell;
@ -3609,6 +3732,17 @@ begin
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array which put the curren operator in parenthesis.
For display purposes only, does not affect calculation.
}
function RPNParenthesis(ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekParen;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for a string.
}
@ -3631,6 +3765,34 @@ begin
raise Exception.Create('No basic tokens allowed here.');
Result := NewRPNItem;
Result^.FE.ElementKind := AToken;
case AToken of
fekFALSE, fekNOW, fekPI, fekRAND, fekTODAY, fekTRUE:
Result^.FE.ParamsNum := 0;
fekABS, fekACOS, fekACOSH, fekASIN, fekASINH, fekATAN, fekATANH,
fekCHAR, fekCODE, fekCOLUMNS, fekCOUNTBLANK, fekCOS, fekCOSH,
fekDATEVALUE, fekDAY, fekDEGREES, fekEXP, fekHOUR, fekINFO, fekINT,
fekIsBLANK, fekIsERR, fekIsERROR, fekIsLOGICAL, fekIsNA, fekIsNONTEXT,
fekIsTEXT, fekIsNUMBER, fekIsRef, fekLN, fekLOG10, fekLOWER, fekMINUTE,
fekMONTH, fekNOT, fekOpSUM, fekPercent, fekPROPER, fekRADIANS, fekROWS,
fekSECOND, fekSIGN, fekSIN, fekSINH, fekSQRT, fekTAN, fekTANH,
fekTIMEVALUE, fekTRIM, fekUMinus, fekUPlus, fekUPPER, fekValue,
fekWEEKDAY, fekYEAR:
Result^.FE.ParamsNum := 1;
fekAdd, fekCHIDIST, fekCHIINV, fekConcat, fekCOUNTIF, fekDiv,
fekEqual, fekGreater, fekGreaterEqual, fekLess, fekLessEqual,
fekMul, fekNotEqual, fekPERMUT, fekPower, fekSub, fekROUND:
Result^.FE.ParamsNum := 2;
fekDATE, fekDATEDIF, fekMID, fekPOISSON, fekTIME:
Result^.FE.ParamsNum := 3;
fekBINOMDIST, fekREPLACE:
Result^.FE.ParamsNum := 4;
end;
Result^.Next := ANext;
end;
@ -3688,7 +3850,6 @@ begin
end;
end;
initialization
MakeLEPalette(@DEFAULT_PALETTE, Length(DEFAULT_PALETTE));

7
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -38,6 +38,7 @@ type
FLockCount: Integer;
FEditing: Boolean;
FCellFont: TFont;
FReadFormulas: Boolean;
function CalcAutoRowHeight(ARow: Integer): Integer;
function CalcColWidth(AWidth: Single): Integer;
function CalcRowHeight(AHeight: Single): Integer;
@ -132,6 +133,7 @@ type
property DisplayFixedColRow: Boolean read GetShowHeaders write SetShowHeaders default true;
property FrozenCols: Integer read FFrozenCols write SetFrozenCols;
property FrozenRows: Integer read FFrozenRows write SetFrozenRows;
property ReadFormulas: Boolean read FReadFormulas write FReadFormulas;
property ShowGridLines: Boolean read GetShowGridLines write SetShowGridLines default true;
property ShowHeaders: Boolean read GetShowHeaders write SetShowHeaders default true;
@ -220,6 +222,7 @@ type
property DisplayFixedColRow; deprecated 'Use ShowHeaders';
property FrozenCols;
property FrozenRows;
property ReadFormulas;
property ShowGridLines;
property ShowHeaders;
@ -551,7 +554,7 @@ end;
{ Converts a spreadsheet font to a font used for painting (TCanvas.Font). }
procedure TsCustomWorksheetGrid.Convert_sFont_to_Font(sFont: TsFont; AFont: TFont);
begin
if Assigned(AFont) then begin
if Assigned(AFont) and Assigned(sFont) then begin
AFont.Name := sFont.FontName;
AFont.Size := round(sFont.Size);
AFont.Style := [];
@ -2522,6 +2525,7 @@ begin
try
FreeAndNil(FWorkbook);
FWorkbook := TsWorkbook.Create;
FWorkbook.ReadFormulas := FReadFormulas;
FWorkbook.ReadFromFile(AFileName, AFormat);
LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex));
finally
@ -2536,6 +2540,7 @@ begin
try
FreeAndNil(FWorkbook);
FWorkbook := TsWorkbook.Create;
FWorkbook.ReadFormulas := FReadFormulas;
FWorkbook.ReadFromFile(AFilename);
LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex));
finally

25
components/fpspreadsheet/fpsutils.pas
View File

@ -59,6 +59,8 @@ function ParseCellColString(const AStr: string;
var AResult: Integer): Boolean;
function GetColString(AColIndex: Integer): String;
function GetCellString(ARow,ACol: Cardinal; AFlags: TsRelFlags): String;
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): String;
function UTF8TextToXMLText(AText: ansistring): ansistring;
@ -459,6 +461,29 @@ begin
Result := 'too big';
end;
const
RELCHAR: Array[boolean] of String = ('$', '');
function GetCellString(ARow, ACol: Cardinal; AFlags: TsRelFlags): String;
begin
Result := Format('%s%s%s%d', [
RELCHAR[rfRelCol in AFlags], GetColString(ACol),
RELCHAR[rfRelRow in AFlags], ARow+1
]);
end;
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): String;
begin
Result := Format('%s%s%s%d:%s%s%s%d', [
RELCHAR[rfRelCol in AFlags], GetColString(ACol1),
RELCHAR[rfRelRow in AFlags], ARow1 + 1,
RELCHAR[rfRelCol2 in AFlags], GetColString(ACol2),
RELCHAR[rfRelRow2 in AFlags], ARow2 + 1
]);
// Result := GetCellString(ARow1, ACol1, AFlags) + ':' + GetCellString(ARow2, ACol2, [rfRelRow2, rfRelCol2]);
end;
{In XML files some chars must be translated}
function UTF8TextToXMLText(AText: ansistring): ansistring;
var

12
components/fpspreadsheet/xlsbiff8.pas
View File

@ -1678,8 +1678,8 @@ begin
ACol := c and MASK_EXCEL_COL_BITS_BIFF8;
// Extract info on absolute/relative addresses.
AFlags := [];
if (c and MASK_EXCEL_RELATIVE_COL = 1) then Include(AFlags, rfRelCol);
if (c and MASK_EXCEL_RELATIVE_ROW = 1) then Include(AFlags, rfRelRow);
if (c and MASK_EXCEL_RELATIVE_COL <> 0) then Include(AFlags, rfRelCol);
if (c and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow);
end;
{ Reads a cell range address used in an RPN formula element.
@ -1703,10 +1703,10 @@ begin
ACol2 := c2 and MASK_EXCEL_COL_BITS_BIFF8;
// Extract info on absolute/relative addresses.
AFlags := [];
if (c1 and MASK_EXCEL_RELATIVE_COL = 1) then Include(AFlags, rfRelCol);
if (c1 and MASK_EXCEL_RELATIVE_ROW = 1) then Include(AFlags, rfRelRow);
if (c2 and MASK_EXCEL_RELATIVE_COL = 1) then Include(AFlags, rfRelCol2);
if (c2 and MASK_EXCEL_RELATIVE_ROW = 1) then Include(AFlags, rfRelRow2);
if (c1 and MASK_EXCEL_RELATIVE_COL <> 0) then Include(AFlags, rfRelCol);
if (c1 and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow);
if (c2 and MASK_EXCEL_RELATIVE_COL <> 0) then Include(AFlags, rfRelCol2);
if (c2 and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow2);
end;
procedure TsSpreadBIFF8Reader.ReadSST(const AStream: TStream);

52
components/fpspreadsheet/xlscommon.pas
View File

@ -79,6 +79,7 @@ const
INT_EXCEL_TOKEN_TUPLUS = $12; // Unary plus +
INT_EXCEL_TOKEN_TUMINUS = $13; // Unary minus +
INT_EXCEL_TOKEN_TPERCENT= $14; // Percent (%, divides operand by 100)
INT_EXCEL_TOKEN_TPAREN = $15; // Operator in parenthesis
{ Constant Operand Tokens, 3.8}
INT_EXCEL_TOKEN_TMISSARG= $16; //missing operand
@ -515,6 +516,7 @@ const
(0, INT_EXCEL_TOKEN_TBOOL), {fekBool}
(0, INT_EXCEL_TOKEN_TERR), {fekErr}
(0, INT_EXCEL_TOKEN_TMISSARG), {fekMissArg, missing argument}
(0, INT_EXCEL_TOKEN_TPAREN), {Operator in parenthesis}
// Basic operations
(0, INT_EXCEL_TOKEN_TADD), {fekAdd, +}
@ -1373,8 +1375,8 @@ begin
ARow := r and MASK_EXCEL_ROW;
// Extract absolute/relative flags
AFlags := [];
if (r and MASK_EXCEL_RELATIVE_COL = 1) then Include(AFlags, rfRelCol);
if (r and MASK_EXCEL_RELATIVE_ROW = 1) then Include(AFlags, rfRelRow);
if (r and MASK_EXCEL_RELATIVE_COL <> 0) then Include(AFlags, rfRelCol);
if (r and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow);
end;
{ Reads the cell address used in an RPN formula element. Evaluates the corresponding
@ -1396,10 +1398,10 @@ begin
ARow2 := r2 and MASK_EXCEL_ROW;
// Extract absolute/relative flags
AFlags := [];
if (r1 and MASK_EXCEL_RELATIVE_COL = 1) then Include(AFlags, rfRelCol);
if (r2 and MASK_EXCEL_RELATIVE_COL = 1) then Include(AFlags, rfRelCol2);
if (r1 and MASK_EXCEL_RELATIVE_ROW = 1) then Include(AFlags, rfRelRow);
if (r2 and MASK_EXCEL_RELATIVE_ROW = 1) then Include(AFlags, rfRelRow2);
if (r1 and MASK_EXCEL_RELATIVE_COL <> 0) then Include(AFlags, rfRelCol);
if (r2 and MASK_EXCEL_RELATIVE_COL <> 0) then Include(AFlags, rfRelCol2);
if (r1 and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow);
if (r2 and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow2);
end;
{ Reads the identifier for an RPN function with fixed argument count.
@ -1463,6 +1465,8 @@ begin
AStream.ReadBuffer(dblVal, 8);
rpnItem := RPNNumber(dblVal, rpnItem);
end;
INT_EXCEL_TOKEN_TPAREN:
rpnItem := RPNParenthesis(rpnItem);
INT_EXCEL_TOKEN_FUNC_R,
INT_EXCEL_TOKEN_FUNC_V,
@ -1510,42 +1514,6 @@ begin
end;
if not found then
supported := false;
(*
// binary tokens
INT_EXCEL_TOKEN_TADD:
rpnItem := RPNFunc(fekAdd, rpnItem);
INT_EXCEL_TOKEN_TSUB:
rpnItem := RPNFunc(fekSub, rpnItem);
INT_EXCEL_TOKEN_TMUL:
rpnItem := RPNFunc(fekMul, rpnItem);
INT_EXCEL_TOKEN_TDIV:
rpnItem := RPNFunc(fekDiv, rpnItem);
INT_EXCEL_TOKEN_TPOWER:
rpnItem := RPNFunc(fekPower, rpnItem);
INT_EXCEL_TOKEN_TCONCAT:
rpnItem := RPNFunc(fekConcat, rpnItem);
INT_EXCEL_TOKEN_TLT:
rpnItem := RPNFunc(fekLess, rpnItem);
INT_EXCEL_TOKEN_TLE:
rpnItem := RPNFunc(fekLessEqual, rpnItem);
INT_EXCEL_TOKEN_TEQ:
rpnItem := RPNFunc(fekEqual, rpnItem);
INT_EXCEL_TOKEN_TGE:
rpnItem := RPNFunc(fekGreaterEqual, rpnItem);
INT_EXCEL_TOKEN_TGT:
rpnItem := RPNFunc(fekGreater, rpnItem);
INT_EXCEL_TOKEN_TNE:
rpnItem := RPNFunc(fekNotEqual, rpnItem);
// Unary operations
INT_EXCEL_TOKEN_TUPLUS:
rpnItem := RPNFunc(fekUPlus, rpnItem);
INT_EXCEL_TOKEN_TUMINUS:
rpnItem := RPNFunc(fekUMinus, rpnItem);
INT_EXCEL_TOKEN_TPERCENT:
rpnItem := RPNFunc(fekPercent, rpnItem);
// Operands (--> 3.8)
else
supported := false; *)
end;
end;
if not supported then begin