diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm index cafd15fd1..370e581a2 100644 --- a/components/fpspreadsheet/examples/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/spready/mainform.lfm @@ -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 diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index ea399a510..f0c53551e 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/components/fpspreadsheet/examples/spready/mainform.pas @@ -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; diff --git a/components/fpspreadsheet/fpscell.pas b/components/fpspreadsheet/fpscell.pas index d15cebe59..d86ebd85e 100644 --- a/components/fpspreadsheet/fpscell.pas +++ b/components/fpspreadsheet/fpscell.pas @@ -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; diff --git a/components/fpspreadsheet/fpsclasses.pas b/components/fpspreadsheet/fpsclasses.pas index b03420510..69dbc00ec 100644 --- a/components/fpspreadsheet/fpsclasses.pas +++ b/components/fpspreadsheet/fpsclasses.pas @@ -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 diff --git a/components/fpspreadsheet/fpsfunc.pas b/components/fpspreadsheet/fpsfunc.pas index 6b4f900f0..6cc60c6b8 100644 --- a/components/fpspreadsheet/fpsfunc.pas +++ b/components/fpspreadsheet/fpsfunc.pas @@ -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); diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index d4edb8f35..c7d9e0918 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -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; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 7ba712a73..6d167baa8 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -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)); diff --git a/components/fpspreadsheet/fpsreaderwriter.pas b/components/fpspreadsheet/fpsreaderwriter.pas index 7c219a28f..360313b9e 100644 --- a/components/fpspreadsheet/fpsreaderwriter.pas +++ b/components/fpspreadsheet/fpsreaderwriter.pas @@ -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; diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index cf5f0b085..df12df086 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/components/fpspreadsheet/fpsstrings.pas @@ -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 = ''; -{%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 diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 963ddd36e..909ce24f1 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -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); diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index b9dbd335d..34d92860f 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -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 diff --git a/components/fpspreadsheet/images/demos/comment-add.png b/components/fpspreadsheet/images/demos/comment-add.png index 19257165b..0205d601e 100644 Binary files a/components/fpspreadsheet/images/demos/comment-add.png and b/components/fpspreadsheet/images/demos/comment-add.png differ diff --git a/components/fpspreadsheet/images/demos/comment-delete.png b/components/fpspreadsheet/images/demos/comment-delete.png index 0205d601e..19257165b 100644 Binary files a/components/fpspreadsheet/images/demos/comment-delete.png and b/components/fpspreadsheet/images/demos/comment-delete.png differ diff --git a/components/fpspreadsheet/tests/enumeratortests.pas b/components/fpspreadsheet/tests/enumeratortests.pas new file mode 100644 index 000000000..d1fdd2b02 --- /dev/null +++ b/components/fpspreadsheet/tests/enumeratortests.pas @@ -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 *10000 + . + 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 + + 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 *10000 + . + 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 + + 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. + diff --git a/components/fpspreadsheet/tests/sortingtests.pas b/components/fpspreadsheet/tests/sortingtests.pas index b1cae49b5..8636ed679 100644 --- a/components/fpspreadsheet/tests/sortingtests.pas +++ b/components/fpspreadsheet/tests/sortingtests.pas @@ -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 diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index 28284f24b..30519e721 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -40,7 +40,7 @@ - + @@ -96,6 +96,7 @@ + @@ -121,6 +122,7 @@ + @@ -131,6 +133,11 @@ + + + + + diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpr b/components/fpspreadsheet/tests/spreadtestgui.lpr index d930de51a..f30e5276d 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpr +++ b/components/fpspreadsheet/tests/spreadtestgui.lpr @@ -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} diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 38db147ce..08bb8dde8 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -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 '', [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,