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

fpspreadsheet: In fpspreadsheet.pas, extract cells AVLTree to fpsclasses.pas. Implement enumerator for the avl trees. Add unit tests for cell and comment enumeration.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3988 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-03-04 17:30:59 +00:00
parent e85c36df87
commit 7e52faa49f
18 changed files with 1613 additions and 483 deletions
Download Patch File Download Diff File Expand all files Collapse all files

139
components/fpspreadsheet/examples/spready/mainform.lfm
View File

@ -23,7 +23,7 @@ object MainFrm: TMainFrm
TabOrder = 6 TabOrder = 6
object EdFrozenCols: TSpinEdit object EdFrozenCols: TSpinEdit
Left = 429 Left = 429
Height = 27 Height = 23
Top = 8 Top = 8
Width = 52 Width = 52
OnChange = EdFrozenColsChange OnChange = EdFrozenColsChange
@ -31,7 +31,7 @@ object MainFrm: TMainFrm
end end
object EdFrozenRows: TSpinEdit object EdFrozenRows: TSpinEdit
Left = 429 Left = 429
Height = 27 Height = 23
Top = 39 Top = 39
Width = 52 Width = 52
OnChange = EdFrozenRowsChange OnChange = EdFrozenRowsChange
@ -123,7 +123,7 @@ object MainFrm: TMainFrm
Action = AcSaveAs Action = AcSaveAs
end end
object ToolButton3: TToolButton object ToolButton3: TToolButton
Left = 200 Left = 228
Top = 0 Top = 0
Action = AcQuit Action = AcQuit
end end
@ -181,6 +181,19 @@ object MainFrm: TMainFrm
Caption = 'ToolButton31' Caption = 'ToolButton31'
Style = tbsDivider Style = tbsDivider
end end
object ToolButton32: TToolButton
Left = 200
Top = 0
Action = AcCommentAdd
end
object ToolButton33: TToolButton
Left = 223
Height = 24
Top = 0
Width = 5
Caption = 'ToolButton33'
Style = tbsDivider
end
end end
object FormatToolBar: TToolBar object FormatToolBar: TToolBar
Left = 0 Left = 0
@ -401,7 +414,7 @@ object MainFrm: TMainFrm
TabOrder = 2 TabOrder = 2
object EdCellAddress: TEdit object EdCellAddress: TEdit
Left = 0 Left = 0
Height = 27 Height = 23
Top = 0 Top = 0
Width = 170 Width = 170
Align = alTop Align = alTop
@ -1406,7 +1419,7 @@ object MainFrm: TMainFrm
left = 272 left = 272
top = 264 top = 264
Bitmap = { Bitmap = {
4C69280000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 4C692B0000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00EAC39DFFE6BF96FFE4BB92FFE4BB92FFD1A06CF5D09E6DF6CC96 FF00FFFFFF00EAC39DFFE6BF96FFE4BB92FFE4BB92FFD1A06CF5D09E6DF6CC96
5FDAC479427EB2673C09FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 5FDAC479427EB2673C09FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00E5BE96FFFFFFFEFFFDF3E9FFFDF3EAFFFCF2E8FFFAEFE3FFFAF2 FF00FFFFFF00E5BE96FFFFFFFEFFFDF3E9FFFDF3EAFFFCF2E8FFFAEFE3FFFAF2
@ -2686,7 +2699,103 @@ object MainFrm: TMainFrm
63FFCB8E5EFFC98A5BFFC78756FFC38452FFC38452FFC38452FFC38452FFC384 63FFCB8E5EFFC98A5BFFC78756FFC38452FFC38452FFC38452FFC38452FFC384
52FFC38452FFBB7742B0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 52FFC38452FFBB7742B0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000026EB628026EB669026EB679026E
B679026EB679026EB679026EB679026EB679026EB679026EB679026EB679026E
B679026EB669026EB6280000000000000000026DB46BC1E3F1D9E6FBFFFFE5FA
FFFFE5FAFFFFE5FAFFFFE5FAFFFFE5FAFFFFE5FAFFFFE4FAFFFFE4FAFFFFE5FA
FFFFBDE2F1D9026DB46B0000000000000000026BB17EE5FAFFFFD9F4FFFFD9F4
FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4
FFFFE0F8FFFF026BB17E0000000000000000026AAE81E0F9FFFFD4F2FFFFD4F2
FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2
FFFFD9F5FFFF026AAE8100000000000000000268AB84DCF7FFFFCFF0FFFFCFF0
FFFFCFF0FFFFC2EDFCFFA8E8F4FF91E3EDFF84E0E9FF7CDEE7FF7CDEE7FF84E0
E9FF9CE6EFFF0268AB8400000000000000000266A788D8F4FFFFCCEEFFFFC2EC
FCFF9DE5F1FF85E0EAFF82E0E9FF82E0E9FF82E0E9FF82E0E9FF82E0E9FF82E0
E9FF8AE2EBFF0266A78800000000000000000264A48CD6F3FFFFB6EBF9FF94E4
F0FF8FE3EEFF8FE3EEFF8FE3EEFF8FE3EEFF8FE3EEFF45C05FFF2DB42FFF45C0
5FFF91E4EFFF0264A48C00000000000000000261A090C1EFFBFF9EE7F4FF9DE6
F4FF9DE6F4FF9DE6F4FF9DE6F4FF9DE6F4FF9DE6F4FF2FB130FF75EE64FF2FB1
30FF9DE6F4FF0261A0900000000000000000025F9C8191D0E6E1B0ECF9FFAEEB
F9FFADEBF9FFACEBF9FFABEAF9FF4EBB63FF30AC31FF30AC31FF66EB55FF30AC
31FF26A529F90D8C27CD0000000000000000025C9832025C9785025C9799025C
9799B7EDFDFF025C9799025C97990E8D13EB52E741FF52E741FF52E741FF52E7
41FF52E741FF0F9207D600000000000000000000000000000000000000000355
8BA603558BA603568D39035993020E8D00990E8C00CC0E8C00CC3DE22CFF0E8C
00CC0E8C00CC0E8D00990000000000000000000000000000000000000000034D
7DB5034E7F3D000000000000000000000000000000000C8300CC2BDF1AFF0C83
00CC000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000066D0099056900CC066D
0099000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000026EB628026EB669026EB679026E
B679026EB679026EB679026EB679026EB679026EB679026EB679026EB679026E
B679026EB669026EB6280000000000000000026DB46BC1E3F1D9E6FBFFFFE5FA
FFFFE5FAFFFFE5FAFFFFE5FAFFFFE5FAFFFFE5FAFFFFE4FAFFFFE4FAFFFFE5FA
FFFFBDE2F1D9026DB46B0000000000000000026BB17EE5FAFFFFD9F4FFFFD9F4
FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4
FFFFE0F8FFFF026BB17E0000000000000000026AAE81E0F9FFFFD4F2FFFFD4F2
FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2
FFFFD9F5FFFF026AAE8100000000000000000268AB84DCF7FFFFCFF0FFFFCFF0
FFFFCFF0FFFFC2EDFCFFA8E8F4FF91E3EDFF84E0E9FF7CDEE7FF7CDEE7FF84E0
E9FF9CE6EFFF0268AB8400000000000000000266A788D8F4FFFFCCEEFFFFC2EC
FCFF9DE5F1FF85E0EAFF82E0E9FF82E0E9FF82E0E9FF82E0E9FF82E0E9FF82E0
E9FF8AE2EBFF0266A78800000000000000000264A48CD6F3FFFFB6EBF9FF94E4
F0FF8FE3EEFF8FE3EEFF8FE3EEFF8FE3EEFF8FE3EEFF8FE3EEFF8FE3EEFF8FE3
EEFF91E4EFFF0264A48C00000000000000000261A090C1EFFBFF9EE7F4FF9DE6
F4FF9DE6F4FF9DE6F4FF9DE6F4FF9DE6F4FF9DE6F4FF9DE6F4FF9DE6F4FF9DE6
F4FF9DE6F4FF0261A0900000000000000000025F9C8191D0E6E1B0ECF9FFAEEB
F9FFADEBF9FFACEBF9FFABEAF9FF445DC7FF222EB7FF222EB7FF222EB7FF222E
B7FF1824B2F90018A3CD0000000000000000025C9832025C9785025C9799025C
9799B7EDFDFF025C9799025C9799000C97EB5E5EF7FF5E5EF7FF5E5EF7FF5E5E
F7FF5E5EF7FF000498D600000000000000000000000000000000000000000355
8BA603558BA603568D390359930200008499000080CC000080CC000080CC0000
80CC000080CC000084990000000000000000000000000000000000000000034D
7DB5034E7F3D0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000026EB628026EB669026EB679026E
B679026EB679026EB679026EB679026EB679026EB679026EB679026EB679026E
B679026EB669026EB6280000000000000000026DB46BC1E3F1D9E6FBFFFFE5FA
FFFFE5FAFFFFE5FAFFFFE5FAFFFFE5FAFFFFE5FAFFFFE4FAFFFFE4FAFFFFE5FA
FFFFBDE2F1D9026DB46B0000000000000000026BB17EE5FAFFFFD9F4FFFFD9F4
FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4FFFFD9F4
FFFFE0F8FFFF026BB17E0000000000000000026AAE81E0F9FFFFD4F2FFFFD4F2
FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2FFFFD4F2
FFFFD9F5FFFF026AAE8100000000000000000268AB84DCF7FFFFCFF0FFFFCFF0
FFFFCFF0FFFFC2EDFCFFA8E8F4FF91E3EDFF84E0E9FF7CDEE7FF7CDEE7FF70B7
D8FF3148E3FF013FB5A300000000000000000266A788D8F4FFFFCCEEFFFFC2EC
FCFF9DE5F1FF85E0EAFF82E0E9FF82E0E9FF82E0E9FF82E0E9FF7BCCD3FF5E8E
ADFF8080FFFF010FAFE200000000000000000264A48CD6F3FFFFB6EBF9FF94E4
F0FF8FE3EEFF8FE3EEFF8FE3EEFF8FE3EEFF8FE3EEFF6BD2E1FF71A2A8FFF7F7
F7FF4E7390FF013BA1AC00000000000000000261A090C1EFFBFF9EE7F4FF9DE6
F4FF9DE6F4FF9DE6F4FF9DE6F4FF9DE6F4FF76D5E5FF2EADC3FF79E6F7FF6085
8DFF83BFCBFF0261A0900000000000000000025F9C8191D0E6E1B0ECF9FFAEEB
F9FFADEBF9FFACEBF9FFABEAF9FF80D8E9FF32AFC5FF79E6F7FF2C99AEFF80BF
CDFF86CCE5E1025F9C810000000000000000025C9832025C9785025C9799025C
9799B7EDFDFF025C97990174A3B2018BABE179E6F7FF017895E5016491B4025C
9799025C9785025C983200000000000000000000000000000000000000000355
8BA603558BA6016798570196AFB679E6F7FF017E95BE00728944000000000000
000000000000000000000000000000000000000000000000000000000000034D
7DB5034E7F3D016D917FD9F4FFFF017E95BE0072894400000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF014F68AB015F773D0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
} }
end end
object ActionList: TActionList object ActionList: TActionList
@ -3203,6 +3312,24 @@ object MainFrm: TMainFrm
Hint = 'Names and symbols known as valid currencies' Hint = 'Names and symbols known as valid currencies'
OnExecute = AcCurrencySymbolsExecute OnExecute = AcCurrencySymbolsExecute
end end
object AcCommentAdd: TAction
Caption = 'New comment..'
Hint = 'Add comment'
ImageIndex = 40
OnExecute = AcCommentAddExecute
end
object AcCommentDelete: TAction
Caption = 'Delete comment'
Hint = 'Delete comment'
ImageIndex = 41
OnExecute = AcCommentDeleteExecute
end
object AcCommentEdit: TAction
Caption = 'Edit comment...'
Hint = 'Edit comment'
ImageIndex = 42
OnExecute = AcCommentAddExecute
end
end end
object FontDialog: TFontDialog object FontDialog: TFontDialog
MinFontSize = 0 MinFontSize = 0

114
components/fpspreadsheet/examples/spready/mainform.pas
View File

@ -83,6 +83,9 @@ type
AcSortColAsc: TAction; AcSortColAsc: TAction;
AcSort: TAction; AcSort: TAction;
AcCurrencySymbols: TAction; AcCurrencySymbols: TAction;
AcCommentAdd: TAction;
AcCommentDelete: TAction;
AcCommentEdit: TAction;
AcViewInspector: TAction; AcViewInspector: TAction;
AcWordwrap: TAction; AcWordwrap: TAction;
AcVAlignDefault: TAction; AcVAlignDefault: TAction;
@ -248,6 +251,8 @@ type
ToolButton29: TToolButton; ToolButton29: TToolButton;
ToolButton30: TToolButton; ToolButton30: TToolButton;
ToolButton31: TToolButton; ToolButton31: TToolButton;
ToolButton32: TToolButton;
ToolButton33: TToolButton;
WorksheetGrid: TsWorksheetGrid; WorksheetGrid: TsWorksheetGrid;
ToolBar1: TToolBar; ToolBar1: TToolBar;
FormatToolBar: TToolBar; FormatToolBar: TToolBar;
@ -280,6 +285,8 @@ type
procedure AcAddColumnExecute(Sender: TObject); procedure AcAddColumnExecute(Sender: TObject);
procedure AcAddRowExecute(Sender: TObject); procedure AcAddRowExecute(Sender: TObject);
procedure AcBorderExecute(Sender: TObject); procedure AcBorderExecute(Sender: TObject);
procedure AcCommentAddExecute(Sender: TObject);
procedure AcCommentDeleteExecute(Sender: TObject);
procedure AcCopyFormatExecute(Sender: TObject); procedure AcCopyFormatExecute(Sender: TObject);
procedure AcCSVParamsExecute(Sender: TObject); procedure AcCSVParamsExecute(Sender: TObject);
procedure AcCurrencySymbolsExecute(Sender: TObject); procedure AcCurrencySymbolsExecute(Sender: TObject);
@ -327,10 +334,13 @@ type
private private
FCopiedFormat: TCell; FCopiedFormat: TCell;
function EditComment(ACaption: String; var AText: String): Boolean;
procedure LoadFile(const AFileName: String); procedure LoadFile(const AFileName: String);
procedure SetupBackgroundColorBox; procedure SetupBackgroundColorBox;
procedure UpdateBackgroundColorIndex; procedure UpdateBackgroundColorIndex;
procedure UpdateCellInfo(ACell: PCell); procedure UpdateCellInfo(ACell: PCell);
procedure UpdateCommentActions;
procedure UpdateFontNameIndex; procedure UpdateFontNameIndex;
procedure UpdateFontSizeIndex; procedure UpdateFontSizeIndex;
procedure UpdateFontStyleActions; procedure UpdateFontStyleActions;
@ -353,7 +363,7 @@ var
implementation implementation
uses uses
TypInfo, LCLIntf, LCLType, LCLVersion, fpcanvas, TypInfo, LCLIntf, LCLType, LCLVersion, fpcanvas, Buttons,
fpsutils, fpscsv, fpsNumFormat, fpsutils, fpscsv, fpsNumFormat,
sFormatSettingsForm, sCSVParamsForm, sSortParamsForm, sfCurrencyForm; sFormatSettingsForm, sCSVParamsForm, sSortParamsForm, sfCurrencyForm;
@ -479,6 +489,42 @@ begin
end; end;
end; end;
procedure TMainFrm.AcCommentAddExecute(Sender: TObject);
var
r,c: Cardinal;
cell: PCell;
comment: String;
begin
with WorksheetGrid do
begin
r := GetWorksheetRow(Row);
c := GetWorksheetCol(Col);
cell := Worksheet.FindCell(r, c);
if Worksheet.HasComment(cell) then
comment := Worksheet.ReadComment(cell)
else
comment := '';
if EditComment(Format('Comment for cell %s', [GetCellString(r, c)]), comment)
then
Worksheet.WriteComment(r, c, comment);
end;
end;
procedure TMainFrm.AcCommentDeleteExecute(Sender: TObject);
var
r, c: Cardinal;
cell: PCell;
begin
with WorksheetGrid do
begin
r := GetWorksheetRow(Row);
c := GetWorksheetCol(Col);
cell := Worksheet.FindCell(r, c);
if Worksheet.HasComment(cell) then
Worksheet.RemoveComment(cell);
end;
end;
procedure TMainFrm.AcAddColumnExecute(Sender: TObject); procedure TMainFrm.AcAddColumnExecute(Sender: TObject);
begin begin
WorksheetGrid.InsertCol(WorksheetGrid.Col); WorksheetGrid.InsertCol(WorksheetGrid.Col);
@ -934,6 +980,53 @@ begin
WorksheetGrid.FrozenRows := EdFrozenRows.Value; WorksheetGrid.FrozenRows := EdFrozenRows.Value;
end; end;
function TMainFrm.EditComment(ACaption: String; var AText: String): Boolean;
var
F: TForm;
memo: TMemo;
panel: TPanel;
btn: TBitBtn;
begin
F := TForm.Create(nil);
try
F.Caption := ACaption;
F.Width := 400;
F.Height := 300;
F.Position := poMainFormCenter;
memo := TMemo.Create(F);
memo.Parent := F;
memo.Align := alClient;
memo.BorderSpacing.Around := 4;
memo.Lines.Text := AText;
panel := TPanel.Create(F);
panel.Parent := F;
panel.Align := alBottom;
panel.Height := 44;
panel.BevelOuter := bvNone;
panel.Caption := '';
btn := TBitBtn.Create(F);
btn.Parent := panel;
btn.Kind := bkOK;
btn.Left := panel.ClientWidth - 2*btn.Width - 2*8;
btn.Top := 6;
btn.Anchors := [akTop, akRight];
btn := TBitBtn.Create(F);
btn.Parent := panel;
btn.Kind := bkCancel;
btn.Left := panel.ClientWidth - btn.Width - 8;
btn.Top := 6;
btn.Anchors := [akTop, akRight];
if F.ShowModal = mrOK then
begin
Result := true;
AText := memo.Lines.Text;
end else
Result := false;
finally
F.Free;
end;
end;
procedure TMainFrm.FontComboBoxSelect(Sender: TObject); procedure TMainFrm.FontComboBoxSelect(Sender: TObject);
var var
fname: String; fname: String;
@ -1246,6 +1339,24 @@ begin
end; end;
end; end;
procedure TMainFrm.UpdateCommentActions;
var
r, c: Cardinal;
cell: PCell;
hasCmnt: Boolean;
begin
with WorksheetGrid do
begin
r := GetWorksheetRow(Row);
c := GetWorksheetCol(Col);
cell := Worksheet.FindCell(row, col);
hasCmnt := Worksheet.HasComment(cell);
end;
AcCommentAdd.Enabled := not hasCmnt;
AcCommentEdit.Enabled := hasCmnt;
AcCommentDelete.Enabled := hasCmnt;
end;
procedure TMainFrm.UpdateFontNameIndex; procedure TMainFrm.UpdateFontNameIndex;
var var
fname: String; fname: String;
@ -1418,6 +1529,7 @@ begin
UpdateFontStyleActions; UpdateFontStyleActions;
UpdateTextRotationActions; UpdateTextRotationActions;
UpdateNumFormatActions; UpdateNumFormatActions;
UpdateCommentActions;
UpdateCellInfo(cell); UpdateCellInfo(cell);
end; end;

67
components/fpspreadsheet/fpscell.pas
View File

@ -44,7 +44,9 @@ type
procedure SetWordwrap(const AValue: Boolean); procedure SetWordwrap(const AValue: Boolean);
protected protected
function GetWorkbook: TsWorkbook; function GetWorkbook: TsWorkbook; inline;
function GetWorksheet: TsWorksheet; inline;
public public
property BackgroundColor: TsColor property BackgroundColor: TsColor
read GetBackgroundColor write SetBackgroundColor; read GetBackgroundColor write SetBackgroundColor;
@ -84,37 +86,37 @@ implementation
function TCellHelper.GetBackgroundColor: TsColor; function TCellHelper.GetBackgroundColor: TsColor;
begin begin
Result := Worksheet.ReadBackgroundColor(@self); Result := GetWorksheet.ReadBackgroundColor(@self);
end; end;
function TCellHelper.GetBorder: TsCellBorders; function TCellHelper.GetBorder: TsCellBorders;
begin begin
Result := Worksheet.ReadCellBorders(@self); Result := GetWorksheet.ReadCellBorders(@self);
end; end;
function TCellHelper.GetBorderStyle(const ABorder: TsCellBorder): TsCellBorderStyle; function TCellHelper.GetBorderStyle(const ABorder: TsCellBorder): TsCellBorderStyle;
begin begin
Result := Worksheet.ReadCellBorderStyle(@self, ABorder); Result := GetWorksheet.ReadCellBorderStyle(@self, ABorder);
end; end;
function TCellHelper.GetBorderStyles: TsCellBorderStyles; function TCellHelper.GetBorderStyles: TsCellBorderStyles;
begin begin
Result := Worksheet.ReadCellBorderStyles(@self); Result := GetWorksheet.ReadCellBorderStyles(@self);
end; end;
function TCellHelper.GetCellFormat: TsCellFormat; function TCellHelper.GetCellFormat: TsCellFormat;
begin begin
Result := Workbook.GetCellFormat(FormatIndex); Result := GetWorkbook.GetCellFormat(FormatIndex);
end; end;
function TCellHelper.GetComment: String; function TCellHelper.GetComment: String;
begin begin
Result := Worksheet.ReadComment(@self); Result := GetWorksheet.ReadComment(@self);
end; end;
function TCellHelper.GetFont: TsFont; function TCellHelper.GetFont: TsFont;
begin begin
Result := Worksheet.ReadCellFont(@self); Result := GetWorksheet.ReadCellFont(@self);
end; end;
function TCellHelper.GetFontIndex: Integer; function TCellHelper.GetFontIndex: Integer;
@ -127,12 +129,12 @@ end;
function TCellHelper.GetHorAlignment: TsHorAlignment; function TCellHelper.GetHorAlignment: TsHorAlignment;
begin begin
Result := Worksheet.ReadHorAlignment(@Self); Result := GetWorksheet.ReadHorAlignment(@Self);
end; end;
function TCellHelper.GetHyperlink: TsHyperlink; function TCellHelper.GetHyperlink: TsHyperlink;
begin begin
Result := Worksheet.ReadHyperlink(@self); Result := GetWorksheet.ReadHyperlink(@self);
end; end;
function TCellHelper.GetNumberFormat: TsNumberFormat; function TCellHelper.GetNumberFormat: TsNumberFormat;
@ -153,73 +155,78 @@ end;
function TCellHelper.GetTextRotation: TsTextRotation; function TCellHelper.GetTextRotation: TsTextRotation;
begin begin
Result := Worksheet.ReadTextRotation(@Self); Result := GetWorksheet.ReadTextRotation(@Self);
end; end;
function TCellHelper.GetUsedFormattingFields: TsUsedFormattingFields; function TCellHelper.GetUsedFormattingFields: TsUsedFormattingFields;
begin begin
Result := Worksheet.ReadUsedFormatting(@Self); Result := GetWorksheet.ReadUsedFormatting(@Self);
end; end;
function TCellHelper.GetVertAlignment: TsVertAlignment; function TCellHelper.GetVertAlignment: TsVertAlignment;
begin begin
Result := Worksheet.ReadVertAlignment(@self); Result := GetWorksheet.ReadVertAlignment(@self);
end; end;
function TCellHelper.GetWordwrap: Boolean; function TCellHelper.GetWordwrap: Boolean;
begin begin
Result := Worksheet.ReadWordwrap(@self); Result := GetWorksheet.ReadWordwrap(@self);
end; end;
function TCellHelper.GetWorkbook: TsWorkbook; function TCellHelper.GetWorkbook: TsWorkbook;
begin begin
Result := Worksheet.Workbook; Result := GetWorksheet.Workbook;
end;
function TCellHelper.GetWorksheet: TsWorksheet;
begin
Result := TsWorksheet(Worksheet);
end; end;
procedure TCellHelper.SetBackgroundColor(const AValue: TsColor); procedure TCellHelper.SetBackgroundColor(const AValue: TsColor);
begin begin
Worksheet.WriteBackgroundColor(@self, AValue); GetWorksheet.WriteBackgroundColor(@self, AValue);
end; end;
procedure TCellHelper.SetBorder(const AValue: TsCellBorders); procedure TCellHelper.SetBorder(const AValue: TsCellBorders);
begin begin
Worksheet.WriteBorders(@self, AValue); GetWorksheet.WriteBorders(@self, AValue);
end; end;
procedure TCellHelper.SetBorderStyle(const ABorder: TsCellBorder; procedure TCellHelper.SetBorderStyle(const ABorder: TsCellBorder;
const AValue: TsCellBorderStyle); const AValue: TsCellBorderStyle);
begin begin
Worksheet.WriteBorderStyle(@self, ABorder, AValue); GetWorksheet.WriteBorderStyle(@self, ABorder, AValue);
end; end;
procedure TCellHelper.SetBorderStyles(const AValue: TsCellBorderStyles); procedure TCellHelper.SetBorderStyles(const AValue: TsCellBorderStyles);
begin begin
Worksheet.WriteBorderStyles(@self, AValue); GetWorksheet.WriteBorderStyles(@self, AValue);
end; end;
procedure TCellHelper.SetCellFormat(const AValue: TsCellFormat); procedure TCellHelper.SetCellFormat(const AValue: TsCellFormat);
begin begin
Worksheet.WriteCellFormat(@self, AValue); GetWorksheet.WriteCellFormat(@self, AValue);
end; end;
procedure TCellHelper.SetComment(const AValue: String); procedure TCellHelper.SetComment(const AValue: String);
begin begin
Worksheet.WriteComment(@self, AValue); GetWorksheet.WriteComment(@self, AValue);
end; end;
procedure TCellHelper.SetFontIndex(const AValue: Integer); procedure TCellHelper.SetFontIndex(const AValue: Integer);
begin begin
Worksheet.WriteFont(@self, AValue); GetWorksheet.WriteFont(@self, AValue);
end; end;
procedure TCellHelper.SetHorAlignment(const AValue: TsHorAlignment); procedure TCellHelper.SetHorAlignment(const AValue: TsHorAlignment);
begin begin
Worksheet.WriteHorAlignment(@self, AValue); GetWorksheet.WriteHorAlignment(@self, AValue);
end; end;
procedure TCellHelper.SetHyperlink(const AValue: TsHyperlink); procedure TCellHelper.SetHyperlink(const AValue: TsHyperlink);
begin begin
Worksheet.WriteHyperlink(@self, AValue.Target, AValue.Tooltip); GetWorksheet.WriteHyperlink(@self, AValue.Target, AValue.Tooltip);
end; end;
procedure TCellHelper.SetNumberFormat(const AValue: TsNumberFormat); procedure TCellHelper.SetNumberFormat(const AValue: TsNumberFormat);
@ -228,7 +235,7 @@ var
begin begin
fmt := Workbook.GetCellFormat(FormatIndex); fmt := Workbook.GetCellFormat(FormatIndex);
fmt.NumberFormat := AValue; fmt.NumberFormat := AValue;
Worksheet.WriteCellFormat(@self, fmt); GetWorksheet.WriteCellFormat(@self, fmt);
end; end;
procedure TCellHelper.SetNumberFormatStr(const AValue: String); procedure TCellHelper.SetNumberFormatStr(const AValue: String);
@ -237,27 +244,27 @@ var
begin begin
fmt := Workbook.GetCellFormat(FormatIndex); fmt := Workbook.GetCellFormat(FormatIndex);
fmt.NumberFormatStr := AValue; fmt.NumberFormatStr := AValue;
Worksheet.WriteCellFormat(@self, fmt); GetWorksheet.WriteCellFormat(@self, fmt);
end; end;
procedure TCellHelper.SetTextRotation(const AValue: TsTextRotation); procedure TCellHelper.SetTextRotation(const AValue: TsTextRotation);
begin begin
Worksheet.WriteTextRotation(@self, AValue); GetWorksheet.WriteTextRotation(@self, AValue);
end; end;
procedure TCellHelper.SetUsedFormattingFields(const AValue: TsUsedFormattingFields); procedure TCellHelper.SetUsedFormattingFields(const AValue: TsUsedFormattingFields);
begin begin
Worksheet.WriteUsedFormatting(@self, AValue); GetWorksheet.WriteUsedFormatting(@self, AValue);
end; end;
procedure TCellHelper.SetVertAlignment(const AValue: TsVertAlignment); procedure TCellHelper.SetVertAlignment(const AValue: TsVertAlignment);
begin begin
Worksheet.WriteVertAlignment(@self, AValue); GetWorksheet.WriteVertAlignment(@self, AValue);
end; end;
procedure TCellHelper.SetWordwrap(const AValue: Boolean); procedure TCellHelper.SetWordwrap(const AValue: Boolean);
begin begin
Worksheet.WriteWordwrap(@self, AValue); GetWorksheet.WriteWordwrap(@self, AValue);
end; end;

667
components/fpspreadsheet/fpsclasses.pas
View File

@ -9,35 +9,122 @@ uses
fpstypes; fpstypes;
type type
{ forward declarations }
TsRowColAVLTree = class;
{ TsRowCol } { TsRowCol }
TsRowCol = record TsRowCol = record
Row, Col: Cardinal; Row, Col: LongInt;
end; end;
PsRowCol = ^TsRowCol; PsRowCol = ^TsRowCol;
{ TAVLTreeNodeStack }
TAVLTreeNodeStack = class(TFPList)
public
procedure Push(ANode: TAVLTreeNode);
function Pop: TAVLTreeNode;
end;
{ TsRowColEnumerator }
TsRowColEnumerator = class
protected
FCurrentNode: TAVLTreeNode;
FTree: TsRowColAVLTree;
FStartRow, FEndRow, FStartCol, FEndCol: LongInt;
FReverse: Boolean;
function GetCurrent: PsRowCol;
public
constructor Create(ATree: TsRowColAVLTree;
AStartRow, AStartCol, AEndRow, AEndCol: LongInt; AReverse: Boolean);
function GetEnumerator: TsRowColEnumerator; inline;
function MoveNext: Boolean;
property Current: PsRowCol read GetCurrent;
property StartRow: LongInt read FStartRow;
property EndRow: LongInt read FEndRow;
property StartCol: LongInt read FStartCol;
property EndCol: LongInt read FEndCol;
end;
{ TsRowColAVLTree } { TsRowColAVLTree }
TsRowColAVLTree = class(TAVLTree) TsRowColAVLTree = class(TAVLTree)
private private
FOwnsData: Boolean; FOwnsData: Boolean;
FCurrentNode: TAVLTreeNode; FCurrentNode: TAVLTreeNode;
FCurrentNodeStack: TAVLTreeNodeStack;
protected protected
procedure DisposeData(var AData: Pointer); virtual; abstract; procedure DisposeData(var AData: Pointer); virtual; abstract;
function NewData: Pointer; virtual; abstract; function NewData: Pointer; virtual; abstract;
public public
constructor Create(AOwnsData: Boolean = true); constructor Create(AOwnsData: Boolean = true);
destructor Destroy; override; destructor Destroy; override;
function Add(ARow, ACol: Cardinal): PsRowCol; function Add(ARow, ACol: LongInt): PsRowCol;
procedure Clear; procedure Clear;
procedure Delete(ANode: TAVLTreeNode); procedure Delete(ANode: TAVLTreeNode); overload;
procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); virtual; procedure Delete(ARow, ACol: LongInt); overload;
function Find(ARow, ACol: Cardinal): PsRowCol; procedure DeleteRowOrCol(AIndex: LongInt; IsRow: Boolean); virtual;
procedure Exchange(ARow1, ACol1, ARow2, ACol2: LongInt); virtual;
function Find(ARow, ACol: LongInt): PsRowCol; overload;
function GetData(ANode: TAVLTreeNode): PsRowCol;
function GetFirst: PsRowCol; function GetFirst: PsRowCol;
function GetLast: PsRowCol;
function GetNext: PsRowCol; function GetNext: PsRowCol;
procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean); function GetPrev: PsRowCol;
procedure Remove(ARow, ACol: Cardinal); procedure InsertRowOrCol(AIndex: LongInt; IsRow: Boolean);
procedure Remove(ARow, ACol: LongInt); overload;
procedure PushCurrent;
procedure PopCurrent;
end;
{ TsCells }
TsCellEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PCell;
public
function GetEnumerator: TsCellEnumerator; inline;
property Current: PCell read GetCurrent;
end;
TsCells = class(TsRowColAVLTree)
private
FWorksheet: Pointer; // Must be cast to TsWorksheet
protected
procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override;
public
constructor Create(AWorksheet: Pointer; AOwnsData: Boolean = true);
function AddCell(ARow, ACol: LongInt): PCell;
procedure DeleteCell(ARow, ACol: LongInt);
function FindCell(ARow, ACol: LongInt): PCell;
function GetFirstCell: PCell;
function GetLastCell: PCell;
function GetNextCell: PCell;
function GetPrevCell: PCell;
// enumerators
function GetEnumerator: TsCellEnumerator;
function GetReverseEnumerator: TsCellEnumerator;
function GetColEnumerator(ACol: LongInt; AStartRow: Longint = 0;
AEndRow: Longint = $7FFFFFFF): TsCellEnumerator;
function GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Longint): TsCellEnumerator;
function GetRowEnumerator(ARow: LongInt; AStartCol:LongInt = 0;
AEndCol: Longint = $7FFFFFFF): TsCellEnumerator;
function GetReverseColEnumerator(ACol: LongInt; AStartRow: Longint = 0;
AEndRow: Longint = $7FFFFFFF): TsCellEnumerator;
function GetReverseRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Longint): TsCellEnumerator;
function GetReverseRowEnumerator(ARow: LongInt; AStartCol:LongInt = 0;
AEndCol: Longint = $7FFFFFFF): TsCellEnumerator;
end; end;
{ TsComments } { TsComments }
TsCommentEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PsComment;
public
function GetEnumerator: TsCommentEnumerator; inline;
property Current: PsComment read GetCurrent;
end;
TsComments = class(TsRowColAVLTree) TsComments = class(TsRowColAVLTree)
protected protected
procedure DisposeData(var AData: Pointer); override; procedure DisposeData(var AData: Pointer); override;
@ -45,16 +132,33 @@ type
public public
function AddComment(ARow, ACol: Cardinal; AComment: String): PsComment; function AddComment(ARow, ACol: Cardinal; AComment: String): PsComment;
procedure DeleteComment(ARow, ACol: Cardinal); procedure DeleteComment(ARow, ACol: Cardinal);
// enumerators
function GetEnumerator: TsCommentEnumerator;
function GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Longint): TsCommentEnumerator;
end; end;
{ TsHyperlinks } { TsHyperlinks }
TsHyperlinkEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PsHyperlink;
public
function GetEnumerator: TsHyperlinkEnumerator; inline;
property Current: PsHyperlink read GetCurrent;
end;
TsHyperlinks = class(TsRowColAVLTree) TsHyperlinks = class(TsRowColAVLTree)
protected protected
procedure DisposeData(var AData: Pointer); override; procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override; function NewData: Pointer; override;
public public
function AddHyperlink(ARow, ACol: Cardinal; ATarget: String; ATooltip: String = ''): PsHyperlink; function AddHyperlink(ARow, ACol: Longint; ATarget: String;
procedure DeleteHyperlink(ARow, ACol: Cardinal); ATooltip: String = ''): PsHyperlink;
procedure DeleteHyperlink(ARow, ACol: Longint);
// enumerators
function GetEnumerator: TsHyperlinkEnumerator;
function GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Longint): TsHyperlinkEnumerator;
end; end;
{ TsMergedCells } { TsMergedCells }
@ -63,16 +167,17 @@ type
procedure DisposeData(var AData: Pointer); override; procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override; function NewData: Pointer; override;
public public
function AddRange(ARow1, ACol1, ARow2, ACol2: Cardinal): PsCellRange; function AddRange(ARow1, ACol1, ARow2, ACol2: Longint): PsCellRange;
procedure DeleteRange(ARow, ACol: Cardinal); procedure DeleteRange(ARow, ACol: Longint);
procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); override; procedure DeleteRowOrCol(AIndex: Longint; IsRow: Boolean); override;
function FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange; procedure Exchange(ARow1, ACol1, ARow2, ACol2: Longint); override;
function FindRangeWithCell(ARow, ACol: Longint): PsCellRange;
end; end;
implementation implementation
uses uses
fpspreadsheet; Math, fpsUtils;
function CompareRowCol(Item1, Item2: Pointer): Integer; function CompareRowCol(Item1, Item2: Pointer): Integer;
begin begin
@ -82,6 +187,103 @@ begin
end; end;
function TAVLTreeNodeStack.Pop: TAVLTreeNode;
begin
Result := TAVLTreeNode(Items[Count-1]);
Delete(Count-1);
end;
procedure TAVLTreeNodeStack.Push(ANode: TAVLTreeNode);
begin
Add(ANode);
end;
{******************************************************************************}
{ TsRowColEnumerator: A specialized enumerator for TsRowColAVLTree using the }
{ pointers to the data records. }
{******************************************************************************}
constructor TsRowColEnumerator.Create(ATree: TsRowColAVLTree;
AStartRow, AStartCol, AEndRow, AEndCol: LongInt; AReverse: Boolean);
begin
FTree := ATree;
FReverse := AReverse;
// Rearrange col/row indexes such that iteration always begins with "StartXXX"
if AStartRow <= AEndRow then
begin
FStartRow := IfThen(AReverse, AEndRow, AStartRow);
FEndRow := IfThen(AReverse, AStartRow, AEndRow);
end else
begin
FStartRow := IfThen(AReverse, AStartRow, AEndRow);
FEndRow := IfThen(AReverse, AEndRow, AStartRow);
end;
if AStartCol <= AEndCol then
begin
FStartCol := IfThen(AReverse, AEndCol, AStartCol);
FEndCol := IfThen(AReverse, AStartCol, AEndCol);
end else
begin
FStartCol := IfThen(AReverse, AStartCol, AEndCol);
FEndCol := IfThen(AReverse, AEndCol, AStartCol);
end;
end;
function TsRowColEnumerator.GetCurrent: PsRowCol;
begin
if Assigned(FCurrentNode) then
Result := PsRowCol(FCurrentNode.Data)
else
Result := nil;
end;
function TsRowColEnumerator.GetEnumerator: TsRowColEnumerator;
begin
Result := self;
end;
function TsRowColEnumerator.MoveNext: Boolean;
var
r1,c1,r2,c2: LongInt;
item: TsRowCol;
begin
if FCurrentNode <> nil then begin
if FReverse then
begin
FCurrentNode := FTree.FindPrecessor(FCurrentNode);
while (FCurrentNode <> nil) and
( (Current^.Col < FEndCol) or (Current^.Col > FStartCol) or
(Current^.Row < FEndRow) or (Current^.Row > FStartRow) )
do
FCurrentNode := FTree.FindPrecessor(FCurrentNode);
end else
begin
FCurrentNode := FTree.FindSuccessor(FCurrentNode);
while (FCurrentNode <> nil) and
( (Current^.Col < FStartCol) or (Current^.Col > FEndCol) or
(Current^.Row < FStartRow) or (Current^.Row > FEndRow) )
do
FCurrentNode := FTree.FindSuccessor(FCurrentNode);
end;
end else
begin
if FReverse and (FStartRow = $7FFFFFFF) and (FStartCol = $7FFFFFFF) then
FCurrentNode := FTree.FindHighest
else
if not FReverse and (FStartRow = 0) and (FStartCol = 0) then
FCurrentNode := FTree.FindLowest
else
begin
item.Row := FStartRow;
item.Col := FStartCol;
FCurrentNode := FTree.Find(@item);
end;
end;
Result := FCurrentNode <> nil;
end;
{******************************************************************************} {******************************************************************************}
{ TsRowColAVLTree: A specialized AVLTree working with records containing } { TsRowColAVLTree: A specialized AVLTree working with records containing }
{ row and column indexes. } { row and column indexes. }
@ -96,6 +298,7 @@ constructor TsRowColAVLTree.Create(AOwnsData: Boolean = true);
begin begin
inherited Create(@CompareRowCol); inherited Create(@CompareRowCol);
FOwnsData := AOwnsData; FOwnsData := AOwnsData;
FCurrentNodeStack := TAVLTreeNodeStack.Create;
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -104,6 +307,7 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
destructor TsRowColAVLTree.Destroy; destructor TsRowColAVLTree.Destroy;
begin begin
FCurrentNodeStack.Free;
Clear; Clear;
inherited; inherited;
end; end;
@ -112,11 +316,9 @@ end;
Adds a new node to the tree identified by the specified row and column Adds a new node to the tree identified by the specified row and column
indexes. indexes.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsRowColAVLTree.Add(ARow, ACol: Cardinal): PsRowCol; function TsRowColAVLTree.Add(ARow, ACol: LongInt): PsRowCol;
begin begin
Result := Find(ARow, ACol); Result := NewData;
if Result = nil then
Result := NewData;
Result^.Row := ARow; Result^.Row := ARow;
Result^.Col := ACol; Result^.Col := ACol;
inherited Add(Result); inherited Add(Result);
@ -149,6 +351,18 @@ begin
inherited Delete(ANode); inherited Delete(ANode);
end; end;
procedure TsRowColAVLTree.Delete(ARow, ACol: LongInt);
var
node: TAVLTreeNode;
cell: TCell;
begin
cell.Row := ARow;
cell.Col := ACol;
node := inherited Find(@cell);
if Assigned(node) then
Delete(node);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
This procedure adjusts row or column indexes stored in the tree nodes if a This procedure adjusts row or column indexes stored in the tree nodes if a
row or column will be deleted from the underlying worksheet. row or column will be deleted from the underlying worksheet.
@ -157,7 +371,7 @@ end;
to be deleted to be deleted
@param IsRow Identifies whether AIndex refers to a row or column index @param IsRow Identifies whether AIndex refers to a row or column index
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsRowColAVLTree.DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); procedure TsRowColAVLTree.DeleteRowOrCol(AIndex: LongInt; IsRow: Boolean);
var var
node, nextnode: TAVLTreeNode; node, nextnode: TAVLTreeNode;
item: PsRowCol; item: PsRowCol;
@ -189,12 +403,54 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Exchanges two nodes
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.Exchange(ARow1, ACol1, ARow2, ACol2: LongInt);
var
item1, item2: PsRowCol;
begin
item1 := Find(ARow1, ACol1);
item2 := Find(ARow2, ACol2);
// There are entries for both locations: Exchange row/col indexes
if (item1 <> nil) and (item2 <> nil) then
begin
Remove(item1);
Remove(item2);
item1^.Row := ARow2;
item1^.Col := ACol2;
item2^.Row := ARow1;
item2^.Col := ACol1;
inherited Add(item1);
inherited Add(item2);
end else
// Only the 1tst item exists --> give it the row/col indexes of the 2nd item
if (item1 <> nil) then
begin
Remove(item1);
item1^.Row := ARow2;
item1^.Col := ACol2;
inherited Add(item1);
end else
// Only the 2nd item exists --> give it the row/col indexes of the 1st item
if (item2 <> nil) then
begin
Remove(item2);
item2^.Row := ARow1;
item2^.Col := ACol1;
inherited Add(item2); // just adds the existing item at the new position
end;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Seeks the entire tree for a node of the specified row and column indexes and Seeks the entire tree for a node of the specified row and column indexes and
returns a pointer to the data record. returns a pointer to the data record.
Returns nil if such a node does not exist Returns nil if such a node does not exist
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsRowColAVLTree.Find(ARow, ACol: Cardinal): PsRowCol; function TsRowColAVLTree.Find(ARow, ACol: LongInt): PsRowCol;
var var
data: TsRowCol; data: TsRowCol;
node: TAVLTreeNode; node: TAVLTreeNode;
@ -210,6 +466,33 @@ begin
Result := PsRowCol(node.Data); Result := PsRowCol(node.Data);
end; end;
{@@ ----------------------------------------------------------------------------
Extracts the pointer to the data record from a tree node
-------------------------------------------------------------------------------}
function TsRowColAVLTree.GetData(ANode: TAVLTreeNode): PsRowCol;
begin
if ANode <> nil then
Result := PsRowCol(ANode.Data)
else
Result := nil;
end;
(*
function TsRowColAVLTree.GetEnumerator: TsRowColEnumerator;
begin
Result := TsRowColEnumerator.Create(self);
end;
function TsRowColAVLTree.GetColEnumerator(ACol: LongInt): TsRowColEnumerator;
begin
Result := TsRowColEnumerator.Create(self, -1, ACol, -1, ACol);
end;
function TsRowColAVLTree.GetRowEnumerator(ARow: LongInt): TsRowColEnumerator;
begin
Result := TsRowColEnumerator.Create(self, ARow, -1, ARow, -1);
end;
*)
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
The combination of the methods GetFirst and GetNext allow a fast iteration The combination of the methods GetFirst and GetNext allow a fast iteration
through all nodes of the tree. through all nodes of the tree.
@ -217,19 +500,27 @@ end;
function TsRowColAVLTree.GetFirst: PsRowCol; function TsRowColAVLTree.GetFirst: PsRowCol;
begin begin
FCurrentNode := FindLowest; FCurrentNode := FindLowest;
if FCurrentNode <> nil then Result := GetData(FCurrentNode);
Result := PsRowCol(FCurrentNode.Data) end;
else
Result := nil; function TsRowColAVLTree.GetLast: PsRowCol;
begin
FCurrentNode := FindHighest;
Result := GetData(FCurrentNode);
end; end;
function TsRowColAVLTree.GetNext: PsRowCol; function TsRowColAVLTree.GetNext: PsRowCol;
begin begin
FCurrentNode := FindSuccessor(FCurrentNode);
if FCurrentNode <> nil then if FCurrentNode <> nil then
Result := PsRowCol(FCurrentNode.Data) FCurrentNode := FindSuccessor(FCurrentNode);
else Result := GetData(FCurrentNode);
Result := nil; end;
function TsRowColAVLTree.GetPrev: PsRowCol;
begin
if FCurrentNode <> nil then
FCurrentNode := FindPrecessor(FCurrentNode);
Result := GetData(FCurrentNode);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -240,7 +531,7 @@ end;
to be inserted to be inserted
@param IsRow Identifies whether AIndex refers to a row or column index @param IsRow Identifies whether AIndex refers to a row or column index
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsRowColAVLTree.InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean); procedure TsRowColAVLTree.InsertRowOrCol(AIndex: LongInt; IsRow: Boolean);
var var
node: TAVLTreeNode; node: TAVLTreeNode;
item: PsRowCol; item: PsRowCol;
@ -260,10 +551,9 @@ begin
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Removes the node and destroys the associated data reocrd (if the tree has Removes the node, but does NOT destroy the associated data reocrd
been created with AOwnsData=true) for the specified row and column indexes.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsRowColAVLTree.Remove(ARow, ACol: Cardinal); procedure TsRowColAVLTree.Remove(ARow, ACol: LongInt);
var var
node: TAVLTreeNode; node: TAVLTreeNode;
item: TsRowCol; item: TsRowCol;
@ -271,12 +561,215 @@ begin
item.Row := ARow; item.Row := ARow;
item.Col := ACol; item.Col := ACol;
node := inherited Find(@item); node := inherited Find(@item);
Delete(node); Remove(node);
// Delete(node);
end;
procedure TsRowColAVLTree.PopCurrent;
begin
FCurrentNode := FCurrentNodeStack.Pop;
end;
procedure TsRowColAVLTree.PushCurrent;
begin
FCurrentNodeStack.Push(FCurrentNode);
end; end;
{******************************************************************************} {******************************************************************************}
{ TsComments: a AVLTree to store comment records for cells } { TsCellEnumerator: enumerator for the TsCells AVLTree }
{******************************************************************************}
function TsCellEnumerator.GetEnumerator: TsCellEnumerator;
begin
Result := self;
end;
function TsCellEnumerator.GetCurrent: PCell;
begin
Result := PCell(inherited GetCurrent);
end;
{******************************************************************************}
{ TsCells: an AVLTree to store spreadsheet cells }
{******************************************************************************}
constructor TsCells.Create(AWorksheet: Pointer; AOwnsData: Boolean = true);
begin
inherited Create(AOwnsData);
FWorksheet := AWorksheet;
end;
{@@ ----------------------------------------------------------------------------
Adds a node with a new TCell record to the tree.
Returns a pointer to the cell record.
NOTE: It must be checked first that there ia no other record at the same
col/row. (Check omitted for better performance).
-------------------------------------------------------------------------------}
function TsCells.AddCell(ARow, ACol: LongInt): PCell;
begin
Result := PCell(Add(ARow, ACol));
end;
{@@ ----------------------------------------------------------------------------
Deletes the node for the specified row and column index along with the
associated cell data record.
-------------------------------------------------------------------------------}
procedure TsCells.DeleteCell(ARow, ACol: LongInt);
begin
Delete(ARow, ACol);
end;
{@@ ----------------------------------------------------------------------------
Helper procedure which disposes the memory occupied by the cell data
record attached to a tree node.
-------------------------------------------------------------------------------}
procedure TsCells.DisposeData(var AData: Pointer);
begin
if AData <> nil then
Dispose(PCell(AData));
AData := nil;
end;
{@@ ----------------------------------------------------------------------------
Checks whether a specific cell already exists
-------------------------------------------------------------------------------}
function TsCells.FindCell(ARow, ACol: Longint): PCell;
begin
Result := PCell(Find(ARow, ACol));
end;
{@@ ----------------------------------------------------------------------------
Cell enumerators (use in "for ... in" syntax)
-------------------------------------------------------------------------------}
function TsCells.GetEnumerator: TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false);
end;
function TsCells.GetColEnumerator(ACol: LongInt; AStartRow: Longint = 0;
AEndRow: Longint = $7FFFFFFF): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self, AStartRow, ACol, AEndRow, ACol, false);
end;
function TsCells.GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Longint): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self,
AStartRow, AStartCol, AEndRow, AEndCol, false);
end;
function TsCells.GetRowEnumerator(ARow: LongInt; AStartCol: Longint = 0;
AEndCol: LongInt = $7FFFFFFF): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self,
ARow, AStartCol, ARow, AEndCol, false);
end;
function TsCells.GetReverseColEnumerator(ACol: LongInt; AStartRow: Longint = 0;
AEndRow: Longint = $7FFFFFFF): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self,
AStartRow, ACol, AEndRow, ACol, true);
end;
function TsCells.GetReverseEnumerator: TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, true);
end;
function TsCells.GetReverseRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Longint): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self,
AStartRow, AStartCol, AEndRow, AEndCol, true);
end;
function TsCells.GetReverseRowEnumerator(ARow: LongInt; AStartCol: Longint = 0;
AEndCol: LongInt = $7FFFFFFF): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self,
ARow, AStartCol, ARow, AEndCol, true);
end;
{@@ ----------------------------------------------------------------------------
Returns a pointer to the first cell of the tree.
Should always be followed by GetNextCell.
Use to iterate through all cells efficiently.
-------------------------------------------------------------------------------}
function TsCells.GetFirstCell: PCell;
begin
Result := PCell(GetFirst);
end;
{@@ ----------------------------------------------------------------------------
Returns a pointer to the last cell of the tree.
Needed for efficient iteration through all nodes in reverse direction by
calling GetPrev.
-------------------------------------------------------------------------------}
function TsCells.GetLastCell: PCell;
begin
Result := PCell(GetLast);
end;
{@@ ----------------------------------------------------------------------------
After beginning an iteration through all cells with GetFirstCell, the next
available cell can be found by calling GetNextCell.
Use to iterate througt all cells efficiently.
-------------------------------------------------------------------------------}
function TsCells.GetNextCell: PCell;
begin
Result := PCell(GetNext);
end;
{@@ ----------------------------------------------------------------------------
After beginning a reverse iteration through all cells with GetLastCell,
the next available cell can be found by calling GetPrevCell.
Use to iterate througt all cells efficiently in reverse order.
-------------------------------------------------------------------------------}
function TsCells.GetPrevCell: PCell;
begin
Result := PCell(GetPrev);
end;
{@@ ----------------------------------------------------------------------------
Alloates memory for a cell data record.
-------------------------------------------------------------------------------}
function TsCells.NewData: Pointer;
var
cell: PCell;
begin
New(cell);
InitCell(cell^);
cell^.Worksheet := FWorksheet;
Result := cell;
end;
{******************************************************************************}
{ TsCommentEnumerator: enumerator for the TsComments AVLTree }
{******************************************************************************}
function TsCommentEnumerator.GetEnumerator: TsCommentEnumerator;
begin
Result := self;
end;
function TsCommentEnumerator.GetCurrent: PsComment;
begin
Result := PsComment(inherited GetCurrent);
end;
{******************************************************************************}
{ TsComments: an AVLTree to store comment records for cells }
{******************************************************************************} {******************************************************************************}
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -287,7 +780,9 @@ end;
function TsComments.AddComment(ARow, ACol: Cardinal; function TsComments.AddComment(ARow, ACol: Cardinal;
AComment: String): PsComment; AComment: String): PsComment;
begin begin
Result := PsComment(Add(ARow, ACol)); Result := PsComment(Find(ARow, ACol));
if Result = nil then
Result := PsComment(Add(ARow, ACol));
Result^.Text := AComment; Result^.Text := AComment;
end; end;
@ -297,7 +792,7 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsComments.DeleteComment(ARow, ACol: Cardinal); procedure TsComments.DeleteComment(ARow, ACol: Cardinal);
begin begin
Remove(ARow, ACol); Delete(ARow, ACol);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -322,9 +817,38 @@ begin
Result := comment; Result := comment;
end; end;
{@@ ----------------------------------------------------------------------------
Comments enumerators (use in "for ... in" syntax)
-------------------------------------------------------------------------------}
function TsComments.GetEnumerator: TsCommentEnumerator;
begin
Result := TsCommentEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false);
end;
function TsComments.GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Longint): TsCommentEnumerator;
begin
Result := TsCommentEnumerator.Create(Self,
AStartRow, AStartCol, AEndRow, AEndCol, false);
end;
{******************************************************************************} {******************************************************************************}
{ TsHyperlinks: a AVLTree to store hyperlink records for cells } { TsHyperlinkEnumerator: enumerator for the TsHyperlinks AVLTree }
{******************************************************************************}
function TsHyperlinkEnumerator.GetEnumerator: TsHyperlinkEnumerator;
begin
Result := self;
end;
function TsHyperlinkEnumerator.GetCurrent: PsHyperlink;
begin
Result := PsHyperlink(inherited GetCurrent);
end;
{******************************************************************************}
{ TsHyperlinks: an AVLTree to store hyperlink records for cells }
{******************************************************************************} {******************************************************************************}
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -332,10 +856,12 @@ end;
exists then its data will be replaced by the specified ones. exists then its data will be replaced by the specified ones.
Returns a pointer to the hyperlink record. Returns a pointer to the hyperlink record.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsHyperlinks.AddHyperlink(ARow, ACol: Cardinal; ATarget: String; function TsHyperlinks.AddHyperlink(ARow, ACol: Longint; ATarget: String;
ATooltip: String = ''): PsHyperlink; ATooltip: String = ''): PsHyperlink;
begin begin
Result := PsHyperlink(Add(ARow, ACol)); Result := PsHyperlink(Find(ARow, ACol));
if Result = nil then
Result := PsHyperlink(Add(ARow, ACol));
Result^.Target := ATarget; Result^.Target := ATarget;
Result^.Tooltip := ATooltip; Result^.Tooltip := ATooltip;
end; end;
@ -344,9 +870,9 @@ end;
Deletes the node for the specified row and column index along with the Deletes the node for the specified row and column index along with the
associated hyperlink data record. associated hyperlink data record.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsHyperlinks.DeleteHyperlink(ARow, ACol: Cardinal); procedure TsHyperlinks.DeleteHyperlink(ARow, ACol: Longint);
begin begin
Remove(ARow, ACol); Delete(ARow, ACol);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -360,6 +886,21 @@ begin
AData := nil; AData := nil;
end; end;
{@@ ----------------------------------------------------------------------------
Hyperlink enumerators (use in "for ... in" syntax)
-------------------------------------------------------------------------------}
function TsHyperlinks.GetEnumerator: TsHyperlinkEnumerator;
begin
Result := TsHyperlinkEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false);
end;
function TsHyperlinks.GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Longint): TsHyperlinkEnumerator;
begin
Result := TsHyperlinkEnumerator.Create(Self,
AStartRow, AStartCol, AEndRow, AEndCol, false);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Alloates memory of a hyperlink data record. Alloates memory of a hyperlink data record.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
@ -381,9 +922,11 @@ end;
exists then its data will be replaced by the specified ones. exists then its data will be replaced by the specified ones.
Returns a pointer to the cell range record. Returns a pointer to the cell range record.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsMergedCells.AddRange(ARow1, ACol1, ARow2, ACol2: Cardinal): PsCellRange; function TsMergedCells.AddRange(ARow1, ACol1, ARow2, ACol2: Longint): PsCellRange;
begin begin
Result := PsCellRange(Add(ARow1, ACol1)); Result := PsCellRange(Find(ARow1, ACol1));
if Result = nil then
Result := PsCellRange(Add(ARow1, ACol1));
Result^.Row2 := ARow2; Result^.Row2 := ARow2;
Result^.Col2 := ACol2; Result^.Col2 := ACol2;
end; end;
@ -392,9 +935,9 @@ end;
Deletes the node for which the top/left corner of the cell range matches the Deletes the node for which the top/left corner of the cell range matches the
specified parameters. There is only a single range fulfilling this criterion. specified parameters. There is only a single range fulfilling this criterion.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsMergedCells.DeleteRange(ARow, ACol: Cardinal); procedure TsMergedCells.DeleteRange(ARow, ACol: Longint);
begin begin
Remove(ARow, ACol); Delete(ARow, ACol);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -405,7 +948,7 @@ end;
to be deleted to be deleted
@param IsRow Identifies whether AIndex refers to a row or column index @param IsRow Identifies whether AIndex refers to a row or column index
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsMergedCells.DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); procedure TsMergedCells.DeleteRowOrCol(AIndex: Longint; IsRow: Boolean);
var var
rng, nextrng: PsCellRange; rng, nextrng: PsCellRange;
begin begin
@ -465,11 +1008,41 @@ begin
AData := nil; AData := nil;
end; end;
procedure TsMergedCells.Exchange(ARow1, ACol1, ARow2, ACol2: Longint);
var
rng: PsCellrange;
dr, dc: LongInt;
begin
rng := PsCellrange(Find(ARow1, ACol1));
if rng <> nil then
begin
dr := rng^.Row2 - rng^.Row1;
dc := rng^.Col2 - rng^.Col1;
rng^.Row1 := ARow2;
rng^.Col1 := ACol2;
rng^.Row2 := ARow2 + dr;
rng^.Col2 := ACol2 + dc;
end;
rng := PsCellRange(Find(ARow2, ACol2));
if rng <> nil then
begin
dr := rng^.Row2 - rng^.Row1;
dc := rng^.Col2 - rng^.Col1;
rng^.Row1 := ARow1;
rng^.Col1 := ACol1;
rng^.Row2 := ARow1 + dr;
rng^.Col2 := ACol1 + dc;
end;
inherited Exchange(ARow1, ACol1, ARow2, ACol2);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Finds the cell range which contains the cell specified by its row and column Finds the cell range which contains the cell specified by its row and column
index index
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsMergedCells.FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange; function TsMergedCells.FindRangeWithCell(ARow, ACol: Longint): PsCellRange;
var var
node: TAVLTreeNode; node: TAVLTreeNode;
begin begin

2
components/fpspreadsheet/fpsfunc.pas
View File

@ -1284,7 +1284,7 @@ begin
exit; exit;
end; end;
if cell <> nil then if cell <> nil then
cellfmt := cell^.Worksheet.ReadCellFormat(cell) cellfmt := TsWorksheet(cell^.Worksheet).ReadCellFormat(cell)
else else
InitFormatRecord(cellfmt); InitFormatRecord(cellfmt);

496
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -32,43 +32,6 @@ type
TsBasicSpreadReader = class; TsBasicSpreadReader = class;
TsBasicSpreadWriter = class; TsBasicSpreadWriter = class;
{@@ Pointer to a TCell record }
PCell = ^TCell;
{@@ Cell structure for TsWorksheet
The cell record contains information on the location of the cell (row and
column index), on the value contained (number, date, text, ...), on
formatting, etc.
Never suppose that all *Value fields are valid,
only one of the ContentTypes is valid. For other fields
use TWorksheet.ReadAsUTF8Text and similar methods
@see ReadAsUTF8Text }
TCell = record
{ Location of the cell }
Worksheet: TsWorksheet;
Col: Cardinal; // zero-based
Row: Cardinal; // zero-based
{ Status flags }
Flags: TsCellFlags;
{ Index of format record in the workbook's FCellFormatList }
FormatIndex: Integer;
{ Special information }
SharedFormulaBase: PCell; // Cell containing the shared formula
{ Cell content }
UTF8StringValue: String; // Strings cannot be part of a variant record
FormulaValue: String;
case ContentType: TCellContentType of // variant part must be at the end
cctEmpty : (); // has no data at all
cctFormula : (); // FormulaValue is outside the variant record
cctNumber : (Numbervalue: Double);
cctUTF8String : (); // UTF8StringValue is outside the variant record
cctDateTime : (DateTimevalue: TDateTime);
cctBool : (BoolValue: boolean);
cctError : (ErrorValue: TsErrorValue);
end;
{@@ The record TRow contains information about a spreadsheet row: {@@ The record TRow contains information about a spreadsheet row:
@param Row The index of the row (beginning with 0) @param Row The index of the row (beginning with 0)
@param Height The height of the row (expressed as lines count of the default font) @param Height The height of the row (expressed as lines count of the default font)
@ -124,11 +87,10 @@ type
private private
FWorkbook: TsWorkbook; FWorkbook: TsWorkbook;
FName: String; // Name of the worksheet (displayed at the tab) FName: String; // Name of the worksheet (displayed at the tab)
FCells: TAvlTree; // Items are TCell FCells: TsCells;
FComments: TsComments; FComments: TsComments;
FMergedCells: TsMergedCells; FMergedCells: TsMergedCells;
FHyperlinks: TsHyperlinks; FHyperlinks: TsHyperlinks;
FCurrentNode: TAVLTreeNode; // for GetFirstCell and GetNextCell
FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from default FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from default
FActiveCellRow: Cardinal; FActiveCellRow: Cardinal;
FActiveCellCol: Cardinal; FActiveCellCol: Cardinal;
@ -153,17 +115,13 @@ type
procedure SetName(const AName: String); procedure SetName(const AName: String);
{ Callback procedures called when iterating through all cells } { Callback procedures called when iterating through all cells }
procedure CalcFormulaCallback(data, arg: Pointer);
procedure CalcStateCallback(data, arg: Pointer);
procedure DeleteColCallback(data, arg: Pointer); procedure DeleteColCallback(data, arg: Pointer);
procedure DeleteRowCallback(data, arg: Pointer); procedure DeleteRowCallback(data, arg: Pointer);
procedure InsertColCallback(data, arg: Pointer); procedure InsertColCallback(data, arg: Pointer);
procedure InsertRowCallback(data, arg: Pointer); procedure InsertRowCallback(data, arg: Pointer);
procedure RemoveCellsCallback(data, arg: pointer);
protected protected
function CellUsedInFormula(ARow, ACol: Cardinal): Boolean; function CellUsedInFormula(ARow, ACol: Cardinal): Boolean;
procedure RemoveAllAVLTreeNodes(ATree: TAvlTree; ARemoveCallback: TsCallback);
// Remove and delete cells // Remove and delete cells
function RemoveCell(ARow, ACol: Cardinal): PCell; function RemoveCell(ARow, ACol: Cardinal): PCell;
@ -176,6 +134,7 @@ type
ASortOptions: TsSortOptions): Integer; ASortOptions: TsSortOptions): Integer;
procedure DoExchangeColRow(AIsColumn: Boolean; AIndex, WithIndex: Cardinal; procedure DoExchangeColRow(AIsColumn: Boolean; AIndex, WithIndex: Cardinal;
AFromIndex, AToIndex: Cardinal); AFromIndex, AToIndex: Cardinal);
procedure ExchangeCells(ARow1, ACol1, ARow2, ACol2: Cardinal);
public public
{ Base methods } { Base methods }
@ -185,7 +144,7 @@ type
{ Utils } { Utils }
class function CellInRange(ARow, ACol: Cardinal; ARange: TsCellRange): Boolean; class function CellInRange(ARow, ACol: Cardinal; ARange: TsCellRange): Boolean;
class function CellPosToText(ARow, ACol: Cardinal): string; class function CellPosToText(ARow, ACol: Cardinal): string;
procedure RemoveAllCells; // procedure RemoveAllCells;
procedure UpdateCaches; procedure UpdateCaches;
{ Reading of values } { Reading of values }
@ -397,16 +356,12 @@ type
procedure DeleteCell(ACell: PCell); procedure DeleteCell(ACell: PCell);
procedure EraseCell(ACell: PCell); procedure EraseCell(ACell: PCell);
procedure ExchangeCells(ARow1, ACol1, ARow2, ACol2: Cardinal);
function FindCell(ARow, ACol: Cardinal): PCell; overload; function FindCell(ARow, ACol: Cardinal): PCell; overload;
function FindCell(AddressStr: String): PCell; overload; function FindCell(AddressStr: String): PCell; overload;
function GetCell(ARow, ACol: Cardinal): PCell; overload; function GetCell(ARow, ACol: Cardinal): PCell; overload;
function GetCell(AddressStr: String): PCell; overload; function GetCell(AddressStr: String): PCell; overload;
function GetCellCount: Cardinal; function GetCellCount: Cardinal;
function GetFirstCell(): PCell;
function GetNextCell(): PCell;
function GetFirstCellOfRow(ARow: Cardinal): PCell; function GetFirstCellOfRow(ARow: Cardinal): PCell;
function GetLastCellOfRow(ARow: Cardinal): PCell; function GetLastCellOfRow(ARow: Cardinal): PCell;
@ -494,7 +449,7 @@ type
{@@ List of cells of the worksheet. Only cells with contents or with formatting {@@ List of cells of the worksheet. Only cells with contents or with formatting
are listed } are listed }
property Cells: TAVLTree read FCells; property Cells: TsCells read FCells;
{@@ List of all column records of the worksheet having a non-standard column width } {@@ List of all column records of the worksheet having a non-standard column width }
property Cols: TIndexedAVLTree read FCols; property Cols: TIndexedAVLTree read FCols;
{@@ List of all comment records } {@@ List of all comment records }
@ -828,9 +783,6 @@ procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
//function SameCellBorders(ACell1, ACell2: PCell): Boolean; overload; //function SameCellBorders(ACell1, ACell2: PCell): Boolean; overload;
function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean; //overload; function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean; //overload;
procedure InitCell(out ACell: TCell); overload;
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); overload;
function HasFormula(ACell: PCell): Boolean; function HasFormula(ACell: PCell): Boolean;
{ For debugging purposes } { For debugging purposes }
@ -841,7 +793,7 @@ implementation
uses uses
Math, StrUtils, TypInfo, lazutf8, URIParser, Math, StrUtils, TypInfo, lazutf8, URIParser,
fpsPatches, fpsStrings, fpsStreams, uvirtuallayer_ole, fpsPatches, fpsStrings, uvirtuallayer_ole,
fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser, fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser,
fpsNumFormat, fpsNumFormatParser; fpsNumFormat, fpsNumFormatParser;
@ -1026,32 +978,6 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Initalizes a new cell.
@return New cell record
-------------------------------------------------------------------------------}
procedure InitCell(out ACell: TCell);
begin
ACell.FormulaValue := '';
ACell.UTF8StringValue := '';
FillChar(ACell, SizeOf(ACell), 0);
end;
{@@ ----------------------------------------------------------------------------
Initalizes a new cell and presets the row and column fields of the cell record
to the parameters passed to the procedure.
@param ARow Row index of the new cell
@param ACol Column index of the new cell
@return New cell record with row and column fields preset to passed values.
-------------------------------------------------------------------------------}
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell);
begin
InitCell(ACell);
ACell.Row := ARow;
ACell.Col := ACol;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Returns TRUE if the cell contains a formula (direct or shared, does not matter). Returns TRUE if the cell contains a formula (direct or shared, does not matter).
@ -1135,7 +1061,7 @@ constructor TsWorksheet.Create;
begin begin
inherited Create; inherited Create;
FCells := TAVLTree.Create(@CompareCells); FCells := TsCells.Create(self);
FRows := TIndexedAVLTree.Create(@CompareRows); FRows := TIndexedAVLTree.Create(@CompareRows);
FCols := TIndexedAVLTree.Create(@CompareCols); FCols := TIndexedAVLTree.Create(@CompareCols);
FComments := TsComments.Create; FComments := TsComments.Create;
@ -1164,7 +1090,7 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
destructor TsWorksheet.Destroy; destructor TsWorksheet.Destroy;
begin begin
RemoveAllCells; // RemoveAllCells;
RemoveAllRows; RemoveAllRows;
RemoveAllCols; RemoveAllCols;
@ -1207,24 +1133,6 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Helper method for calculation of the formulas in a spreadsheet.
-------------------------------------------------------------------------------}
procedure TsWorksheet.CalcFormulaCallback(data, arg: pointer);
var
cell: PCell;
begin
Unused(arg);
cell := PCell(data);
// Empty cell or error cell --> nothing to do
if (cell = nil) or (cell^.ContentType = cctError) then
exit;
if HasFormula(cell) or HasFormula(cell^.SharedFormulaBase) then
CalcFormula(cell);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Calculates the formula in a cell Calculates the formula in a cell
Should not be called by itself because the result may depend on other cells Should not be called by itself because the result may depend on other cells
@ -1253,6 +1161,7 @@ begin
formula := ACell^.SharedFormulaBase^.FormulaValue; formula := ACell^.SharedFormulaBase^.FormulaValue;
parser.ActiveCell := ACell; parser.ActiveCell := ACell;
end; end;
try try
parser.Expression := formula; parser.Expression := formula;
res := parser.Evaluate; res := parser.Evaluate;
@ -1263,6 +1172,7 @@ begin
Res := ErrorResult(errIllegalRef); Res := ErrorResult(errIllegalRef);
end; end;
end; end;
case res.ResultType of case res.ResultType of
rtEmpty : WriteBlank(ACell); rtEmpty : WriteBlank(ACell);
rtError : WriteErrorValue(ACell, res.ResError); rtError : WriteErrorValue(ACell, res.ResError);
@ -1307,6 +1217,7 @@ end;
procedure TsWorksheet.CalcFormulas; procedure TsWorksheet.CalcFormulas;
var var
node: TAVLTreeNode; node: TAVLTreeNode;
cell: PCell;
begin begin
// prevent infinite loop due to triggering of formula calculation whenever // prevent infinite loop due to triggering of formula calculation whenever
// a cell changes during execution of CalcFormulas. // a cell changes during execution of CalcFormulas.
@ -1315,36 +1226,29 @@ begin
// Step 1 - mark all formula cells as "not calculated" // Step 1 - mark all formula cells as "not calculated"
node := FCells.FindLowest; node := FCells.FindLowest;
while Assigned(node) do begin while Assigned(node) do begin
CalcStateCallback(node.Data, nil); cell := PCell(node.Data);
if HasFormula(cell) then
SetCalcState(cell, csNotCalculated);
node := FCells.FindSuccessor(node); node := FCells.FindSuccessor(node);
end; end;
// Step 2 - calculate cells. If a not-yet-calculated cell is found it is // Step 2 - calculate cells. If a not-yet-calculated cell is found it is
// calculated and then marked as such. // calculated and then marked as such.
node := FCells.FindLowest; node := FCells.FindLowest;
while Assigned(Node) do begin while Assigned(node) do begin
CalcFormulaCallback(Node.Data, nil); cell := PCell(node.Data);
if (cell^.ContentType <> cctError) and
(HasFormula(cell) or HasFormula(cell^.SharedFormulaBase))
then
CalcFormula(cell);
node := FCells.FindSuccessor(node); node := FCells.FindSuccessor(node);
end; end;
finally finally
dec(FWorkbook.FCalculationLock); dec(FWorkbook.FCalculationLock);
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Helper method marking all cells with formulas as "not calculated". This flag
is needed for recursive calculation of the entire worksheet.
-------------------------------------------------------------------------------}
procedure TsWorksheet.CalcStateCallback(data, arg: Pointer);
var
cell: PCell;
begin
Unused(arg);
cell := PCell(data);
if HasFormula(cell) then
SetCalcState(cell, csNotCalculated);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Checks whether a cell given by its row and column indexes belongs to a Checks whether a cell given by its row and column indexes belongs to a
specified rectangular cell range. specified rectangular cell range.
@ -1376,37 +1280,40 @@ end;
function TsWorksheet.CellUsedInFormula(ARow, ACol: Cardinal): Boolean; function TsWorksheet.CellUsedInFormula(ARow, ACol: Cardinal): Boolean;
var var
cell: PCell; cell: PCell;
cellNode: TAVLTreeNode;
fe: TsFormulaElement; fe: TsFormulaElement;
i: Integer; i: Integer;
rpnFormula: TsRPNFormula; rpnFormula: TsRPNFormula;
begin begin
cellNode := FCells.FindLowest; FCells.PushCurrent;
while Assigned(cellNode) do begin try
cell := PCell(cellNode.Data); cell := FCells.GetFirstCell;
if HasFormula(cell) then begin while Assigned(cell) do begin
rpnFormula := BuildRPNFormula(cell); if HasFormula(cell) then begin
for i := 0 to Length(rpnFormula)-1 do rpnFormula := BuildRPNFormula(cell);
begin for i := 0 to Length(rpnFormula)-1 do
fe := rpnFormula[i]; begin
case fe.ElementKind of fe := rpnFormula[i];
fekCell, fekCellRef: case fe.ElementKind of
if (fe.Row = ARow) and (fe.Col = ACol) then fekCell, fekCellRef:
begin if (fe.Row = ARow) and (fe.Col = ACol) then
Result := true; begin
exit; Result := true;
end; exit;
fekCellRange: end;
if (fe.Row <= ARow) and (ARow <= fe.Row2) and fekCellRange:
(fe.Col <= ACol) and (ACol <= fe.Col2) then if (fe.Row <= ARow) and (ARow <= fe.Row2) and
begin (fe.Col <= ACol) and (ACol <= fe.Col2) then
Result := true; begin
exit; Result := true;
end; exit;
end;
end;
end; end;
end; end;
cell := FCells.GetNextCell;
end; end;
cellNode := FCells.FindSuccessor(cellNode); finally
FCells.PopCurrent;
end; end;
SetLength(rpnFormula, 0); SetLength(rpnFormula, 0);
end; end;
@ -1489,9 +1396,6 @@ end;
@param AText Comment text @param AText Comment text
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.WriteComment(ACell: PCell; AText: String); procedure TsWorksheet.WriteComment(ACell: PCell; AText: String);
var
comment: PsComment;
addNew: Boolean;
begin begin
if ACell = nil then if ACell = nil then
exit; exit;
@ -1504,7 +1408,7 @@ begin
end; end;
// Add new comment record // Add new comment record
comment := FComments.AddComment(ACell^.Row, ACell^.Col, AText); FComments.AddComment(ACell^.Row, ACell^.Col, AText);
Include(ACell^.Flags, cfHasComment); Include(ACell^.Flags, cfHasComment);
ChangedCell(ACell^.Row, ACell^.Col); ChangedCell(ACell^.Row, ACell^.Col);
@ -1728,7 +1632,7 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.CopyCell(AFromCell, AToCell: PCell); procedure TsWorksheet.CopyCell(AFromCell, AToCell: PCell);
var var
toRow, toCol: Cardinal; toRow, toCol: LongInt;
row1, col1, row2, col2: Cardinal; row1, col1, row2, col2: Cardinal;
hyperlink: PsHyperlink; hyperlink: PsHyperlink;
begin begin
@ -2071,31 +1975,19 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Exchanges two cells Exchanges two cells
@param ARow1 Row index of the first cell @param ARow1 Row index of the first cell
@param ACol1 Column index of the first cell @param ACol1 Column index of the first cell
@param ARow2 Row index of the second cell @param ARow2 Row index of the second cell
@param ACol2 Column index of the second cell @param ACol2 Column index of the second cell
@note This method does not take care of merged cells and does not
check for this situation. Therefore, the method is not public!
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.ExchangeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); procedure TsWorksheet.ExchangeCells(ARow1, ACol1, ARow2, ACol2: Cardinal);
var
cell1, cell2: PCell;
begin begin
cell1 := RemoveCell(ARow1, ACol1); FCells.Exchange(ARow1, ACol1, ARow2, ACol2);
cell2 := RemoveCell(ARow2, ACol2); FComments.Exchange(ARow1, ACol1, ARow2, ACol2);
if cell1 <> nil then FHyperlinks.Exchange(ARow1, ACol1, ARow2, ACol2);
begin
cell1^.Row := ARow2;
cell1^.Col := ACol2;
FCells.Add(cell1);
ChangedCell(ARow2, ACol2);
end;
if cell2 <> nil then
begin
cell2^.Row := ARow1;
cell2^.Col := ACol1;
FCells.Add(cell2);
ChangedCell(ARow1, ACol1);
end;
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -2107,19 +1999,8 @@ end;
@see TCell @see TCell
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.FindCell(ARow, ACol: Cardinal): PCell; function TsWorksheet.FindCell(ARow, ACol: Cardinal): PCell;
var
LCell: TCell;
AVLNode: TAVLTreeNode;
begin begin
Result := nil; Result := PCell(FCells.Find(ARow, ACol));
if FCells.Count = 0 then
exit;
LCell.Row := ARow;
LCell.Col := ACol;
AVLNode := FCells.Find(@LCell);
if Assigned(AVLNode) then
result := PCell(AVLNode.Data);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -2156,15 +2037,10 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.GetCell(ARow, ACol: Cardinal): PCell; function TsWorksheet.GetCell(ARow, ACol: Cardinal): PCell;
begin begin
Result := FindCell(ARow, ACol); Result := Cells.FindCell(ARow, ACol);
if Result = nil then
if (Result = nil) then
begin begin
New(Result); Result := Cells.AddCell(ARow, ACol);
InitCell(ARow, ACol, Result^);
Result^.Worksheet := self;
Cells.Add(Result);
if FFirstColIndex = $FFFFFFFF then FFirstColIndex := GetFirstColIndex(true) if FFirstColIndex = $FFFFFFFF then FFirstColIndex := GetFirstColIndex(true)
else FFirstColIndex := Min(FFirstColIndex, ACol); else FFirstColIndex := Min(FFirstColIndex, ACol);
if FFirstRowIndex = $FFFFFFFF then FFirstRowIndex := GetFirstRowIndex(true) if FFirstRowIndex = $FFFFFFFF then FFirstRowIndex := GetFirstRowIndex(true)
@ -2203,14 +2079,7 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Returns the number of cells in the worksheet with contents. Returns the number of cells in the worksheet with contents.
This routine is used together with GetFirstCell and GetNextCell
to iterate througth all cells in a worksheet efficiently.
@return The number of cells with contents in the worksheet @return The number of cells with contents in the worksheet
@see TCell
@see GetFirstCell
@see GetNextCell
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.GetCellCount: Cardinal; function TsWorksheet.GetCellCount: Cardinal;
begin begin
@ -2294,49 +2163,6 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Returns the first cell.
Use together with GetCellCount and GetNextCell
to iterate througth all cells in a worksheet efficiently.
@return The first cell if any exists, nil otherwise
@see TCell
@see GetCellCount
@see GetNextCell
-------------------------------------------------------------------------------}
function TsWorksheet.GetFirstCell(): PCell;
begin
FCurrentNode := FCells.FindLowest();
if FCurrentNode <> nil then
Result := PCell(FCurrentNode.Data)
else Result := nil;
end;
{@@ ----------------------------------------------------------------------------
Returns the next cell.
Should always be used either after GetFirstCell or
after GetNextCell.
Use together with GetCellCount and GetFirstCell
to iterate througth all cells in a worksheet efficiently.
@return The first cell if any exists, nil otherwise
@see TCell
@see GetCellCount
@see GetFirstCell
-------------------------------------------------------------------------------}
function TsWorksheet.GetNextCell(): PCell;
begin
FCurrentNode := FCells.FindSuccessor(FCurrentNode);
if FCurrentNode <> nil then
Result := PCell(FCurrentNode.Data)
else Result := nil;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Returns the 0-based index of the first column with a cell with contents. Returns the 0-based index of the first column with a cell with contents.
@ -2353,20 +2179,30 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal; function TsWorksheet.GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal;
var var
AVLNode: TAVLTreeNode; cell: PCell;
i: Integer; i: Integer;
begin begin
if AForceCalculation then if AForceCalculation then
begin begin
Result := $FFFFFFFF; Result := $FFFFFFFF;
for cell in FCells do
Result := Math.Min(Result, cell^.Col);
(*
// Traverse the tree from lowest to highest. // Traverse the tree from lowest to highest.
// Since tree primary sort order is on row lowest col could exist anywhere. // Since tree primary sort order is on row lowest col could exist anywhere.
AVLNode := FCells.FindLowest; FCells.PushCurrent;
while Assigned(AVLNode) do try
begin cell := FCells.GetFirstCell;
Result := Math.Min(Result, PCell(AVLNode.Data)^.Col); while Assigned(cell) do
AVLNode := FCells.FindSuccessor(AVLNode); begin
Result := Math.Min(Result, cell^.Col);
cell := FCells.GetNextCell;
end;
finally
FCells.PopCurrent;
end; end;
*)
// In addition, there may be column records defining the column width even // In addition, there may be column records defining the column width even
// without content // without content
for i:=0 to FCols.Count-1 do for i:=0 to FCols.Count-1 do
@ -2444,17 +2280,26 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.GetLastOccupiedColIndex: Cardinal; function TsWorksheet.GetLastOccupiedColIndex: Cardinal;
var var
AVLNode: TAVLTreeNode; cell: PCell;
begin begin
Result := 0; Result := 0;
// Traverse the tree from lowest to highest. // Traverse the tree from lowest to highest.
// Since tree's primary sort order is on row, highest col could exist anywhere. // Since tree's primary sort order is on row, highest col could exist anywhere.
AVLNode := FCells.FindLowest; for cell in FCells do
while Assigned(AVLNode) do Result := Math.Max(Result, cell^.Col);
begin {
Result := Math.Max(Result, PCell(AVLNode.Data)^.Col); FCells.PushCurrent;
AVLNode := FCells.FindSuccessor(AVLNode); try
cell := FCells.GetFirstCell;
while Assigned(cell) do
begin
Result := Math.Max(Result, cell^.Col);
cell := FCells.GetNextCell;
end;
finally
FCells.PopCurrent;
end; end;
}
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -2509,15 +2354,20 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.GetFirstRowIndex(AForceCalculation: Boolean = false): Cardinal; function TsWorksheet.GetFirstRowIndex(AForceCalculation: Boolean = false): Cardinal;
var var
AVLNode: TAVLTreeNode; cell: PCell;
i: Integer; i: Integer;
begin begin
if AForceCalculation then if AForceCalculation then
begin begin
Result := $FFFFFFFF; Result := $FFFFFFFF;
AVLNode := FCells.FindLowest; FCells.PushCurrent;
if Assigned(AVLNode) then try
Result := PCell(AVLNode.Data).Row; cell := FCells.GetFirstCell;
finally
FCells.PopCurrent;
end;
if Assigned(cell) then
Result := cell^.Row;
// In addition, there may be row records even for rows without cells. // In addition, there may be row records even for rows without cells.
for i:=0 to FRows.Count-1 do for i:=0 to FRows.Count-1 do
if FRows[i] <> nil then if FRows[i] <> nil then
@ -2579,12 +2429,12 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.GetLastOccupiedRowIndex: Cardinal; function TsWorksheet.GetLastOccupiedRowIndex: Cardinal;
var var
AVLNode: TAVLTreeNode; cell: PCell;
begin begin
Result := 0; Result := 0;
AVLNode := FCells.FindHighest; cell := FCells.GetLastCell;
if Assigned(AVLNode) then if Assigned(cell) then
Result := PCell(AVLNode.Data).Row; Result := cell^.Row;
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -3360,7 +3210,6 @@ begin
UnmergeCells(rng.Row1, rng.Col1); UnmergeCells(rng.Row1, rng.Col1);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Finds the upper left cell of a shared formula block to which the specified Finds the upper left cell of a shared formula block to which the specified
cell belongs. This is the "shared formula base". cell belongs. This is the "shared formula base".
@ -3529,23 +3378,6 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Helper method for clearing the cell records in a spreadsheet.
-------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveCellsCallback(data, arg: pointer);
begin
Unused(arg);
Dispose(PCell(data));
end;
{@@ ----------------------------------------------------------------------------
Clears the list of cells and releases their memory.
-------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveAllCells;
begin
RemoveAllAvlTreeNodes(FCells, RemoveCellsCallback);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Removes the comment from a cell and releases the memory occupied by the node. Removes the comment from a cell and releases the memory occupied by the node.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
@ -3558,23 +3390,6 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Clears the AVLTree specified and releases the memory occupied by the nodes
-------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveAllAVLTreeNodes(ATree: TAvlTree;
ARemoveCallback: TsCallback);
var
node: TAvlTreeNode;
begin
node := ATree.FindLowest;
while Assigned(node) do begin
ARemoveCallback(node.Data, nil);
node.Data := nil;
node := ATree.FindSuccessor(node);
end;
ATree.Clear;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Removes a cell from its tree container. DOES NOT RELEASE ITS MEMORY! Removes a cell from its tree container. DOES NOT RELEASE ITS MEMORY!
@ -3584,7 +3399,7 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.RemoveCell(ARow, ACol: Cardinal): PCell; function TsWorksheet.RemoveCell(ARow, ACol: Cardinal): PCell;
begin begin
Result := FindCell(ARow, ACol); Result := PCell(FCells.Find(ARow, ACol));
if Result <> nil then FCells.Remove(Result); if Result <> nil then FCells.Remove(Result);
end; end;
@ -3600,18 +3415,8 @@ end;
@param ACol Column index of the cell to be removed @param ACol Column index of the cell to be removed
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveAndFreeCell(ARow, ACol: Cardinal); procedure TsWorksheet.RemoveAndFreeCell(ARow, ACol: Cardinal);
var
cellnode: TAVLTreeNode;
cell: TCell;
begin begin
// Delete the cell FCells.DeleteCell(ARow, ACol);
cell.Row := ARow;
cell.Col := ACol;
cellnode := FCells.Find(@cell);
if cellnode <> nil then begin
Dispose(PCell(cellnode.Data));
FCells.Delete(cellnode);
end;
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -3871,7 +3676,25 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
until I >= R; until I >= R;
end; end;
function ContainsMergedCells: boolean;
var
r,c: Cardinal;
cell: PCell;
begin
result := false;
for r := ARowFrom to ARowTo do
for c := AColFrom to AColTo do
begin
cell := FindCell(r, c);
if IsMerged(cell) then
exit(true);
end;
end;
begin begin
if ContainsMergedCells then
raise Exception.Create(rsCannotSortMerged);
FSortParams := ASortParams; FSortParams := ASortParams;
if ASortParams.SortByCols then if ASortParams.SortByCols then
QuickSort(ARowFrom, ARowTo) QuickSort(ARowFrom, ARowTo)
@ -6117,13 +5940,11 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.DeleteCol(ACol: Cardinal); procedure TsWorksheet.DeleteCol(ACol: Cardinal);
var var
AVLNode: TAVLTreeNode;
col: PCol; col: PCol;
i: Integer; i: Integer;
r, rr, cc: Cardinal; r, rr, cc: Cardinal;
cell, basecell, nextcell: PCell; cell, basecell, nextcell: PCell;
firstRow, lastCol, lastRow: Cardinal; firstRow, lastCol, lastRow: Cardinal;
rng: PsCellRange;
begin begin
lastCol := GetLastColIndex; lastCol := GetLastColIndex;
lastRow := GetLastOccupiedRowIndex; lastRow := GetLastOccupiedRowIndex;
@ -6172,10 +5993,15 @@ begin
RemoveAndFreeCell(r, ACol); RemoveAndFreeCell(r, ACol);
// Update column index of cell records // Update column index of cell records
AVLNode := FCells.FindLowest; FCells.PushCurrent;
while Assigned(AVLNode) do begin try
DeleteColCallback(AVLNode.Data, {%H-}pointer(PtrInt(ACol))); cell := FCells.GetFirstCell;
AVLNode := FCells.FindSuccessor(AVLNode); while Assigned(cell) do begin
DeleteColCallback(cell, {%H-}pointer(PtrInt(ACol)));
cell := FCells.GetNextCell;
end;
finally
FCells.PopCurrent;
end; end;
// Update column index of col records // Update column index of col records
@ -6202,13 +6028,11 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.DeleteRow(ARow: Cardinal); procedure TsWorksheet.DeleteRow(ARow: Cardinal);
var var
AVLNode: TAVLTreeNode;
row: PRow; row: PRow;
i: Integer; i: Integer;
c, rr, cc: Cardinal; c, rr, cc: Cardinal;
firstCol, lastCol, lastRow: Cardinal; firstCol, lastCol, lastRow: Cardinal;
cell, nextcell, basecell: PCell; cell, nextcell, basecell: PCell;
rng: PsCellRange;
begin begin
firstCol := GetFirstColIndex; firstCol := GetFirstColIndex;
lastCol := GetLastOccupiedColIndex; lastCol := GetLastOccupiedColIndex;
@ -6256,10 +6080,10 @@ begin
RemoveAndFreeCell(ARow, c); RemoveAndFreeCell(ARow, c);
// Update row index of cell records // Update row index of cell records
AVLNode := FCells.FindLowest; cell := FCells.GetFirstCell;
while Assigned(AVLNode) do begin while Assigned(cell) do begin
DeleteRowCallback(AVLNode.Data, {%H-}pointer(PtrInt(ARow))); DeleteRowCallback(cell, {%H-}pointer(PtrInt(ARow)));
AVLNode := FCells.FindSuccessor(AVLNode); cell := FCells.GetNextCell;
end; end;
// Update row index of row records // Update row index of row records
@ -6291,16 +6115,14 @@ var
i: Integer; i: Integer;
r: Cardinal; r: Cardinal;
cell: PCell; cell: PCell;
AVLNode: TAVLTreeNode;
rng: PsCellRange; rng: PsCellRange;
begin begin
// Handling of shared formula references is too complicated for me... // Handling of shared formula references is too complicated for me...
// Split them into isolated cell formulas // Split them into isolated cell formulas
AVLNode := FCells.FindLowest; cell := FCells.GetFirstCell;
while Assigned(AVLNode) do begin while Assigned(cell) do begin
cell := PCell(AVLNode.Data);
SplitSharedFormula(cell); SplitSharedFormula(cell);
AVLNode := FCells.FindSuccessor(AVLNode); cell := FCells.GetNextCell;
end; end;
// Update column index of comments // Update column index of comments
@ -6310,10 +6132,10 @@ begin
FHyperlinks.InsertRowOrCol(ACol, false); FHyperlinks.InsertRowOrCol(ACol, false);
// Update column index of cell records // Update column index of cell records
AVLNode := FCells.FindLowest; cell := FCells.GetFirstCell;
while Assigned(AVLNode) do begin while Assigned(cell) do begin
InsertColCallback(AVLNode.Data, {%H-}pointer(PtrInt(ACol))); InsertColCallback(cell, {%H-}pointer(PtrInt(ACol)));
AVLNode := FCells.FindSuccessor(AVLNode); cell := FCells.GetNextCell;
end; end;
// Update column index of column records // Update column index of column records
@ -6416,16 +6238,14 @@ var
i: Integer; i: Integer;
c: Cardinal; c: Cardinal;
cell: PCell; cell: PCell;
AVLNode: TAVLTreeNode;
rng: PsCellRange; rng: PsCellRange;
begin begin
// Handling of shared formula references is too complicated for me... // Handling of shared formula references is too complicated for me...
// Splits them into isolated cell formulas // Splits them into isolated cell formulas
AVLNode := FCells.FindLowest; cell := FCells.GetFirstCell;
while Assigned(AVLNode) do begin while Assigned(cell) do begin
cell := PCell(AVLNode.Data);
SplitSharedFormula(cell); SplitSharedFormula(cell);
AVLNode := FCells.FindSuccessor(AVLNode); cell := FCells.GetNextCell;
end; end;
// Update row index of cell comments // Update row index of cell comments
@ -6435,10 +6255,10 @@ begin
FHyperlinks.InsertRowOrCol(ARow, true); FHyperlinks.InsertRowOrCol(ARow, true);
// Update row index of cell records // Update row index of cell records
AVLNode := FCells.FindLowest; cell := FCells.GetFirstCell;
while Assigned(AVLNode) do begin while Assigned(cell) do begin
InsertRowCallback(AVLNode.Data, {%H-}pointer(PtrInt(ARow))); InsertRowCallback(cell, {%H-}pointer(PtrInt(ARow)));
AVLNode := FCells.FindSuccessor(AVLNode); cell := FCells.GetNextCell;
end; end;
// Update row index of row records // Update row index of row records
@ -8249,7 +8069,6 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorkbook.UsesColor(AColorIndex: TsColor): Boolean; function TsWorkbook.UsesColor(AColorIndex: TsColor): Boolean;
var var
Node: TAVLTreeNode;
sheet: TsWorksheet; sheet: TsWorksheet;
cell: PCell; cell: PCell;
i: Integer; i: Integer;
@ -8261,10 +8080,9 @@ begin
for i:=0 to GetWorksheetCount-1 do for i:=0 to GetWorksheetCount-1 do
begin begin
sheet := GetWorksheetByIndex(i); sheet := GetWorksheetByIndex(i);
Node := sheet.Cells.FindLowest; cell := sheet.Cells.GetFirstCell;
while Assigned(Node) do while Assigned(cell) do
begin begin
cell := PCell(Node.Data);
fmt := GetPointerToCellFormat(cell^.FormatIndex); fmt := GetPointerToCellFormat(cell^.FormatIndex);
if (uffBackground in fmt^.UsedFormattingFields) then if (uffBackground in fmt^.UsedFormattingFields) then
begin begin
@ -8281,7 +8099,7 @@ begin
if fnt.Color = AColorIndex then if fnt.Color = AColorIndex then
exit; exit;
end; end;
Node := sheet.Cells.FindSuccessor(Node); cell := sheet.Cells.GetNextCell;
end; end;
end; end;
Result := false; Result := false;

5
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -1495,8 +1495,7 @@ begin
if Worksheet = nil then if Worksheet = nil then
exit; exit;
cell := Worksheet.GetFirstCell; for cell in Worksheet.Cells do
while cell <> nil do
begin begin
if (uffBorder in Worksheet.ReadUsedFormatting(cell)) then if (uffBorder in Worksheet.ReadUsedFormatting(cell)) then
begin begin
@ -1505,7 +1504,6 @@ begin
rect := CellRect(c, r); rect := CellRect(c, r);
DrawCellBorders(c, r, rect); DrawCellBorders(c, r, rect);
end; end;
cell := Worksheet.GetNextCell;
end; end;
end; end;
@ -2003,7 +2001,6 @@ var
P1, P2: TPoint; P1, P2: TPoint;
cell: PCell; cell: PCell;
r1,c1,r2,c2: Cardinal; r1,c1,r2,c2: Cardinal;
rng: PsCellRange;
begin begin
// Selected cell // Selected cell
cell := Worksheet.FindCell(GetWorksheetRow(Selection.Top), GetWorksheetCol(Selection.Left)); cell := Worksheet.FindCell(GetWorksheetRow(Selection.Top), GetWorksheetCol(Selection.Left));

82
components/fpspreadsheet/fpsreaderwriter.pas
View File

@ -20,7 +20,7 @@ interface
uses uses
Classes, Sysutils, AVL_Tree, Classes, Sysutils, AVL_Tree,
fpsTypes, fpSpreadsheet, fpsNumFormat; fpsTypes, fpsClasses, fpSpreadsheet, fpsNumFormat;
type type
{@@ {@@
@ -101,7 +101,7 @@ type
{ Helpers for writing } { Helpers for writing }
procedure WriteCellCallback(ACell: PCell; AStream: TStream); procedure WriteCellCallback(ACell: PCell; AStream: TStream);
procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree); procedure WriteCellsToStream(AStream: TStream; ACells: TsCells);
{ Record writing methods } { Record writing methods }
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
@ -124,11 +124,11 @@ type
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
{ General writing methods } { General writing methods }
procedure IterateThroughCells(AStream: TStream; ACells: TAVLTree; procedure IterateThroughCells(AStream: TStream; ACells: TsCells;
ACallback: TCellsCallback); ACallback: TCellsCallback);
procedure IterateThroughComments(AStream: TStream; AComments: TAVLTree; procedure IterateThroughComments(AStream: TStream; AComments: TsComments;
ACallback: TCommentsCallback); ACallback: TCommentsCallback);
procedure IterateThroughHyperlinks(AStream: TStream; AHyperlinks: TAVLTree; procedure IterateThroughHyperlinks(AStream: TStream; AHyperlinks: TsHyperlinks;
ACallback: THyperlinksCallback); ACallback: THyperlinksCallback);
procedure WriteToFile(const AFileName: string; procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); override; const AOverwriteExisting: Boolean = False); override;
@ -471,16 +471,29 @@ end;
cell as well as the destination stream. cell as well as the destination stream.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.IterateThroughCells(AStream: TStream; procedure TsCustomSpreadWriter.IterateThroughCells(AStream: TStream;
ACells: TAVLTree; ACallback: TCellsCallback); ACells: TsCells; ACallback: TCellsCallback);
var var
AVLNode: TAVLTreeNode; cell: PCell;
node: TAVLTreeNode;
begin begin
AVLNode := ACells.FindLowest; node := ACells.FindLowest;
while Assigned(AVLNode) do while Assigned(node) do begin
begin ACallback(PCell(node.Data), AStream);
ACallback(PCell(AVLNode.Data), AStream); node := ACells.FindSuccessor(node);
AVLNode := ACells.FindSuccessor(AVLNode);
end; end;
{
ACells.PushCurrent;
try
cell := ACells.GetFirstCell;
while Assigned(cell) do
begin
ACallback(cell, AStream);
cell := ACells.GetNextCell;
end;
finally
ACells.PopCurrent;
end;
}
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -493,18 +506,23 @@ end;
comment record as well as the destination stream. comment record as well as the destination stream.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.IterateThroughComments(AStream: TStream; procedure TsCustomSpreadWriter.IterateThroughComments(AStream: TStream;
AComments: TAVLTree; ACallback: TCommentsCallback); AComments: TsComments; ACallback: TCommentsCallback);
var var
AVLNode: TAVLTreeNode;
index: Integer; index: Integer;
comment: PsComment;
begin begin
index := 0; index := 0;
AVLNode := AComments.FindLowest; AComments.PushCurrent;
while Assigned(AVLNode) do try
begin comment := PsComment(AComments.GetFirst);
ACallback(PsComment(AVLNode.Data), index, AStream); while Assigned(comment) do
AVLNode := AComments.FindSuccessor(AVLNode); begin
inc(index); ACallback(comment, index, AStream);
comment := PsComment(AComments.GetNext);
inc(index);
end;
finally
AComments.PopCurrent;
end; end;
end; end;
@ -518,18 +536,20 @@ end;
the hyperlink record as well as the destination stream. the hyperlink record as well as the destination stream.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.IterateThroughHyperlinks(AStream: TStream; procedure TsCustomSpreadWriter.IterateThroughHyperlinks(AStream: TStream;
AHyperlinks: TAVLTree; ACallback: THyperlinksCallback); AHyperlinks: TsHyperlinks; ACallback: THyperlinksCallback);
var var
AVLNode: TAVLTreeNode; hyperlink: PsHyperlink;
index: Integer;
begin begin
index := 0; AHyperlinks.PushCurrent;
AVLNode := AHyperlinks.FindLowest; try
while Assigned(AVLNode) do hyperlink := PsHyperlink(AHyperlinks.GetFirst);
begin while Assigned(hyperlink) do
ACallback(PsHyperlink(AVLNode.Data), AStream); begin
AVLNode := AHyperlinks.FindSuccessor(AVLNode); ACallback(hyperlink, AStream);
inc(index); hyperlink := PsHyperlink(AHyperlinks.GetNext);
end;
finally
AHyperlinks.PopCurrent;
end; end;
end; end;
@ -595,7 +615,7 @@ end;
@param ACells List of cells to be writeen @param ACells List of cells to be writeen
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.WriteCellsToStream(AStream: TStream; procedure TsCustomSpreadWriter.WriteCellsToStream(AStream: TStream;
ACells: TAVLTree); ACells: TsCells);
begin begin
IterateThroughCells(AStream, ACells, WriteCellCallback); IterateThroughCells(AStream, ACells, WriteCellCallback);
end; end;

9
components/fpspreadsheet/fpsstrings.pas
View File

@ -55,12 +55,14 @@ resourcestring
rsIndexInSSTOutOfRange = 'Index %d in SST out of range (0-%d).'; rsIndexInSSTOutOfRange = 'Index %d in SST out of range (0-%d).';
rsAmbiguousDecThouSeparator = 'Assuming usage of decimal separator in "%s".'; rsAmbiguousDecThouSeparator = 'Assuming usage of decimal separator in "%s".';
rsCodePageNotSupported = 'Code page "%s" is not supported. Using "cp1252" (Latin 1) instead.'; rsCodePageNotSupported = 'Code page "%s" is not supported. Using "cp1252" (Latin 1) instead.';
rsNoValidHyperlinkInternal = 'The hyperlink "%s" is not a valid cell address.'; rsNoValidHyperlinkInternal = 'The hyperlink "%s" is not a valid cell address.';
rsNoValidHyperlinkURI = 'The hyperlink "%s" is not a valid URI.'; rsNoValidHyperlinkURI = 'The hyperlink "%s" is not a valid URI.';
rsEmptyHyperlink = 'The hyperlink is not specified.'; rsEmptyHyperlink = 'The hyperlink is not specified.';
rsODSHyperlinksOfTextCellsOnly = 'Cell %s: OpenDocument supports hyperlinks for text cells only.'; rsODSHyperlinksOfTextCellsOnly = 'Cell %s: OpenDocument supports hyperlinks for text cells only.';
rsStdHyperlinkTooltip = 'Press the left mouse button a bit longer to activate the hyperlink.'; rsStdHyperlinkTooltip = 'Press the left mouse button a bit longer to activate the hyperlink.';
rsCannotSortMerged = 'The cell range cannot be sorted because it contains merged cells.';
rsTRUE = 'TRUE'; // wp: Do we really want to translate these strings? rsTRUE = 'TRUE'; // wp: Do we really want to translate these strings?
rsFALSE = 'FALSE'; rsFALSE = 'FALSE';
@ -73,9 +75,10 @@ resourcestring
rsErrArgError = '#N/A'; rsErrArgError = '#N/A';
rsErrFormulaNotSupported = '<FORMULA?>'; rsErrFormulaNotSupported = '<FORMULA?>';
{%H-}rsNoValidDateTimeFormatString = 'No valid date/time format string.'; (*
{%H-}rsIllegalNumberFormat = 'Illegal number format.'; {%H-}rsNoValidDateTimeFormatString = 'No valid date/time format string.';
{%H-}rsIllegalNumberFormat = 'Illegal number format.';
*)
implementation implementation

38
components/fpspreadsheet/fpstypes.pas
View File

@ -531,6 +531,44 @@ type
property Items[AIndex: Integer]: PsCellFormat read GetItem write SetItem; default; property Items[AIndex: Integer]: PsCellFormat read GetItem write SetItem; default;
end; end;
{@@ Pointer to a TCell record }
PCell = ^TCell;
{@@ Cell structure for TsWorksheet
The cell record contains information on the location of the cell (row and
column index), on the value contained (number, date, text, ...), on
formatting, etc.
Never suppose that all *Value fields are valid,
only one of the ContentTypes is valid. For other fields
use TWorksheet.ReadAsUTF8Text and similar methods
@see ReadAsUTF8Text }
TCell = record
{ Location of the cell }
Row: Cardinal; // zero-based
Col: Cardinal; // zero-based
Worksheet: Pointer; // Must be cast to TsWorksheet when used
{ Status flags }
Flags: TsCellFlags;
{ Index of format record in the workbook's FCellFormatList }
FormatIndex: Integer;
{ Special information }
SharedFormulaBase: PCell; // Cell containing the shared formula
{ Cell content }
UTF8StringValue: String; // Strings cannot be part of a variant record
FormulaValue: String;
case ContentType: TCellContentType of // variant part must be at the end
cctEmpty : (); // has no data at all
cctFormula : (); // FormulaValue is outside the variant record
cctNumber : (Numbervalue: Double);
cctUTF8String : (); // UTF8StringValue is outside the variant record
cctDateTime : (DateTimevalue: TDateTime);
cctBool : (BoolValue: boolean);
cctError : (ErrorValue: TsErrorValue);
end;
procedure InitFormatRecord(out AValue: TsCellFormat); procedure InitFormatRecord(out AValue: TsCellFormat);

29
components/fpspreadsheet/fpsutils.pas
View File

@ -148,6 +148,9 @@ function InitSortParams(ASortByCols: Boolean = true; ANumSortKeys: Integer = 1;
procedure SplitHyperlink(AValue: String; out ATarget, ABookmark: String); procedure SplitHyperlink(AValue: String; out ATarget, ABookmark: String);
procedure InitCell(out ACell: TCell); overload;
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); overload;
procedure AppendToStream(AStream: TStream; const AString: String); inline; overload; procedure AppendToStream(AStream: TStream; const AString: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload; procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String); inline; overload; procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String); inline; overload;
@ -2051,6 +2054,32 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Initalizes a new cell.
@return New cell record
-------------------------------------------------------------------------------}
procedure InitCell(out ACell: TCell);
begin
ACell.FormulaValue := '';
ACell.UTF8StringValue := '';
FillChar(ACell, SizeOf(ACell), 0);
end;
{@@ ----------------------------------------------------------------------------
Initalizes a new cell and presets the row and column fields of the cell record
to the parameters passed to the procedure.
@param ARow Row index of the new cell
@param ACol Column index of the new cell
@return New cell record with row and column fields preset to passed values.
-------------------------------------------------------------------------------}
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell);
begin
InitCell(ACell);
ACell.Row := ARow;
ACell.Col := ACol;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Appends a string to a stream Appends a string to a stream

BIN
components/fpspreadsheet/images/demos/comment-add.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 471 B

After

Width:  |  Height:  |  Size: 567 B

BIN
components/fpspreadsheet/images/demos/comment-delete.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 567 B

After

Width:  |  Height:  |  Size: 471 B

363
components/fpspreadsheet/tests/enumeratortests.pas Normal file
View File

@ -0,0 +1,363 @@
{ Tests for iteration through cells by means of the enumerator of the cells tree.
This unit test is not writing anything to file.
}
unit enumeratortests;
{$mode objfpc}{$H+}
interface
uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testregistry,
fpstypes, fpspreadsheet, fpsclasses, {and a project requirement for lclbase for utf8 handling}
testsutility;
type
{ TSpreadEnumeratorTests }
TSpreadEnumeratorTests = class(TTestCase)
private
protected
procedure SetUp; override;
procedure TearDown; override;
procedure Test_EnumCells(what: Integer; reverse, withGaps: Boolean);
procedure Test_EnumComments(what: Integer; withGaps: Boolean);
published
procedure Test_Enum_Cells_All;
procedure Test_Enum_Cells_All_Reverse;
procedure Test_Enum_Cells_FullRow;
procedure Test_Enum_Cells_FullRow_Reverse;
procedure Test_Enum_Cells_FullCol;
procedure Test_Enum_Cells_FullCol_Reverse;
procedure Test_Enum_Cells_PartialRow;
procedure Test_Enum_Cells_PartialRow_Reverse;
procedure Test_Enum_Cells_PartialCol;
procedure Test_Enum_Cells_PartialCol_Reverse;
procedure Test_Enum_Cells_Range;
procedure Test_Enum_Cells_Range_Reverse;
procedure Test_Enum_Cells_WithGaps_All;
procedure Test_Enum_Cells_WithGaps_All_Reverse;
procedure Test_Enum_Cells_WithGaps_FullRow;
procedure Test_Enum_Cells_WithGaps_FullRow_Reverse;
procedure Test_Enum_Cells_WithGaps_FullCol;
procedure Test_Enum_Cells_WithGaps_FullCol_Reverse;
procedure Test_Enum_Cells_WithGaps_PartialRow;
procedure Test_Enum_Cells_WithGaps_PartialRow_Reverse;
procedure Test_Enum_Cells_WithGaps_PartialCol;
procedure Test_Enum_Cells_WithGaps_PartialCol_Reverse;
procedure Test_Enum_Cells_WithGaps_Range;
procedure Test_Enum_Cells_WithGaps_Range_Reverse;
procedure Test_Enum_Comments_All;
procedure Test_Enum_Comments_Range;
procedure Test_Enum_Comments_WithGaps_All;
procedure Test_Enum_Comments_WithGaps_Range;
end;
implementation
const
NUM_ROWS = 100;
NUM_COLS = 100;
TEST_ROW = 10;
TEST_COL = 20;
TEST_ROW1 = 20;
TEST_ROW2 = 50;
TEST_COL1 = 30;
TEST_COL2 = 60;
procedure TSpreadEnumeratorTests.Setup;
begin
end;
procedure TSpreadEnumeratorTests.TearDown;
begin
end;
procedure TSpreadEnumeratorTests.Test_EnumCells(what: Integer; reverse: Boolean;
withGaps: Boolean);
{ what = 1 ---> iterate through entire worksheet
what = 2 ---> iterate along full row
what = 3 ---> iterate along full column
what = 4 ---> iterate along partial row
what = 5 ---> iterate along partial column
what = 6 ---> iterate through rectangular cell range
The test writes numbers into the worksheet calculated by <row>*10000 + <col>.
Then the test iterates through the designed range (according to "what") and
compares the read number with the soll values.
If "withGaps" is true then numbers are only written at cells where
<col>+<row> is odd. }
var
row, col: Cardinal;
cell: PCell;
MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet;
expected, actual: Double;
enumerator: TsCellEnumerator;
begin
MyWorkbook := TsWorkbook.Create;
try
MyWorksheet := MyWorkbook.AddWorksheet('Sheet1');
for row := 0 to NUM_ROWS-1 do
for col := 0 to NUM_COLS-1 do
if (withGaps and odd(row + col)) or (not withGaps) then
MyWorksheet.WriteNumber(row, col, row*10000.0 + col);
if reverse then
case what of
1: enumerator := MyWorksheet.Cells.GetReverseRangeEnumerator(0, 0, $7FFFFFFF, $7FFFFFFF);
2: enumerator := Myworksheet.Cells.GetReverseRowEnumerator(TEST_ROW);
3: enumerator := MyWorksheet.Cells.GetReverseColEnumerator(TEST_COL);
4: enumerator := MyWorksheet.Cells.GetReverseRowEnumerator(TEST_ROW, TEST_COL1, TEST_COL2);
5: enumerator := Myworksheet.Cells.GetReverseColEnumerator(TEST_COL, TEST_ROW1, TEST_ROW2);
6: enumerator := MyWorksheet.Cells.GetReverseRangeEnumerator(TEST_ROW1, TEST_COL1, TEST_ROW2, TEST_COL2);
end
else
case what of
1: enumerator := MyWorksheet.Cells.GetEnumerator;
2: enumerator := Myworksheet.Cells.GetRowEnumerator(TEST_ROW);
3: enumerator := MyWorksheet.Cells.GetColEnumerator(TEST_COL);
4: enumerator := MyWorksheet.Cells.GetRowEnumerator(TEST_ROW, TEST_COL1, TEST_COL2);
5: enumerator := Myworksheet.Cells.GetColEnumerator(TEST_COL, TEST_ROW1, TEST_ROW2);
6: enumerator := MyWorksheet.Cells.GetRangeEnumerator(TEST_ROW1, TEST_COL1, TEST_ROW2, TEST_COL2);
end;
for cell in enumerator do
begin
row := cell^.Row;
col := cell^.Col;
if (withgaps and odd(row + col)) or (not withgaps) then
expected := row * 10000.0 + col
else
expected := 0.0;
actual := MyWorksheet.ReadAsNumber(cell);
CheckEquals(expected, actual,
'Enumerated cell value mismatch, cell '+CellNotation(MyWorksheet, row, col));
end;
// for debugging, to see the data file
// MyWorkbook.WriteToFile('enumerator-test.xlsx', sfOOXML, true);
finally
MyWorkbook.Free;
end;
end;
procedure TSpreadEnumeratorTests.Test_EnumComments(what: Integer;
withGaps: Boolean);
{ what = 1 ---> iterate through entire worksheet
what = 2 ---> iterate through rectangular cell range
The test writes comments into the worksheet calculated by <row>*10000 + <col>.
Then the test iterates through the designed range (according to "what") and
compares the read comments with the soll values.
if "withGaps" is true then comments are only written at cells where
<col>+<row> is odd. }
var
row, col: Cardinal;
comment: PsComment;
MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet;
expected, actual: string;
enumerator: TsCommentEnumerator;
begin
MyWorkbook := TsWorkbook.Create;
try
MyWorksheet := MyWorkbook.AddWorksheet('Sheet1');
for row := 0 to NUM_ROWS-1 do
for col := 0 to NUM_COLS-1 do
if (withGaps and odd(row + col)) or (not withGaps) then
MyWorksheet.WriteComment(row, col, IntToStr(row*10000 + col));
case what of
1: enumerator := MyWorksheet.Comments.GetEnumerator;
2: enumerator := MyWorksheet.Comments.GetRangeEnumerator(TEST_ROW1, TEST_COL1, TEST_ROW2, TEST_COL2);
end;
for comment in enumerator do
begin
row := comment^.Row;
col := comment^.Col;
if (withgaps and odd(row + col)) or (not withgaps) then
expected := IntToStr(row * 10000 + col)
else
expected := '';
actual := MyWorksheet.ReadComment(row, col);
CheckEquals(expected, actual,
'Enumerated comment mismatch, cell '+CellNotation(MyWorksheet, row, col));
end;
// for debugging, to see the data file
// MyWorkbook.WriteToFile('enumerator-test.xlsx', sfOOXML, true);
finally
MyWorkbook.Free;
end;
end;
{ Fully filled worksheet }
procedure TSpreadEnumeratorTests.Test_Enum_Cells_All;
begin
Test_Enumcells(1, false, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_All_Reverse;
begin
Test_EnumCells(1, true, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_FullRow;
begin
Test_EnumCells(2, false, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_FullRow_Reverse;
begin
Test_EnumCells(2, true, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_FullCol;
begin
Test_EnumCells(3, false, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_FullCol_Reverse;
begin
Test_EnumCells(3, true, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_PartialRow;
begin
Test_EnumCells(4, false, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_PartialRow_Reverse;
begin
Test_EnumCells(4, true, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_PartialCol;
begin
Test_EnumCells(5, false, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_PartialCol_Reverse;
begin
Test_EnumCells(5, true, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_Range;
begin
Test_EnumCells(6, false, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_Range_Reverse;
begin
Test_EnumCells(6, true, false);
end;
{ Worksheet with gaps}
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_All;
begin
Test_Enumcells(1, false, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_All_Reverse;
begin
Test_EnumCells(1, true, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_FullRow;
begin
Test_EnumCells(2, false, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_FullRow_Reverse;
begin
Test_EnumCells(2, true, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_FullCol;
begin
Test_EnumCells(3, false, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_FullCol_Reverse;
begin
Test_EnumCells(3, true, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_PartialRow;
begin
Test_EnumCells(4, false, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_PartialRow_Reverse;
begin
Test_EnumCells(4, true, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_PartialCol;
begin
Test_EnumCells(5, false, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_PartialCol_Reverse;
begin
Test_EnumCells(5, true, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_Range;
begin
Test_EnumCells(6, false, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Cells_WithGaps_Range_Reverse;
begin
Test_EnumCells(6, true, true);
end;
{ Fully filled worksheet }
procedure TSpreadEnumeratorTests.Test_Enum_Comments_All;
begin
Test_EnumComments(1, false);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Comments_Range;
begin
Test_EnumComments(2, false);
end;
{ Every other cell empty }
procedure TSpreadEnumeratorTests.Test_Enum_Comments_WithGaps_All;
begin
Test_EnumComments(1, true);
end;
procedure TSpreadEnumeratorTests.Test_Enum_Comments_WithGaps_Range;
begin
Test_EnumComments(2, true);
end;
initialization
RegisterTest(TSpreadEnumeratorTests);
end.

64
components/fpspreadsheet/tests/sortingtests.pas
View File

@ -18,6 +18,11 @@ var
SollSortNumbers: array[0..9] of Double; SollSortNumbers: array[0..9] of Double;
SollSortStrings: array[0..9] of String; SollSortStrings: array[0..9] of String;
CommentIsSortedToStringIndex: Integer;
CommentIsSortedToNumberIndex: Integer;
HyperlinkIsSortedToStringIndex: Integer;
HyperlinkIsSortedToNumberIndex: Integer;
procedure InitUnsortedData; procedure InitUnsortedData;
type type
@ -74,7 +79,7 @@ procedure InitUnsortedData;
// The logics of the detection requires equal count of numbers and strings. // The logics of the detection requires equal count of numbers and strings.
begin begin
// When sorted the value is equal to the index // When sorted the value is equal to the index
SollSortNumbers[0] := 9; SollSortNumbers[0] := 9; // --> A1 --> will contain comment and hyperlink
SollSortNumbers[1] := 8; SollSortNumbers[1] := 8;
SollSortNumbers[2] := 5; SollSortNumbers[2] := 5;
SollSortNumbers[3] := 2; SollSortNumbers[3] := 2;
@ -85,8 +90,11 @@ begin
SollSortNumbers[8] := 4; SollSortNumbers[8] := 4;
SollSortNumbers[9] := 0; SollSortNumbers[9] := 0;
CommentIsSortedToNumberIndex := 9;
HyperlinkIsSortedToNumberIndex := 9;
// When sorted the value is equal to 'A' + index // When sorted the value is equal to 'A' + index
SollSortStrings[0] := 'C'; SollSortStrings[0] := 'C'; // --> Ar --> will contain hyperlink and comment
SollSortStrings[1] := 'G'; SollSortStrings[1] := 'G';
SollSortStrings[2] := 'F'; SollSortStrings[2] := 'F';
SollSortStrings[3] := 'I'; SollSortStrings[3] := 'I';
@ -96,6 +104,9 @@ begin
SollSortStrings[7] := 'H'; SollSortStrings[7] := 'H';
SollSortStrings[8] := 'E'; SollSortStrings[8] := 'E';
SollSortStrings[9] := 'A'; SollSortStrings[9] := 'A';
CommentIsSortedToStringIndex := 2;
HyperlinkIsSortedToStringIndex := 2;
end; end;
@ -120,17 +131,15 @@ var
MyWorksheet: TsWorksheet; MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook; MyWorkbook: TsWorkbook;
i, ilast, n, row, col: Integer; i, ilast, n, row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it TempFile: string; //write xls/xml to this file and read back from it
L: TStringList; L: TStringList;
s: String; s: String;
sortParams: TsSortParams; sortParams: TsSortParams;
sortOptions: TsSortOptions;
r1,r2,c1,c2: Cardinal;
actualNumber: Double; actualNumber: Double;
actualString: String; actualString: String;
expectedNumber: Double; expectedNumber: Double;
expectedString: String; expectedString: String;
cell: PCell;
begin begin
sortParams := InitSortParams(ASortByCols, 1); sortParams := InitSortParams(ASortByCols, 1);
@ -145,11 +154,11 @@ begin
row := 0; row := 0;
if ASortByCols then begin if ASortByCols then begin
case AWhat of case AWhat of
0: for i :=0 to High(SollSortNumbers) do 0: for i :=0 to High(SollSortNumbers) do // Numbers only
MyWorksheet.WriteNumber(i, col, SollSortNumbers[i]); MyWorksheet.WriteNumber(i, col, SollSortNumbers[i]);
1: for i := 0 to High(SollSortStrings) do 1: for i := 0 to High(SollSortStrings) do // Strings only
Myworksheet.WriteUTF8Text(i, col, SollSortStrings[i]); Myworksheet.WriteUTF8Text(i, col, SollSortStrings[i]);
2: begin 2: begin // Numbers and strings
for i := 0 to High(SollSortNumbers) do for i := 0 to High(SollSortNumbers) do
MyWorkSheet.WriteNumber(i*2, col, SollSortNumbers[i]); MyWorkSheet.WriteNumber(i*2, col, SollSortNumbers[i]);
for i := 0 to High(SollSortStrings) do for i := 0 to High(SollSortStrings) do
@ -171,6 +180,14 @@ begin
end; end;
end; end;
end; end;
// Add comment and hyperlink to cell A1. After sorting it is expected
// in cell defined by CommentIsSortedToXXXIndex (XXX = Number/String)
if AFormat <> sfExcel8 then // Comments not implemented for writing Excel8
MyWorksheet.WriteComment(0, 0, 'Test comment');
MyWorksheet.WriteHyperlink(0, 0, 'http://www.google.com');
MyWorkBook.WriteToFile(TempFile, AFormat, true); MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally finally
MyWorkbook.Free; MyWorkbook.Free;
@ -205,7 +222,7 @@ begin
MyWorksheet.Sort(sortParams, 0, 0, 0, iLast); MyWorksheet.Sort(sortParams, 0, 0, 0, iLast);
// for debugging, to see the sorted data // for debugging, to see the sorted data
// MyWorkbook.WriteToFile('sorted.xls', AFormat, true); //MyWorkbook.WriteToFile('sorted.xls', AFormat, true);
row := 0; row := 0;
col := 0; col := 0;
@ -223,20 +240,41 @@ begin
end; end;
case AWhat of case AWhat of
0: begin 0: begin
actualNumber := MyWorksheet.ReadAsNumber(row, col); cell := MyWorksheet.FindCell(row, col);
actualNumber := MyWorksheet.ReadAsNumber(cell);
expectedNumber := i; expectedNumber := i;
CheckEquals(expectednumber, actualnumber, CheckEquals(expectednumber, actualnumber,
'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col)); 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
if AFormat <> sfExcel8 then // Comments are not written for sfExcel8 --> ignore
CheckEquals(
i=CommentIsSortedToNumberIndex,
MyWorksheet.HasComment(cell),
'Sorted comment position mismatch, cell '+CellNotation(MyWorksheet, row, col));
CheckEquals(
i = HyperlinkisSortedToNumberIndex,
MyWorksheet.HasHyperlink(cell),
'Sorted hyperlink position mismatch, cell '+CellNotation(MyWorksheet, row, col));
end; end;
1: begin 1: begin
actualString := MyWorksheet.ReadAsUTF8Text(row, col); cell := MyWorksheet.FindCell(row, col);
actualString := MyWorksheet.ReadAsUTF8Text(cell);
expectedString := char(ord('A') + i); expectedString := char(ord('A') + i);
CheckEquals(expectedstring, actualstring, CheckEquals(expectedstring, actualstring,
'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col)); 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col));
if AFormat <> sfExcel8 then // Comments are not written for sfExcel8 --> ignore
CheckEquals(
i=CommentIsSortedToStringIndex,
MyWorksheet.HasComment(cell),
'Sorted comment position mismatch, cell '+CellNotation(MyWorksheet, row, col));
CheckEquals(
i = HyperlinkisSortedToStringIndex,
MyWorksheet.HasHyperlink(cell),
'Sorted hyperlink position mismatch, cell '+CellNotation(MyWorksheet, row, col));
end; end;
2: begin // with increasing i, we see first the numbers, then the strings 2: begin // with increasing i, we see first the numbers, then the strings
if i <= High(SollSortNumbers) then begin if i <= High(SollSortNumbers) then begin
actualnumber := MyWorksheet.ReadAsNumber(row, col); cell := MyWorksheet.FindCell(row, col);
actualnumber := MyWorksheet.ReadAsNumber(cell);
expectedNumber := i; expectedNumber := i;
CheckEquals(expectednumber, actualnumber, CheckEquals(expectednumber, actualnumber,
'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col)); 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
@ -346,7 +384,7 @@ begin
MyWorksheet.Sort(sortParams, 0, 0, 1, iLast); MyWorksheet.Sort(sortParams, 0, 0, 1, iLast);
// for debugging, to see the sorted data // for debugging, to see the sorted data
MyWorkbook.WriteToFile('sorted.xls', AFormat, true); // MyWorkbook.WriteToFile('sorted.xls', AFormat, true);
for i:=0 to iLast do for i:=0 to iLast do
begin begin

9
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -40,7 +40,7 @@
<PackageName Value="FCL"/> <PackageName Value="FCL"/>
</Item4> </Item4>
</RequiredPackages> </RequiredPackages>
<Units Count="22"> <Units Count="23">
<Unit0> <Unit0>
<Filename Value="spreadtestgui.lpr"/> <Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -96,6 +96,7 @@
<Unit13> <Unit13>
<Filename Value="formulatests.pas"/> <Filename Value="formulatests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="formulatests"/>
</Unit13> </Unit13>
<Unit14> <Unit14>
<Filename Value="emptycelltests.pas"/> <Filename Value="emptycelltests.pas"/>
@ -121,6 +122,7 @@
<Unit19> <Unit19>
<Filename Value="sortingtests.pas"/> <Filename Value="sortingtests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="sortingtests"/>
</Unit19> </Unit19>
<Unit20> <Unit20>
<Filename Value="copytests.pas"/> <Filename Value="copytests.pas"/>
@ -131,6 +133,11 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="commenttests"/> <UnitName Value="commenttests"/>
</Unit21> </Unit21>
<Unit22>
<Filename Value="enumeratortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="enumeratortests"/>
</Unit22>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

2
components/fpspreadsheet/tests/spreadtestgui.lpr
View File

@ -12,7 +12,7 @@ uses
manualtests, testsutility, internaltests, formattests, colortests, fonttests, manualtests, testsutility, internaltests, formattests, colortests, fonttests,
optiontests, numformatparsertests, formulatests, rpnFormulaUnit, optiontests, numformatparsertests, formulatests, rpnFormulaUnit,
emptycelltests, errortests, virtualmodetests, insertdeletetests, emptycelltests, errortests, virtualmodetests, insertdeletetests,
celltypetests, sortingtests, copytests, commenttests; celltypetests, sortingtests, copytests, commenttests, enumeratortests;
begin begin
{$IFDEF HEAPTRC} {$IFDEF HEAPTRC}

10
components/fpspreadsheet/xlsxooxml.pas
View File

@ -2314,7 +2314,7 @@ var
value: Variant; value: Variant;
lCell: TCell; lCell: TCell;
styleCell: PCell; styleCell: PCell;
AVLNode: TAVLTreeNode; cell: PCell;
rh: String; rh: String;
h0: Single; h0: Single;
begin begin
@ -2395,11 +2395,9 @@ begin
'<row r="%d" spans="%d:%d"%s>', [r+1, c1+1, c2+1, rh])); '<row r="%d" spans="%d:%d"%s>', [r+1, c1+1, c2+1, rh]));
// Write cells belonging to this row. // Write cells belonging to this row.
for c := c1 to c2 do begin for c := c1 to c2 do begin
lCell.Row := r; cell := AWorksheet.FindCell(r, c);
lCell.Col := c; if Assigned(cell) then begin
AVLNode := AWorksheet.Cells.Find(@lCell); WriteCellCallback(cell, AStream);
if Assigned(AVLNode) then begin
WriteCellCallback(PCell(AVLNode.Data), AStream);
end; end;
end; end;
AppendToStream(AStream, AppendToStream(AStream,