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
object EdFrozenCols: TSpinEdit
Left = 429
Height = 27
Height = 23
Top = 8
Width = 52
OnChange = EdFrozenColsChange
@ -31,7 +31,7 @@ object MainFrm: TMainFrm
end
object EdFrozenRows: TSpinEdit
Left = 429
Height = 27
Height = 23
Top = 39
Width = 52
OnChange = EdFrozenRowsChange
@ -123,7 +123,7 @@ object MainFrm: TMainFrm
Action = AcSaveAs
end
object ToolButton3: TToolButton
Left = 200
Left = 228
Top = 0
Action = AcQuit
end
@ -181,6 +181,19 @@ object MainFrm: TMainFrm
Caption = 'ToolButton31'
Style = tbsDivider
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
object FormatToolBar: TToolBar
Left = 0
@ -401,7 +414,7 @@ object MainFrm: TMainFrm
TabOrder = 2
object EdCellAddress: TEdit
Left = 0
Height = 27
Height = 23
Top = 0
Width = 170
Align = alTop
@ -1406,7 +1419,7 @@ object MainFrm: TMainFrm
left = 272
top = 264
Bitmap = {
4C69280000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
4C692B0000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00EAC39DFFE6BF96FFE4BB92FFE4BB92FFD1A06CF5D09E6DF6CC96
5FDAC479427EB2673C09FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00E5BE96FFFFFFFEFFFDF3E9FFFDF3EAFFFCF2E8FFFAEFE3FFFAF2
@ -2686,7 +2699,103 @@ object MainFrm: TMainFrm
63FFCB8E5EFFC98A5BFFC78756FFC38452FFC38452FFC38452FFC38452FFC384
52FFC38452FFBB7742B0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
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
object ActionList: TActionList
@ -3203,6 +3312,24 @@ object MainFrm: TMainFrm
Hint = 'Names and symbols known as valid currencies'
OnExecute = AcCurrencySymbolsExecute
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
object FontDialog: TFontDialog
MinFontSize = 0

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

@ -83,6 +83,9 @@ type
AcSortColAsc: TAction;
AcSort: TAction;
AcCurrencySymbols: TAction;
AcCommentAdd: TAction;
AcCommentDelete: TAction;
AcCommentEdit: TAction;
AcViewInspector: TAction;
AcWordwrap: TAction;
AcVAlignDefault: TAction;
@ -248,6 +251,8 @@ type
ToolButton29: TToolButton;
ToolButton30: TToolButton;
ToolButton31: TToolButton;
ToolButton32: TToolButton;
ToolButton33: TToolButton;
WorksheetGrid: TsWorksheetGrid;
ToolBar1: TToolBar;
FormatToolBar: TToolBar;
@ -280,6 +285,8 @@ type
procedure AcAddColumnExecute(Sender: TObject);
procedure AcAddRowExecute(Sender: TObject);
procedure AcBorderExecute(Sender: TObject);
procedure AcCommentAddExecute(Sender: TObject);
procedure AcCommentDeleteExecute(Sender: TObject);
procedure AcCopyFormatExecute(Sender: TObject);
procedure AcCSVParamsExecute(Sender: TObject);
procedure AcCurrencySymbolsExecute(Sender: TObject);
@ -327,10 +334,13 @@ type
private
FCopiedFormat: TCell;
function EditComment(ACaption: String; var AText: String): Boolean;
procedure LoadFile(const AFileName: String);
procedure SetupBackgroundColorBox;
procedure UpdateBackgroundColorIndex;
procedure UpdateCellInfo(ACell: PCell);
procedure UpdateCommentActions;
procedure UpdateFontNameIndex;
procedure UpdateFontSizeIndex;
procedure UpdateFontStyleActions;
@ -353,7 +363,7 @@ var
implementation
uses
TypInfo, LCLIntf, LCLType, LCLVersion, fpcanvas,
TypInfo, LCLIntf, LCLType, LCLVersion, fpcanvas, Buttons,
fpsutils, fpscsv, fpsNumFormat,
sFormatSettingsForm, sCSVParamsForm, sSortParamsForm, sfCurrencyForm;
@ -479,6 +489,42 @@ begin
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);
begin
WorksheetGrid.InsertCol(WorksheetGrid.Col);
@ -934,6 +980,53 @@ begin
WorksheetGrid.FrozenRows := EdFrozenRows.Value;
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);
var
fname: String;
@ -1246,6 +1339,24 @@ begin
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;
var
fname: String;
@ -1418,6 +1529,7 @@ begin
UpdateFontStyleActions;
UpdateTextRotationActions;
UpdateNumFormatActions;
UpdateCommentActions;
UpdateCellInfo(cell);
end;

67
components/fpspreadsheet/fpscell.pas
View File

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

667
components/fpspreadsheet/fpsclasses.pas
View File

@ -9,35 +9,122 @@ uses
fpstypes;
type
{ forward declarations }
TsRowColAVLTree = class;
{ TsRowCol }
TsRowCol = record
Row, Col: Cardinal;
Row, Col: LongInt;
end;
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 = class(TAVLTree)
private
FOwnsData: Boolean;
FCurrentNode: TAVLTreeNode;
FCurrentNodeStack: TAVLTreeNodeStack;
protected
procedure DisposeData(var AData: Pointer); virtual; abstract;
function NewData: Pointer; virtual; abstract;
public
constructor Create(AOwnsData: Boolean = true);
destructor Destroy; override;
function Add(ARow, ACol: Cardinal): PsRowCol;
function Add(ARow, ACol: LongInt): PsRowCol;
procedure Clear;
procedure Delete(ANode: TAVLTreeNode);
procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); virtual;
function Find(ARow, ACol: Cardinal): PsRowCol;
procedure Delete(ANode: TAVLTreeNode); overload;
procedure Delete(ARow, ACol: LongInt); overload;
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 GetLast: PsRowCol;
function GetNext: PsRowCol;
procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean);
procedure Remove(ARow, ACol: Cardinal);
function GetPrev: PsRowCol;
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;
{ TsComments }
TsCommentEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PsComment;
public
function GetEnumerator: TsCommentEnumerator; inline;
property Current: PsComment read GetCurrent;
end;
TsComments = class(TsRowColAVLTree)
protected
procedure DisposeData(var AData: Pointer); override;
@ -45,16 +132,33 @@ type
public
function AddComment(ARow, ACol: Cardinal; AComment: String): PsComment;
procedure DeleteComment(ARow, ACol: Cardinal);
// enumerators
function GetEnumerator: TsCommentEnumerator;
function GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Longint): TsCommentEnumerator;
end;
{ TsHyperlinks }
TsHyperlinkEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PsHyperlink;
public
function GetEnumerator: TsHyperlinkEnumerator; inline;
property Current: PsHyperlink read GetCurrent;
end;
TsHyperlinks = class(TsRowColAVLTree)
protected
procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override;
public
function AddHyperlink(ARow, ACol: Cardinal; ATarget: String; ATooltip: String = ''): PsHyperlink;
procedure DeleteHyperlink(ARow, ACol: Cardinal);
function AddHyperlink(ARow, ACol: Longint; ATarget: String;
ATooltip: String = ''): PsHyperlink;
procedure DeleteHyperlink(ARow, ACol: Longint);
// enumerators
function GetEnumerator: TsHyperlinkEnumerator;
function GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Longint): TsHyperlinkEnumerator;
end;
{ TsMergedCells }
@ -63,16 +167,17 @@ type
procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override;
public
function AddRange(ARow1, ACol1, ARow2, ACol2: Cardinal): PsCellRange;
procedure DeleteRange(ARow, ACol: Cardinal);
procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); override;
function FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange;
function AddRange(ARow1, ACol1, ARow2, ACol2: Longint): PsCellRange;
procedure DeleteRange(ARow, ACol: Longint);
procedure DeleteRowOrCol(AIndex: Longint; IsRow: Boolean); override;
procedure Exchange(ARow1, ACol1, ARow2, ACol2: Longint); override;
function FindRangeWithCell(ARow, ACol: Longint): PsCellRange;
end;
implementation
uses
fpspreadsheet;
Math, fpsUtils;
function CompareRowCol(Item1, Item2: Pointer): Integer;
begin
@ -82,6 +187,103 @@ begin
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 }
{ row and column indexes. }
@ -96,6 +298,7 @@ constructor TsRowColAVLTree.Create(AOwnsData: Boolean = true);
begin
inherited Create(@CompareRowCol);
FOwnsData := AOwnsData;
FCurrentNodeStack := TAVLTreeNodeStack.Create;
end;
{@@ ----------------------------------------------------------------------------
@ -104,6 +307,7 @@ end;
-------------------------------------------------------------------------------}
destructor TsRowColAVLTree.Destroy;
begin
FCurrentNodeStack.Free;
Clear;
inherited;
end;
@ -112,11 +316,9 @@ end;
Adds a new node to the tree identified by the specified row and column
indexes.
-------------------------------------------------------------------------------}
function TsRowColAVLTree.Add(ARow, ACol: Cardinal): PsRowCol;
function TsRowColAVLTree.Add(ARow, ACol: LongInt): PsRowCol;
begin
Result := Find(ARow, ACol);
if Result = nil then
Result := NewData;
Result := NewData;
Result^.Row := ARow;
Result^.Col := ACol;
inherited Add(Result);
@ -149,6 +351,18 @@ begin
inherited Delete(ANode);
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
row or column will be deleted from the underlying worksheet.
@ -157,7 +371,7 @@ end;
to be deleted
@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
node, nextnode: TAVLTreeNode;
item: PsRowCol;
@ -189,12 +403,54 @@ begin
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
returns a pointer to the data record.
Returns nil if such a node does not exist
-------------------------------------------------------------------------------}
function TsRowColAVLTree.Find(ARow, ACol: Cardinal): PsRowCol;
function TsRowColAVLTree.Find(ARow, ACol: LongInt): PsRowCol;
var
data: TsRowCol;
node: TAVLTreeNode;
@ -210,6 +466,33 @@ begin
Result := PsRowCol(node.Data);
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
through all nodes of the tree.
@ -217,19 +500,27 @@ end;
function TsRowColAVLTree.GetFirst: PsRowCol;
begin
FCurrentNode := FindLowest;
if FCurrentNode <> nil then
Result := PsRowCol(FCurrentNode.Data)
else
Result := nil;
Result := GetData(FCurrentNode);
end;
function TsRowColAVLTree.GetLast: PsRowCol;
begin
FCurrentNode := FindHighest;
Result := GetData(FCurrentNode);
end;
function TsRowColAVLTree.GetNext: PsRowCol;
begin
FCurrentNode := FindSuccessor(FCurrentNode);
if FCurrentNode <> nil then
Result := PsRowCol(FCurrentNode.Data)
else
Result := nil;
FCurrentNode := FindSuccessor(FCurrentNode);
Result := GetData(FCurrentNode);
end;
function TsRowColAVLTree.GetPrev: PsRowCol;
begin
if FCurrentNode <> nil then
FCurrentNode := FindPrecessor(FCurrentNode);
Result := GetData(FCurrentNode);
end;
{@@ ----------------------------------------------------------------------------
@ -240,7 +531,7 @@ end;
to be inserted
@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
node: TAVLTreeNode;
item: PsRowCol;
@ -260,10 +551,9 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Removes the node and destroys the associated data reocrd (if the tree has
been created with AOwnsData=true) for the specified row and column indexes.
Removes the node, but does NOT destroy the associated data reocrd
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.Remove(ARow, ACol: Cardinal);
procedure TsRowColAVLTree.Remove(ARow, ACol: LongInt);
var
node: TAVLTreeNode;
item: TsRowCol;
@ -271,12 +561,215 @@ begin
item.Row := ARow;
item.Col := ACol;
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;
{******************************************************************************}
{ 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;
AComment: String): PsComment;
begin
Result := PsComment(Add(ARow, ACol));
Result := PsComment(Find(ARow, ACol));
if Result = nil then
Result := PsComment(Add(ARow, ACol));
Result^.Text := AComment;
end;
@ -297,7 +792,7 @@ end;
-------------------------------------------------------------------------------}
procedure TsComments.DeleteComment(ARow, ACol: Cardinal);
begin
Remove(ARow, ACol);
Delete(ARow, ACol);
end;
{@@ ----------------------------------------------------------------------------
@ -322,9 +817,38 @@ begin
Result := comment;
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.
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;
begin
Result := PsHyperlink(Add(ARow, ACol));
Result := PsHyperlink(Find(ARow, ACol));
if Result = nil then
Result := PsHyperlink(Add(ARow, ACol));
Result^.Target := ATarget;
Result^.Tooltip := ATooltip;
end;
@ -344,9 +870,9 @@ end;
Deletes the node for the specified row and column index along with the
associated hyperlink data record.
-------------------------------------------------------------------------------}
procedure TsHyperlinks.DeleteHyperlink(ARow, ACol: Cardinal);
procedure TsHyperlinks.DeleteHyperlink(ARow, ACol: Longint);
begin
Remove(ARow, ACol);
Delete(ARow, ACol);
end;
{@@ ----------------------------------------------------------------------------
@ -360,6 +886,21 @@ begin
AData := nil;
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.
-------------------------------------------------------------------------------}
@ -381,9 +922,11 @@ end;
exists then its data will be replaced by the specified ones.
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
Result := PsCellRange(Add(ARow1, ACol1));
Result := PsCellRange(Find(ARow1, ACol1));
if Result = nil then
Result := PsCellRange(Add(ARow1, ACol1));
Result^.Row2 := ARow2;
Result^.Col2 := ACol2;
end;
@ -392,9 +935,9 @@ end;
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.
-------------------------------------------------------------------------------}
procedure TsMergedCells.DeleteRange(ARow, ACol: Cardinal);
procedure TsMergedCells.DeleteRange(ARow, ACol: Longint);
begin
Remove(ARow, ACol);
Delete(ARow, ACol);
end;
{@@ ----------------------------------------------------------------------------
@ -405,7 +948,7 @@ end;
to be deleted
@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
rng, nextrng: PsCellRange;
begin
@ -465,11 +1008,41 @@ begin
AData := nil;
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
index
-------------------------------------------------------------------------------}
function TsMergedCells.FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange;
function TsMergedCells.FindRangeWithCell(ARow, ACol: Longint): PsCellRange;
var
node: TAVLTreeNode;
begin

2
components/fpspreadsheet/fpsfunc.pas
View File

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

496
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -32,43 +32,6 @@ type
TsBasicSpreadReader = 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:
@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)
@ -124,11 +87,10 @@ type
private
FWorkbook: TsWorkbook;
FName: String; // Name of the worksheet (displayed at the tab)
FCells: TAvlTree; // Items are TCell
FCells: TsCells;
FComments: TsComments;
FMergedCells: TsMergedCells;
FHyperlinks: TsHyperlinks;
FCurrentNode: TAVLTreeNode; // for GetFirstCell and GetNextCell
FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from default
FActiveCellRow: Cardinal;
FActiveCellCol: Cardinal;
@ -153,17 +115,13 @@ type
procedure SetName(const AName: String);
{ Callback procedures called when iterating through all cells }
procedure CalcFormulaCallback(data, arg: Pointer);
procedure CalcStateCallback(data, arg: Pointer);
procedure DeleteColCallback(data, arg: Pointer);
procedure DeleteRowCallback(data, arg: Pointer);
procedure InsertColCallback(data, arg: Pointer);
procedure InsertRowCallback(data, arg: Pointer);
procedure RemoveCellsCallback(data, arg: pointer);
protected
function CellUsedInFormula(ARow, ACol: Cardinal): Boolean;
procedure RemoveAllAVLTreeNodes(ATree: TAvlTree; ARemoveCallback: TsCallback);
// Remove and delete cells
function RemoveCell(ARow, ACol: Cardinal): PCell;
@ -176,6 +134,7 @@ type
ASortOptions: TsSortOptions): Integer;
procedure DoExchangeColRow(AIsColumn: Boolean; AIndex, WithIndex: Cardinal;
AFromIndex, AToIndex: Cardinal);
procedure ExchangeCells(ARow1, ACol1, ARow2, ACol2: Cardinal);
public
{ Base methods }
@ -185,7 +144,7 @@ type
{ Utils }
class function CellInRange(ARow, ACol: Cardinal; ARange: TsCellRange): Boolean;
class function CellPosToText(ARow, ACol: Cardinal): string;
procedure RemoveAllCells;
// procedure RemoveAllCells;
procedure UpdateCaches;
{ Reading of values }
@ -397,16 +356,12 @@ type
procedure DeleteCell(ACell: PCell);
procedure EraseCell(ACell: PCell);
procedure ExchangeCells(ARow1, ACol1, ARow2, ACol2: Cardinal);
function FindCell(ARow, ACol: Cardinal): PCell; overload;
function FindCell(AddressStr: String): PCell; overload;
function GetCell(ARow, ACol: Cardinal): PCell; overload;
function GetCell(AddressStr: String): PCell; overload;
function GetCellCount: Cardinal;
function GetFirstCell(): PCell;
function GetNextCell(): PCell;
function GetFirstCellOfRow(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
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 }
property Cols: TIndexedAVLTree read FCols;
{@@ List of all comment records }
@ -828,9 +783,6 @@ procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
//function SameCellBorders(ACell1, ACell2: PCell): 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;
{ For debugging purposes }
@ -841,7 +793,7 @@ implementation
uses
Math, StrUtils, TypInfo, lazutf8, URIParser,
fpsPatches, fpsStrings, fpsStreams, uvirtuallayer_ole,
fpsPatches, fpsStrings, uvirtuallayer_ole,
fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser,
fpsNumFormat, fpsNumFormatParser;
@ -1026,32 +978,6 @@ begin
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).
@ -1135,7 +1061,7 @@ constructor TsWorksheet.Create;
begin
inherited Create;
FCells := TAVLTree.Create(@CompareCells);
FCells := TsCells.Create(self);
FRows := TIndexedAVLTree.Create(@CompareRows);
FCols := TIndexedAVLTree.Create(@CompareCols);
FComments := TsComments.Create;
@ -1164,7 +1090,7 @@ end;
-------------------------------------------------------------------------------}
destructor TsWorksheet.Destroy;
begin
RemoveAllCells;
// RemoveAllCells;
RemoveAllRows;
RemoveAllCols;
@ -1207,24 +1133,6 @@ begin
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
Should not be called by itself because the result may depend on other cells
@ -1253,6 +1161,7 @@ begin
formula := ACell^.SharedFormulaBase^.FormulaValue;
parser.ActiveCell := ACell;
end;
try
parser.Expression := formula;
res := parser.Evaluate;
@ -1263,6 +1172,7 @@ begin
Res := ErrorResult(errIllegalRef);
end;
end;
case res.ResultType of
rtEmpty : WriteBlank(ACell);
rtError : WriteErrorValue(ACell, res.ResError);
@ -1307,6 +1217,7 @@ end;
procedure TsWorksheet.CalcFormulas;
var
node: TAVLTreeNode;
cell: PCell;
begin
// prevent infinite loop due to triggering of formula calculation whenever
// a cell changes during execution of CalcFormulas.
@ -1315,36 +1226,29 @@ begin
// Step 1 - mark all formula cells as "not calculated"
node := FCells.FindLowest;
while Assigned(node) do begin
CalcStateCallback(node.Data, nil);
cell := PCell(node.Data);
if HasFormula(cell) then
SetCalcState(cell, csNotCalculated);
node := FCells.FindSuccessor(node);
end;
// Step 2 - calculate cells. If a not-yet-calculated cell is found it is
// calculated and then marked as such.
node := FCells.FindLowest;
while Assigned(Node) do begin
CalcFormulaCallback(Node.Data, nil);
while Assigned(node) do begin
cell := PCell(node.Data);
if (cell^.ContentType <> cctError) and
(HasFormula(cell) or HasFormula(cell^.SharedFormulaBase))
then
CalcFormula(cell);
node := FCells.FindSuccessor(node);
end;
finally
dec(FWorkbook.FCalculationLock);
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
specified rectangular cell range.
@ -1376,37 +1280,40 @@ end;
function TsWorksheet.CellUsedInFormula(ARow, ACol: Cardinal): Boolean;
var
cell: PCell;
cellNode: TAVLTreeNode;
fe: TsFormulaElement;
i: Integer;
rpnFormula: TsRPNFormula;
begin
cellNode := FCells.FindLowest;
while Assigned(cellNode) do begin
cell := PCell(cellNode.Data);
if HasFormula(cell) then begin
rpnFormula := BuildRPNFormula(cell);
for i := 0 to Length(rpnFormula)-1 do
begin
fe := rpnFormula[i];
case fe.ElementKind of
fekCell, fekCellRef:
if (fe.Row = ARow) and (fe.Col = ACol) then
begin
Result := true;
exit;
end;
fekCellRange:
if (fe.Row <= ARow) and (ARow <= fe.Row2) and
(fe.Col <= ACol) and (ACol <= fe.Col2) then
begin
Result := true;
exit;
end;
FCells.PushCurrent;
try
cell := FCells.GetFirstCell;
while Assigned(cell) do begin
if HasFormula(cell) then begin
rpnFormula := BuildRPNFormula(cell);
for i := 0 to Length(rpnFormula)-1 do
begin
fe := rpnFormula[i];
case fe.ElementKind of
fekCell, fekCellRef:
if (fe.Row = ARow) and (fe.Col = ACol) then
begin
Result := true;
exit;
end;
fekCellRange:
if (fe.Row <= ARow) and (ARow <= fe.Row2) and
(fe.Col <= ACol) and (ACol <= fe.Col2) then
begin
Result := true;
exit;
end;
end;
end;
end;
cell := FCells.GetNextCell;
end;
cellNode := FCells.FindSuccessor(cellNode);
finally
FCells.PopCurrent;
end;
SetLength(rpnFormula, 0);
end;
@ -1489,9 +1396,6 @@ end;
@param AText Comment text
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteComment(ACell: PCell; AText: String);
var
comment: PsComment;
addNew: Boolean;
begin
if ACell = nil then
exit;
@ -1504,7 +1408,7 @@ begin
end;
// Add new comment record
comment := FComments.AddComment(ACell^.Row, ACell^.Col, AText);
FComments.AddComment(ACell^.Row, ACell^.Col, AText);
Include(ACell^.Flags, cfHasComment);
ChangedCell(ACell^.Row, ACell^.Col);
@ -1728,7 +1632,7 @@ end;
-------------------------------------------------------------------------------}
procedure TsWorksheet.CopyCell(AFromCell, AToCell: PCell);
var
toRow, toCol: Cardinal;
toRow, toCol: LongInt;
row1, col1, row2, col2: Cardinal;
hyperlink: PsHyperlink;
begin
@ -2071,31 +1975,19 @@ end;
{@@ ----------------------------------------------------------------------------
Exchanges two cells
@param ARow1 Row index of the first cell
@param ACol1 Column index of the first cell
@param ARow2 Row index of the second cell
@param ACol2 Column index of the second cell
@param ARow1 Row index of the first cell
@param ACol1 Column index of the first cell
@param ARow2 Row 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);
var
cell1, cell2: PCell;
begin
cell1 := RemoveCell(ARow1, ACol1);
cell2 := RemoveCell(ARow2, ACol2);
if cell1 <> nil then
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;
FCells.Exchange(ARow1, ACol1, ARow2, ACol2);
FComments.Exchange(ARow1, ACol1, ARow2, ACol2);
FHyperlinks.Exchange(ARow1, ACol1, ARow2, ACol2);
end;
{@@ ----------------------------------------------------------------------------
@ -2107,19 +1999,8 @@ end;
@see TCell
-------------------------------------------------------------------------------}
function TsWorksheet.FindCell(ARow, ACol: Cardinal): PCell;
var
LCell: TCell;
AVLNode: TAVLTreeNode;
begin
Result := nil;
if FCells.Count = 0 then
exit;
LCell.Row := ARow;
LCell.Col := ACol;
AVLNode := FCells.Find(@LCell);
if Assigned(AVLNode) then
result := PCell(AVLNode.Data);
Result := PCell(FCells.Find(ARow, ACol));
end;
{@@ ----------------------------------------------------------------------------
@ -2156,15 +2037,10 @@ end;
-------------------------------------------------------------------------------}
function TsWorksheet.GetCell(ARow, ACol: Cardinal): PCell;
begin
Result := FindCell(ARow, ACol);
if (Result = nil) then
Result := Cells.FindCell(ARow, ACol);
if Result = nil then
begin
New(Result);
InitCell(ARow, ACol, Result^);
Result^.Worksheet := self;
Cells.Add(Result);
Result := Cells.AddCell(ARow, ACol);
if FFirstColIndex = $FFFFFFFF then FFirstColIndex := GetFirstColIndex(true)
else FFirstColIndex := Min(FFirstColIndex, ACol);
if FFirstRowIndex = $FFFFFFFF then FFirstRowIndex := GetFirstRowIndex(true)
@ -2203,14 +2079,7 @@ end;
{@@ ----------------------------------------------------------------------------
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
@see TCell
@see GetFirstCell
@see GetNextCell
-------------------------------------------------------------------------------}
function TsWorksheet.GetCellCount: Cardinal;
begin
@ -2294,49 +2163,6 @@ begin
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.
@ -2353,20 +2179,30 @@ end;
-------------------------------------------------------------------------------}
function TsWorksheet.GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal;
var
AVLNode: TAVLTreeNode;
cell: PCell;
i: Integer;
begin
if AForceCalculation then
begin
Result := $FFFFFFFF;
for cell in FCells do
Result := Math.Min(Result, cell^.Col);
(*
// Traverse the tree from lowest to highest.
// Since tree primary sort order is on row lowest col could exist anywhere.
AVLNode := FCells.FindLowest;
while Assigned(AVLNode) do
begin
Result := Math.Min(Result, PCell(AVLNode.Data)^.Col);
AVLNode := FCells.FindSuccessor(AVLNode);
FCells.PushCurrent;
try
cell := FCells.GetFirstCell;
while Assigned(cell) do
begin
Result := Math.Min(Result, cell^.Col);
cell := FCells.GetNextCell;
end;
finally
FCells.PopCurrent;
end;
*)
// In addition, there may be column records defining the column width even
// without content
for i:=0 to FCols.Count-1 do
@ -2444,17 +2280,26 @@ end;
-------------------------------------------------------------------------------}
function TsWorksheet.GetLastOccupiedColIndex: Cardinal;
var
AVLNode: TAVLTreeNode;
cell: PCell;
begin
Result := 0;
// Traverse the tree from lowest to highest.
// Since tree's primary sort order is on row, highest col could exist anywhere.
AVLNode := FCells.FindLowest;
while Assigned(AVLNode) do
begin
Result := Math.Max(Result, PCell(AVLNode.Data)^.Col);
AVLNode := FCells.FindSuccessor(AVLNode);
for cell in FCells do
Result := Math.Max(Result, cell^.Col);
{
FCells.PushCurrent;
try
cell := FCells.GetFirstCell;
while Assigned(cell) do
begin
Result := Math.Max(Result, cell^.Col);
cell := FCells.GetNextCell;
end;
finally
FCells.PopCurrent;
end;
}
end;
{@@ ----------------------------------------------------------------------------
@ -2509,15 +2354,20 @@ end;
-------------------------------------------------------------------------------}
function TsWorksheet.GetFirstRowIndex(AForceCalculation: Boolean = false): Cardinal;
var
AVLNode: TAVLTreeNode;
cell: PCell;
i: Integer;
begin
if AForceCalculation then
begin
Result := $FFFFFFFF;
AVLNode := FCells.FindLowest;
if Assigned(AVLNode) then
Result := PCell(AVLNode.Data).Row;
FCells.PushCurrent;
try
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.
for i:=0 to FRows.Count-1 do
if FRows[i] <> nil then
@ -2579,12 +2429,12 @@ end;
-------------------------------------------------------------------------------}
function TsWorksheet.GetLastOccupiedRowIndex: Cardinal;
var
AVLNode: TAVLTreeNode;
cell: PCell;
begin
Result := 0;
AVLNode := FCells.FindHighest;
if Assigned(AVLNode) then
Result := PCell(AVLNode.Data).Row;
cell := FCells.GetLastCell;
if Assigned(cell) then
Result := cell^.Row;
end;
{@@ ----------------------------------------------------------------------------
@ -3360,7 +3210,6 @@ begin
UnmergeCells(rng.Row1, rng.Col1);
end;
{@@ ----------------------------------------------------------------------------
Finds the upper left cell of a shared formula block to which the specified
cell belongs. This is the "shared formula base".
@ -3529,23 +3378,6 @@ begin
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.
-------------------------------------------------------------------------------}
@ -3558,23 +3390,6 @@ begin
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!
@ -3584,7 +3399,7 @@ end;
-------------------------------------------------------------------------------}
function TsWorksheet.RemoveCell(ARow, ACol: Cardinal): PCell;
begin
Result := FindCell(ARow, ACol);
Result := PCell(FCells.Find(ARow, ACol));
if Result <> nil then FCells.Remove(Result);
end;
@ -3600,18 +3415,8 @@ end;
@param ACol Column index of the cell to be removed
-------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveAndFreeCell(ARow, ACol: Cardinal);
var
cellnode: TAVLTreeNode;
cell: TCell;
begin
// Delete the cell
cell.Row := ARow;
cell.Col := ACol;
cellnode := FCells.Find(@cell);
if cellnode <> nil then begin
Dispose(PCell(cellnode.Data));
FCells.Delete(cellnode);
end;
FCells.DeleteCell(ARow, ACol);
end;
{@@ ----------------------------------------------------------------------------
@ -3871,7 +3676,25 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
until I >= R;
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
if ContainsMergedCells then
raise Exception.Create(rsCannotSortMerged);
FSortParams := ASortParams;
if ASortParams.SortByCols then
QuickSort(ARowFrom, ARowTo)
@ -6117,13 +5940,11 @@ end;
-------------------------------------------------------------------------------}
procedure TsWorksheet.DeleteCol(ACol: Cardinal);
var
AVLNode: TAVLTreeNode;
col: PCol;
i: Integer;
r, rr, cc: Cardinal;
cell, basecell, nextcell: PCell;
firstRow, lastCol, lastRow: Cardinal;
rng: PsCellRange;
begin
lastCol := GetLastColIndex;
lastRow := GetLastOccupiedRowIndex;
@ -6172,10 +5993,15 @@ begin
RemoveAndFreeCell(r, ACol);
// Update column index of cell records
AVLNode := FCells.FindLowest;
while Assigned(AVLNode) do begin
DeleteColCallback(AVLNode.Data, {%H-}pointer(PtrInt(ACol)));
AVLNode := FCells.FindSuccessor(AVLNode);
FCells.PushCurrent;
try
cell := FCells.GetFirstCell;
while Assigned(cell) do begin
DeleteColCallback(cell, {%H-}pointer(PtrInt(ACol)));
cell := FCells.GetNextCell;
end;
finally
FCells.PopCurrent;
end;
// Update column index of col records
@ -6202,13 +6028,11 @@ end;
-------------------------------------------------------------------------------}
procedure TsWorksheet.DeleteRow(ARow: Cardinal);
var
AVLNode: TAVLTreeNode;
row: PRow;
i: Integer;
c, rr, cc: Cardinal;
firstCol, lastCol, lastRow: Cardinal;
cell, nextcell, basecell: PCell;
rng: PsCellRange;
begin
firstCol := GetFirstColIndex;
lastCol := GetLastOccupiedColIndex;
@ -6256,10 +6080,10 @@ begin
RemoveAndFreeCell(ARow, c);
// Update row index of cell records
AVLNode := FCells.FindLowest;
while Assigned(AVLNode) do begin
DeleteRowCallback(AVLNode.Data, {%H-}pointer(PtrInt(ARow)));
AVLNode := FCells.FindSuccessor(AVLNode);
cell := FCells.GetFirstCell;
while Assigned(cell) do begin
DeleteRowCallback(cell, {%H-}pointer(PtrInt(ARow)));
cell := FCells.GetNextCell;
end;
// Update row index of row records
@ -6291,16 +6115,14 @@ var
i: Integer;
r: Cardinal;
cell: PCell;
AVLNode: TAVLTreeNode;
rng: PsCellRange;
begin
// Handling of shared formula references is too complicated for me...
// Split them into isolated cell formulas
AVLNode := FCells.FindLowest;
while Assigned(AVLNode) do begin
cell := PCell(AVLNode.Data);
cell := FCells.GetFirstCell;
while Assigned(cell) do begin
SplitSharedFormula(cell);
AVLNode := FCells.FindSuccessor(AVLNode);
cell := FCells.GetNextCell;
end;
// Update column index of comments
@ -6310,10 +6132,10 @@ begin
FHyperlinks.InsertRowOrCol(ACol, false);
// Update column index of cell records
AVLNode := FCells.FindLowest;
while Assigned(AVLNode) do begin
InsertColCallback(AVLNode.Data, {%H-}pointer(PtrInt(ACol)));
AVLNode := FCells.FindSuccessor(AVLNode);
cell := FCells.GetFirstCell;
while Assigned(cell) do begin
InsertColCallback(cell, {%H-}pointer(PtrInt(ACol)));
cell := FCells.GetNextCell;
end;
// Update column index of column records
@ -6416,16 +6238,14 @@ var
i: Integer;
c: Cardinal;
cell: PCell;
AVLNode: TAVLTreeNode;
rng: PsCellRange;
begin
// Handling of shared formula references is too complicated for me...
// Splits them into isolated cell formulas
AVLNode := FCells.FindLowest;
while Assigned(AVLNode) do begin
cell := PCell(AVLNode.Data);
cell := FCells.GetFirstCell;
while Assigned(cell) do begin
SplitSharedFormula(cell);
AVLNode := FCells.FindSuccessor(AVLNode);
cell := FCells.GetNextCell;
end;
// Update row index of cell comments
@ -6435,10 +6255,10 @@ begin
FHyperlinks.InsertRowOrCol(ARow, true);
// Update row index of cell records
AVLNode := FCells.FindLowest;
while Assigned(AVLNode) do begin
InsertRowCallback(AVLNode.Data, {%H-}pointer(PtrInt(ARow)));
AVLNode := FCells.FindSuccessor(AVLNode);
cell := FCells.GetFirstCell;
while Assigned(cell) do begin
InsertRowCallback(cell, {%H-}pointer(PtrInt(ARow)));
cell := FCells.GetNextCell;
end;
// Update row index of row records
@ -8249,7 +8069,6 @@ end;
-------------------------------------------------------------------------------}
function TsWorkbook.UsesColor(AColorIndex: TsColor): Boolean;
var
Node: TAVLTreeNode;
sheet: TsWorksheet;
cell: PCell;
i: Integer;
@ -8261,10 +8080,9 @@ begin
for i:=0 to GetWorksheetCount-1 do
begin
sheet := GetWorksheetByIndex(i);
Node := sheet.Cells.FindLowest;
while Assigned(Node) do
cell := sheet.Cells.GetFirstCell;
while Assigned(cell) do
begin
cell := PCell(Node.Data);
fmt := GetPointerToCellFormat(cell^.FormatIndex);
if (uffBackground in fmt^.UsedFormattingFields) then
begin
@ -8281,7 +8099,7 @@ begin
if fnt.Color = AColorIndex then
exit;
end;
Node := sheet.Cells.FindSuccessor(Node);
cell := sheet.Cells.GetNextCell;
end;
end;
Result := false;

5
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

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

82
components/fpspreadsheet/fpsreaderwriter.pas
View File

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

9
components/fpspreadsheet/fpsstrings.pas
View File

@ -55,12 +55,14 @@ resourcestring
rsIndexInSSTOutOfRange = 'Index %d in SST out of range (0-%d).';
rsAmbiguousDecThouSeparator = 'Assuming usage of decimal separator in "%s".';
rsCodePageNotSupported = 'Code page "%s" is not supported. Using "cp1252" (Latin 1) instead.';
rsNoValidHyperlinkInternal = 'The hyperlink "%s" is not a valid cell address.';
rsNoValidHyperlinkURI = 'The hyperlink "%s" is not a valid URI.';
rsEmptyHyperlink = 'The hyperlink is not specified.';
rsODSHyperlinksOfTextCellsOnly = 'Cell %s: OpenDocument supports hyperlinks for text cells only.';
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?
rsFALSE = 'FALSE';
@ -73,9 +75,10 @@ resourcestring
rsErrArgError = '#N/A';
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

38
components/fpspreadsheet/fpstypes.pas
View File

@ -531,6 +531,44 @@ type
property Items[AIndex: Integer]: PsCellFormat read GetItem write SetItem; default;
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);

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 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 AString1, AString2: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String); inline; overload;
@ -2051,6 +2054,32 @@ begin
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

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;
SollSortStrings: array[0..9] of String;
CommentIsSortedToStringIndex: Integer;
CommentIsSortedToNumberIndex: Integer;
HyperlinkIsSortedToStringIndex: Integer;
HyperlinkIsSortedToNumberIndex: Integer;
procedure InitUnsortedData;
type
@ -74,7 +79,7 @@ procedure InitUnsortedData;
// The logics of the detection requires equal count of numbers and strings.
begin
// 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[2] := 5;
SollSortNumbers[3] := 2;
@ -85,8 +90,11 @@ begin
SollSortNumbers[8] := 4;
SollSortNumbers[9] := 0;
CommentIsSortedToNumberIndex := 9;
HyperlinkIsSortedToNumberIndex := 9;
// 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[2] := 'F';
SollSortStrings[3] := 'I';
@ -96,6 +104,9 @@ begin
SollSortStrings[7] := 'H';
SollSortStrings[8] := 'E';
SollSortStrings[9] := 'A';
CommentIsSortedToStringIndex := 2;
HyperlinkIsSortedToStringIndex := 2;
end;
@ -120,17 +131,15 @@ var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
i, ilast, n, row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
L: TStringList;
s: String;
sortParams: TsSortParams;
sortOptions: TsSortOptions;
r1,r2,c1,c2: Cardinal;
actualNumber: Double;
actualString: String;
expectedNumber: Double;
expectedString: String;
cell: PCell;
begin
sortParams := InitSortParams(ASortByCols, 1);
@ -145,11 +154,11 @@ begin
row := 0;
if ASortByCols then begin
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]);
1: for i := 0 to High(SollSortStrings) do
1: for i := 0 to High(SollSortStrings) do // Strings only
Myworksheet.WriteUTF8Text(i, col, SollSortStrings[i]);
2: begin
2: begin // Numbers and strings
for i := 0 to High(SollSortNumbers) do
MyWorkSheet.WriteNumber(i*2, col, SollSortNumbers[i]);
for i := 0 to High(SollSortStrings) do
@ -171,6 +180,14 @@ begin
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);
finally
MyWorkbook.Free;
@ -205,7 +222,7 @@ begin
MyWorksheet.Sort(sortParams, 0, 0, 0, iLast);
// for debugging, to see the sorted data
// MyWorkbook.WriteToFile('sorted.xls', AFormat, true);
//MyWorkbook.WriteToFile('sorted.xls', AFormat, true);
row := 0;
col := 0;
@ -223,20 +240,41 @@ begin
end;
case AWhat of
0: begin
actualNumber := MyWorksheet.ReadAsNumber(row, col);
cell := MyWorksheet.FindCell(row, col);
actualNumber := MyWorksheet.ReadAsNumber(cell);
expectedNumber := i;
CheckEquals(expectednumber, actualnumber,
'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;
1: begin
actualString := MyWorksheet.ReadAsUTF8Text(row, col);
cell := MyWorksheet.FindCell(row, col);
actualString := MyWorksheet.ReadAsUTF8Text(cell);
expectedString := char(ord('A') + i);
CheckEquals(expectedstring, actualstring,
'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;
2: begin // with increasing i, we see first the numbers, then the strings
if i <= High(SollSortNumbers) then begin
actualnumber := MyWorksheet.ReadAsNumber(row, col);
cell := MyWorksheet.FindCell(row, col);
actualnumber := MyWorksheet.ReadAsNumber(cell);
expectedNumber := i;
CheckEquals(expectednumber, actualnumber,
'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
@ -346,7 +384,7 @@ begin
MyWorksheet.Sort(sortParams, 0, 0, 1, iLast);
// 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
begin

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

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

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

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

10
components/fpspreadsheet/xlsxooxml.pas
View File

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