diff --git a/components/fpspreadsheet/examples/other/demo_sorting.pas b/components/fpspreadsheet/examples/other/demo_sorting.pas index 1bc158ea4..f062c189d 100644 --- a/components/fpspreadsheet/examples/other/demo_sorting.pas +++ b/components/fpspreadsheet/examples/other/demo_sorting.pas @@ -33,7 +33,7 @@ var sortParams := InitSortParams(true, 1); sortParams.Keys[0].ColRowIndex := 0; - sortParams.Keys[0].Order := ssoAscending; + sortParams.Keys[0].Options := []; worksheet.Sort(sortParams, 0, 0, 3, 0); @@ -67,7 +67,7 @@ var sortParams := InitSortParams(false, 1); sortParams.Keys[0].ColRowIndex := 0; - sortParams.Keys[0].Order := ssoAscending; + sortParams.Keys[0].Options := []; worksheet.Sort(sortParams, 0, 0, 0, 3); @@ -111,7 +111,7 @@ var sortParams := InitSortParams(true, 1); sortParams.Keys[0].ColRowIndex := 0; - sortParams.Keys[0].Order := ssoAscending; + sortParams.Keys[0].Options := []; worksheet.Sort(sortParams, 0, 0, 3, 1); @@ -152,7 +152,7 @@ var sortParams := InitSortParams(false, 1); sortParams.Keys[0].ColRowIndex := 0; - sortParams.Keys[0].Order := ssoAscending; + sortParams.Keys[0].Options := []; worksheet.Sort(sortParams, 0, 0, 1, 3); @@ -204,9 +204,9 @@ var sortParams := InitSortParams(true, 2); sortParams.Keys[0].ColRowIndex := 0; - sortParams.Keys[0].Order := ssoAscending; + sortParams.Keys[0].Options := []; sortParams.Keys[1].ColRowIndex := 1; - sortParams.Keys[1].Order := ssoAscending; + sortParams.Keys[1].Options := []; worksheet.Sort(sortParams, 0, 0, 3, 1); @@ -246,9 +246,9 @@ var sortParams := InitSortParams(false, 2); sortParams.Keys[0].ColRowIndex := 0; - sortParams.Keys[0].Order := ssoAscending; + sortParams.Keys[0].Options := []; sortParams.Keys[1].ColRowIndex := 1; - sortParams.Keys[1].Order := ssoAscending; + sortParams.Keys[1].Options := []; worksheet.Sort(sortParams, 0, 0, 1, 3); @@ -314,9 +314,9 @@ var sortParams := InitSortParams(true, 2); sortParams.Keys[0].ColRowIndex := 0; - sortParams.Keys[0].Order := ssoAscending; + sortParams.Keys[0].Options := []; sortParams.Keys[1].ColRowIndex := 1; - sortParams.Keys[1].Order := ssoAscending; + sortParams.Keys[1].Options := []; worksheet.Sort(sortParams, 0, 0, 9, 1); @@ -370,9 +370,9 @@ var sortParams := InitSortParams(false, 2); sortParams.Keys[0].ColRowIndex := 0; - sortParams.Keys[0].Order := ssoAscending; + sortParams.Keys[0].Options := []; sortParams.Keys[1].ColRowIndex := 1; - sortParams.Keys[1].Order := ssoAscending; + sortParams.Keys[1].Options := []; worksheet.Sort(sortParams, 0, 0, 1, 9); diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm index 392c34983..76d32ffab 100644 --- a/components/fpspreadsheet/examples/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/spready/mainform.lfm @@ -4,7 +4,7 @@ object MainFrm: TMainFrm Top = 258 Width = 884 Caption = 'spready' - ClientHeight = 619 + ClientHeight = 614 ClientWidth = 884 Menu = MainMenu OnActivate = FormActivate @@ -14,7 +14,7 @@ object MainFrm: TMainFrm object Panel1: TPanel Left = 0 Height = 82 - Top = 537 + Top = 532 Width = 884 Align = alBottom BevelOuter = bvNone @@ -23,7 +23,7 @@ object MainFrm: TMainFrm TabOrder = 6 object EdFrozenCols: TSpinEdit Left = 429 - Height = 23 + Height = 28 Top = 8 Width = 52 OnChange = EdFrozenColsChange @@ -31,7 +31,7 @@ object MainFrm: TMainFrm end object EdFrozenRows: TSpinEdit Left = 429 - Height = 23 + Height = 28 Top = 39 Width = 52 OnChange = EdFrozenRowsChange @@ -39,37 +39,37 @@ object MainFrm: TMainFrm end object Label1: TLabel Left = 344 - Height = 15 + Height = 20 Top = 13 - Width = 62 + Width = 77 Caption = 'Frozen cols:' FocusControl = EdFrozenCols ParentColor = False end object Label2: TLabel Left = 344 - Height = 15 + Height = 20 Top = 40 - Width = 66 + Width = 82 Caption = 'Frozen rows:' FocusControl = EdFrozenRows ParentColor = False end object CbReadFormulas: TCheckBox Left = 8 - Height = 19 + Height = 24 Top = 8 - Width = 96 + Width = 120 Caption = 'Read formulas' OnChange = CbReadFormulasChange TabOrder = 0 end object CbHeaderStyle: TComboBox Left = 200 - Height = 23 + Height = 28 Top = 8 Width = 116 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 2 Items.Strings = ( 'Lazarus' @@ -83,18 +83,18 @@ object MainFrm: TMainFrm end object CbAutoCalcFormulas: TCheckBox Left = 8 - Height = 19 + Height = 24 Top = 32 - Width = 128 + Width = 158 Caption = 'Calculate on change' OnChange = CbAutoCalcFormulasChange TabOrder = 1 end object CbTextOverflow: TCheckBox Left = 8 - Height = 19 + Height = 24 Top = 56 - Width = 91 + Width = 114 Caption = 'Text overflow' Checked = True OnChange = CbTextOverflowChange @@ -206,19 +206,19 @@ object MainFrm: TMainFrm end object FontComboBox: TComboBox Left = 52 - Height = 23 + Height = 28 Top = 2 Width = 127 - ItemHeight = 15 + ItemHeight = 20 OnSelect = FontComboBoxSelect TabOrder = 0 end object FontSizeComboBox: TComboBox Left = 179 - Height = 23 + Height = 28 Top = 2 Width = 48 - ItemHeight = 15 + ItemHeight = 20 Items.Strings = ( '8' '9' @@ -394,7 +394,7 @@ object MainFrm: TMainFrm TabOrder = 2 object EdCellAddress: TEdit Left = 0 - Height = 23 + Height = 28 Top = 0 Width = 170 Align = alTop @@ -406,7 +406,7 @@ object MainFrm: TMainFrm end object InspectorSplitter: TSplitter Left = 648 - Height = 451 + Height = 446 Top = 86 Width = 5 Align = alRight @@ -414,7 +414,7 @@ object MainFrm: TMainFrm end object InspectorPageControl: TPageControl Left = 653 - Height = 451 + Height = 446 Top = 86 Width = 231 ActivePage = PgCellValue @@ -424,11 +424,11 @@ object MainFrm: TMainFrm OnChange = InspectorPageControlChange object PgCellValue: TTabSheet Caption = 'Cell value' - ClientHeight = 423 + ClientHeight = 413 ClientWidth = 223 object CellInspector: TValueListEditor Left = 0 - Height = 423 + Height = 413 Top = 0 Width = 223 Align = alClient @@ -472,7 +472,7 @@ object MainFrm: TMainFrm end object TabControl: TTabControl Left = 0 - Height = 451 + Height = 446 Top = 86 Width = 648 OnChange = TabControlChange @@ -480,7 +480,7 @@ object MainFrm: TMainFrm TabOrder = 3 object WorksheetGrid: TsWorksheetGrid Left = 2 - Height = 446 + Height = 441 Top = 3 Width = 644 FrozenCols = 0 @@ -498,7 +498,7 @@ object MainFrm: TMainFrm OnHeaderClick = WorksheetGridHeaderClick OnSelection = WorksheetGridSelection ColWidths = ( - 42 + 56 64 64 64 diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index 5762ce244..dee8b5845 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/components/fpspreadsheet/examples/spready/mainform.pas @@ -765,10 +765,7 @@ var begin r := WorksheetGrid.GetWorksheetRow(WorksheetGrid.Row); c := WorksheetGrid.GetWorksheetCol(WorksheetGrid.Col); - SetLength(sortParams.Keys, 1); - sortParams.Keys[0].ColRowIndex := c; - sortParams.Keys[0].Order := ssoAscending; - sortParams.SortByCols := true; + sortParams := InitSortParams; WorksheetGrid.BeginUpdate; try with WorksheetGrid.Worksheet do diff --git a/components/fpspreadsheet/examples/spready/spready.lpi b/components/fpspreadsheet/examples/spready/spready.lpi index 457404471..b4a42713e 100644 --- a/components/fpspreadsheet/examples/spready/spready.lpi +++ b/components/fpspreadsheet/examples/spready/spready.lpi @@ -111,10 +111,12 @@ + + @@ -122,6 +124,7 @@ + diff --git a/components/fpspreadsheet/examples/spready/ssortparamsform.lfm b/components/fpspreadsheet/examples/spready/ssortparamsform.lfm index 0ea1c5efd..9de9e7ea6 100644 --- a/components/fpspreadsheet/examples/spready/ssortparamsform.lfm +++ b/components/fpspreadsheet/examples/spready/ssortparamsform.lfm @@ -1,17 +1,17 @@ object SortParamsForm: TSortParamsForm - Left = 361 - Height = 303 - Top = 177 - Width = 374 + Left = 434 + Height = 314 + Top = 274 + Width = 485 Caption = 'Sorting criteria' - ClientHeight = 303 - ClientWidth = 374 + ClientHeight = 314 + ClientWidth = 485 LCLVersion = '1.3' object ButtonPanel: TButtonPanel Left = 6 - Height = 34 - Top = 263 - Width = 362 + Height = 38 + Top = 270 + Width = 473 OKButton.Name = 'OKButton' OKButton.DefaultCaption = True OKButton.OnClick = OKButtonClick @@ -26,28 +26,34 @@ object SortParamsForm: TSortParamsForm end object Grid: TStringGrid Left = 0 - Height = 207 + Height = 214 Top = 50 - Width = 374 + Width = 485 Align = alClient - ColCount = 3 + ColCount = 4 Columns = < item ButtonStyle = cbsPickList - ReadOnly = False Title.Caption = 'Column' Width = 120 end item - ButtonStyle = cbsPickList + ButtonStyle = cbsCheckboxColumn PickList.Strings = ( - 'A to Z (ascending)' - 'Z to A (descending)' + 'ascending' + 'descending' ) - Title.Caption = 'Direction' - Width = 150 + Title.Alignment = taCenter + Title.Caption = 'Descending' + Width = 120 + end + item + ButtonStyle = cbsCheckboxColumn + Title.Alignment = taCenter + Title.Caption = 'Ignore case' + Width = 120 end> - DefaultColWidth = 100 + DefaultColWidth = 120 Options = [goFixedVertLine, goFixedHorzLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll] RowCount = 2 TabOrder = 1 @@ -64,11 +70,11 @@ object SortParamsForm: TSortParamsForm Left = 0 Height = 50 Top = 0 - Width = 374 + Width = 485 Align = alTop BevelOuter = bvNone ClientHeight = 50 - ClientWidth = 374 + ClientWidth = 485 TabOrder = 2 object BtnAdd: TBitBtn Left = 7 @@ -161,11 +167,11 @@ object SortParamsForm: TSortParamsForm TabOrder = 1 end object CbSortColsRows: TComboBox - Left = 186 - Height = 23 - Top = 13 + Left = 185 + Height = 28 + Top = 11 Width = 160 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'Sort top to bottom' @@ -176,5 +182,20 @@ object SortParamsForm: TSortParamsForm TabOrder = 2 Text = 'Sort top to bottom' end + object CbPriority: TComboBox + Left = 353 + Height = 28 + Top = 11 + Width = 120 + ItemHeight = 20 + ItemIndex = 0 + Items.Strings = ( + 'Numbers first' + 'Text first' + ) + Style = csDropDownList + TabOrder = 3 + Text = 'Numbers first' + end end end diff --git a/components/fpspreadsheet/examples/spready/ssortparamsform.pas b/components/fpspreadsheet/examples/spready/ssortparamsform.pas index 182182fda..476d80401 100644 --- a/components/fpspreadsheet/examples/spready/ssortparamsform.pas +++ b/components/fpspreadsheet/examples/spready/ssortparamsform.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, - ButtonPanel, Grids, ExtCtrls, Buttons, StdCtrls, + ButtonPanel, Grids, ExtCtrls, Buttons, StdCtrls, ComboEx, fpspreadsheet, fpspreadsheetgrid; type @@ -18,6 +18,7 @@ type BtnDelete: TBitBtn; ButtonPanel: TButtonPanel; CbSortColsRows: TComboBox; + CbPriority: TComboBox; TopPanel: TPanel; Grid: TStringGrid; procedure BtnAddClick(Sender: TObject); @@ -83,6 +84,9 @@ begin exit; // there can't be more conditions than defined by the worksheetgrid selection Grid.RowCount := Grid.RowCount + 1; Grid.Cells[0, Grid.RowCount-1] := 'Then by'; + Grid.Cells[1, Grid.RowCount-1] := ''; + Grid.Cells[2, Grid.RowCount-1] := '0'; + Grid.Cells[3, Grid.RowCount-1] := '0'; UpdateCmds; end; @@ -99,13 +103,20 @@ function TSortParamsForm.GetSortParams: TsSortParams; var i, p: Integer; n: Cardinal; - sortDir: TsSortOrder; + sortOptions: TsSortOptions; s: String; begin - Result.SortByCols := CbSortColsRows.ItemIndex = 0; - SetLength(Result.Keys, 0); + // Sort by column or rows? + Result := InitSortParams(CbSortColsRows.ItemIndex = 0, 0); + + // Number before Text, or reversed? + Result.Priority := TsSortPriority(CbPriority.ItemIndex); + for i:=Grid.FixedRows to Grid.RowCount-1 do begin + sortOptions := []; + + // Sort index column s := Grid.Cells[1, i]; // the cell text is "Column A" or "Row A" if s = '' then raise Exception.Create('[TSortParamsForm.GetSortParams] No sort index selected.'); @@ -126,20 +137,22 @@ begin 'Unexpected row identifier in row %s', [i]); end; + // Sort order column s := Grid.Cells[2, i]; if s = '' then raise Exception.Create('[TSortParamsForm.GetSortParams] No sort direction selected.'); + if s = '1' then + Include(sortOptions, ssoDescending); - // These strings are 'A to Z' or 'Z to A', so we look just for the first character. - case s[1] of - 'A': sortDir := ssoAscending; - 'Z': sortDir := ssoDescending; - end; + // Case sensitivity column + s := Grid.Cells[3, i]; + if s = '1' then + Include(sortOptions, ssoCaseInsensitive); SetLength(Result.Keys, Length(Result.Keys) + 1); with Result.Keys[Length(Result.Keys)-1] do begin - Order := sortDir; + Options := sortOptions; ColRowIndex := n; end; end; // for @@ -150,8 +163,9 @@ begin FWorksheetGrid := AValue; UpdateColRowList; UpdateCmds; - Grid.Cells[1, 1] := Grid.Columns[0].PickList[0]; - Grid.Cells[2, 1] := Grid.Columns[1].PickList[0]; + Grid.Cells[1, 1] := Grid.Columns[0].PickList[0]; // Sorting index + Grid.Cells[2, 1] := '0'; // Ascending sort order Grid.Columns[1].CheckedPickList[0]; + Grid.Cells[3, 1] := '0'; // case-sensitive comparisons end; procedure TSortParamsForm.UpdateColRowList; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 5c92cfd32..e3d6e8419 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -442,8 +442,12 @@ type {@@ Pointer to a TCol record } PCol = ^TCol; - {@@ Sort order } - TsSortOrder = (ssoAscending, ssoDescending); + {@@ Sort options } + TsSortOption = (ssoDescending, ssoCaseInsensitive); + TsSortOptions = set of TsSortOption; + +// {@@ Sort order } +// TsSortOrder = (ssoAscending, ssoDescending); {@@ Sort priority } TsSortPriority = (spNumAlpha, spAlphaNum); // NumAlph = "number < alpha" @@ -451,7 +455,8 @@ type {@@ Sort key: sorted column or row index and sort direction } TsSortKey = record ColRowIndex: Integer; - Order: TsSortOrder; + Options: TsSortOptions; +// Order: TsSortOrder; end; {@@ Array of sort keys for multiple sorting criteria } @@ -543,9 +548,9 @@ type // Sorting function DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal; - ASortOrder: TsSortOrder): Integer; + ASortOptions: TsSortOptions): Integer; function DoInternalCompareCells(ACell1, ACell2: PCell; - ASortOrder: TsSortOrder): Integer; + ASortOptions: TsSortOptions): Integer; procedure DoExchangeColRow(AIsColumn: Boolean; AIndex, WithIndex: Cardinal; AFromIndex, AToIndex: Cardinal); @@ -3206,24 +3211,25 @@ end; found to be "equal" the next parameter is set is used until a difference is found, or all parameters are used. - @param ARow1 Row index of the first cell to be compared - @param ACol1 Column index of the first cell to be compared - @param ARow2 Row index of the second cell to be compared - @parem ACol2 Column index of the second cell to be compared + @param ARow1 Row index of the first cell to be compared + @param ACol1 Column index of the first cell to be compared + @param ARow2 Row index of the second cell to be compared + @parem ACol2 Column index of the second cell to be compared + @param ASortOptions Sorting options: case-insensitive and/or descending @return -1 if the first cell is "smaller", i.e. is sorted in front of the second one +1 if the first cell is "larger", i.e. is behind the second one 0 if both cells are equal ------------------------------------------------------------------------------- } function TsWorksheet.DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal; - ASortOrder: TsSortOrder): Integer; + ASortOptions: TsSortOptions): Integer; var cell1, cell2: PCell; // Pointers to the cells to be compared key: Integer; begin cell1 := FindCell(ARow1, ACol1); cell2 := FindCell(ARow2, ACol2); - Result := DoInternalCompareCells(cell1, cell2, ASortOrder); + Result := DoInternalCompareCells(cell1, cell2, ASortOptions); if Result = 0 then begin key := 1; while (Result = 0) and (key <= High(FSortParams.Keys)) do @@ -3237,7 +3243,7 @@ begin cell1 := FindCell(FSortParams.Keys[key].ColRowIndex, ACol1); cell2 := FindCell(FSortParams.Keys[key].ColRowIndex, ACol2); end; - Result := DoInternalCompareCells(cell1, cell2, ASortOrder); + Result := DoInternalCompareCells(cell1, cell2, ASortOptions); inc(key); end; end; @@ -3246,9 +3252,9 @@ end; {@@ ---------------------------------------------------------------------------- Compare function for sorting of rows and columns. Called by DoCompareCells. - @param ACell1 Pointer to the first cell of the comparison - @param ACell2 Pointer to the second cell of the comparison - @param ASortOrder Order of sorting, ascending or descending + @param ACell1 Pointer to the first cell of the comparison + @param ACell2 Pointer to the second cell of the comparison + @param ASortOptions Options for sorting: descending and/or case-insensitive @return -1 if the first cell is "smaller" +1 if the first cell is "larger", 0 if both cells are "equal" @@ -3263,7 +3269,7 @@ end; order) -------------------------------------------------------------------------------} function TsWorksheet.DoInternalCompareCells(ACell1, ACell2: PCell; - ASortOrder: TsSortOrder): Integer; + ASortOptions: TsSortOptions): Integer; // Sort priority in Excel: // numbers < alpha < blank (ascending) // alpha < numbers < blank (descending) @@ -3278,21 +3284,33 @@ begin if (ACell1 = nil) and (ACell2 = nil) then Result := 0 else - if (ACell1 = nil) or (ACell2 = nil) then + if (ACell1 = nil) or (ACell1^.ContentType = cctEmpty) then begin - Result := +1; // Empty cells go to the end - exit; // Avoid SortOrder to bring the empty cell to the top! + Result := +1; // Empty cells go to the end + exit; // Avoid SortOrder to bring the empty cell to the top! + end else + if (ACell2 = nil) or (ACell2^.ContentType = cctEmpty) then + begin + Result := -1; // Empty cells go to the end + exit; // Avoid SortOrder to bring the empty cell to the top! end else if (ACell1^.ContentType = cctEmpty) and (ACell2^.ContentType = cctEmpty) then Result := 0 - else if (ACell1^.ContentType = cctEmpty) or (ACell2^.ContentType = cctEmpty) then + else + { + if (ACell1^.ContentType = cctEmpty) or (ACell2^.ContentType = cctEmpty) then begin Result := +1; // Empty cells go to the end exit; // Avoid SortOrder to bring the empty cell back to the top end else + } if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then - Result := CompareText(ACell1^.UTF8StringValue, ACell2^.UTF8StringValue) - else + begin + if ssoCaseInsensitive in ASortOptions then + Result := UTF8CompareText(ACell1^.UTF8StringValue, ACell2^.UTF8StringValue) + else + Result := UTF8CompareStr(ACell1^.UTF8StringValue, ACell2^.UTF8StringValue); + end else if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType <> cctUTF8String) then case FSortParams.Priority of spNumAlpha: Result := +1; // numbers before text @@ -3311,7 +3329,7 @@ begin Result := CompareValue(number1, number2); end; end; - if ASortOrder = ssoDescending then + if ssoDescending in ASortOptions then Result := -Result; end; @@ -3376,20 +3394,17 @@ end; -------------------------------------------------------------------------------} procedure TsWorksheet.Sort(const ASortParams: TsSortParams; ARowFrom, AColFrom, ARowTo, AColTo: Cardinal); +// code "borrowed" from grids.pas and adapted to multi-key sorting procedure QuickSort(L,R: Integer); var I,J,K: Integer; P: Integer; index: Integer; - order: TsSortOrder; - { - cell1, cell2: PCell; - compareResult: Integer; - } + options: TsSortOptions; begin index := ASortParams.Keys[0].ColRowIndex; // less typing... - order := ASortParams.Keys[0].Order; + options := ASortParams.Keys[0].Options; repeat I := L; J := R; @@ -3397,223 +3412,25 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams; repeat if ASortParams.SortByCols then begin - while DoCompareCells(P, index, I, index, order) > 0 do inc(I); - while DoCompareCells(P, index, J, index, order) < 0 do dec(J); + while DoCompareCells(P, index, I, index, options) > 0 do inc(I); + while DoCompareCells(P, index, J, index, options) < 0 do dec(J); end else begin - while DoCompareCells(index, P, index, I, order) > 0 do inc(I); - while DoCompareCells(index, P, index, J, order) < 0 do dec(J); + while DoCompareCells(index, P, index, I, options) > 0 do inc(I); + while DoCompareCells(index, P, index, J, options) < 0 do dec(J); end; - - { original code from "grids.pas": - - if ColSorting then begin - while DoCompareCells(index, P, index, I)>0 do I:=I+1; - while DoCompareCells(index, P, index, J)<0 do J:=J-1; - end else begin - while DoCompareCells(P, index, I, index)>0 do I:=I+1; - while DoCompareCells(P, index, J, index)<0 do J:=J-1; - end; } - { - if ASortParams.SortByCols then - begin - (* - // Sorting by columns - // The next "while" loop corresponds to grid's: - // while DoCompareCells(index, P, index, I) > 0 do I:=I+1; - while true do - begin - cell1 := FindCell(P, ASortParams.Keys[0].ColRowIndex); - cell2 := FindCell(I, ASortParams.Keys[0].ColRowIndex); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[0].Order); - if compareResult < 0 then - break - else - if compareResult > 0 then - inc(I) - else - begin - // equal --> check next condition - K := 1; - while (K <= High(ASortParams.Keys)) do - begin - cell1 := FindCell(P, ASortParams.Keys[K].ColRowIndex); - cell2 := FindCell(I, ASortParams.Keys[K].ColRowIndex); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[K].Order); - if compareResult < 0 then - break - else - if compareResult > 0 then begin - inc(I); - break; - end else - inc(K); // Still equal --> try next condition - end; - if compareResult <= 0 then - break; - end; - end; - - // The next "while" loop corresponds to grid's: - // while DoCompareCells(index, P, index, J)<0 do J:=J-1; - while true do - begin - cell1 := FindCell(P, ASortParams.Keys[0].ColRowIndex); - cell2 := FindCell(J, ASortParams.Keys[0].ColRowIndex); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[0].Order); - if compareResult < 0 then - dec(J) - else - if compareResult > 0 then - break - else begin // equal --> check next condition - K := 1; - while (K <= High(ASortParams.Keys)) do - begin - cell1 := FindCell(P, ASortParams.Keys[K].ColRowIndex); - cell2 := FindCell(J, ASortParams.Keys[K].ColRowIndex); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[K].Order); - case abs(compareResult) of - -1: begin dec(J); break; end; - +1: break; - 0: inc(K); - end; - end; - if compareResult >= 0 then - break; - end; - end; - *) - K := 0; - while true do - begin - cell1 := FindCell(P, ASortParams.Keys[K].ColRowIndex); - cell2 := FindCell(I, ASortParams.Keys[K].ColRowIndex); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[K].Order); - case sign(compareResult) of - -1: break; - 0: if K <= High(ASortParams.Keys) then inc(K) else break; - +1: begin inc(I); K:= 0; end; - end; - end; - - K := 0; - while true do - begin - cell1 := FindCell(P, ASortParams.Keys[K].ColRowIndex); - cell2 := FindCell(J, ASortParams.Keys[K].ColRowIndex); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[K].Order); - case sign(compareResult) of - -1: begin dec(J); K := 0; end; - 0: if K <= High(ASortParams.Keys) then inc(K) else break; - +1: break; - end; - end; - end else - begin - // Sorting by rows - K := 0; - while true do - begin - cell1 := FindCell(ASortParams.Keys[K].ColRowIndex, P); - cell2 := FindCell(ASortParams.Keys[K].ColRowIndex, I); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[K].Order); - case sign(compareResult) of - -1: break; - 0: if K <= High(ASortParams.Keys) then inc(K) else break; - +1: begin inc(I); if K > 0 then K := 0; end; - end; - end; - K := 0; - while true do - begin - cell1 := FindCell(ASortParams.Keys[K].ColRowIndex, P); - cell2 := FindCell(ASortParams.Keys[K].ColRowIndex, J); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[K].Order); - case sign(compareResult) of - -1: begin dec(J); if K > 0 then K := 0; end; - 0: if K <= High(ASortParams.Keys) then inc(K) else break; - +1: break; - end; - end; - (* - while true do - begin - cell1 := FindCell(ASortParams.Keys[0].ColRowIndex, P); - cell2 := FindCell(ASortParams.Keys[0].ColRowIndex, I); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[0].Order); - case sign(compareresult) of - -1: break; - +1: inc(I); - 0: begin - K := 1; - while (compareResult=0) and (K <= High(ASortParams.Keys)) do - begin - cell1 := FindCell(ASortParams.Keys[K].ColRowIndex, P); - cell2 := FindCell(ASortParams.Keys[K].ColRowIndex, I); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[K].Order); - if compareResult = 0 then - continue - else begin - if compareresult > 0 then inc(I); - break; - end; - end; - if compareResult < 0 then break; - end; - end; - end; - while true do - begin - cell1 := FindCell(ASortParams.Keys[0].ColRowIndex, P); - cell2 := FindCell(ASortParams.Keys[0].ColRowIndex, J); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[0].Order); - case sign(compareResult) of - -1: dec(J); - +1: break; - 0: begin - K := 1; - while (compareResult=0) and (K <= High(ASortParams.Keys)) do - begin - cell1 := FindCell(ASortParams.Keys[0].ColRowIndex, P); - cell2 := FindCell(ASortParams.Keys[0].ColRowIndex, J); - compareResult := DoCompareCells(cell1, cell2, ASortParams.Keys[K].Order); - if compareResult = 0 then - continue - else begin - if compareResult < 0 then dec(J); - break; - end; - end; - if compareResult > 0 then break; - end; - end; - end; - *) - end; } - if I <= J then begin if I <> J then begin if ASortParams.SortByCols then begin - if DoCompareCells(I, index, J, index, order) <> 0 then - { - cell1 := FindCell(I, ASortParams.Keys[0].ColRowIndex); - cell2 := FIndCell(J, ASortParams.Keys[0].ColRowIndex); - if DoCompareCells(cell1, cell2, ASortParams.Keys[0].Order) <> 0 then - } + if DoCompareCells(I, index, J, index, options) <> 0 then DoExchangeColRow(not ASortParams.SortByCols, J,I, AColFrom, AColTo); end else begin - if DoCompareCells(index, I, index, J, order) <> 0 then - { - cell1 := FindCell(ASortParams.Keys[0].ColRowIndex, I); - cell2 := FIndCell(ASortParams.Keys[0].ColRowIndex, J); - if DoCompareCells(cell1, cell2, ASortParams.Keys[0].Order) <> 0 then - } + if DoCompareCells(index, I, index, J, options) <> 0 then DoExchangeColRow(not ASortParams.SortByCols, J,I, ARowFrom, ARowTo); end; end; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 10316162b..9343ddd3f 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -2373,7 +2373,8 @@ end; ColRowIndexes refer to row indexes Default: true @param ANumSortKeys Determines how many columns or rows are used as sorting - keys. (Default: 1) + keys. (Default: 1). Every sort key is initialized for + ascending sort direction and case-sensitive comparison. @param ASortPriority Determines the order or text and numeric data in mixed content type cell ranges. Default: spNumAlpha, i.e. numbers before text (in @@ -2389,8 +2390,8 @@ begin Result.Priority := spNumAlpha; // numbers before text, like in Excel SetLength(Result.Keys, ANumSortKeys); for i:=0 to High(Result.Keys) do begin - Result.Keys[i].ColRowIndex := 0; - Result.Keys[i].Order := ssoAscending; + Result.Keys[i].ColRowIndex := i; + Result.Keys[i].Options := []; // Ascending & case-sensitive end; end; diff --git a/components/fpspreadsheet/tests/sortingtests.pas b/components/fpspreadsheet/tests/sortingtests.pas index 9b769aa99..e960ad31c 100644 --- a/components/fpspreadsheet/tests/sortingtests.pas +++ b/components/fpspreadsheet/tests/sortingtests.pas @@ -32,23 +32,33 @@ type procedure Test_Sorting_1( // one column or row ASortByCols: Boolean; - AMode: Integer // AMode = 0: number, 1: strings, 2: mixed + ADescending: Boolean; // true: desending order + AWhat: Integer // What = 0: number, 1: strings, 2: mixed ); procedure Test_Sorting_2( // two columns/rows, primary keys equal - ASortByCols: Boolean + ASortByCols: Boolean; + ADescending: Boolean ); published - procedure Test_SortingByCols1_Numbers; - procedure Test_SortingByCols1_Strings; - procedure Test_SortingByCols1_NumbersStrings; + procedure Test_SortingByCols1_Numbers_Asc; + procedure Test_SortingByCols1_Numbers_Desc; + procedure Test_SortingByCols1_Strings_Asc; + procedure Test_SortingByCols1_Strings_Desc; + procedure Test_SortingByCols1_NumbersStrings_Asc; + procedure Test_SortingByCols1_NumbersStrings_Desc; - procedure Test_SortingByRows1_Numbers; - procedure Test_SortingByRows1_Strings; - procedure Test_SortingByRows1_NumbersStrings; + procedure Test_SortingByRows1_Numbers_Asc; + procedure Test_SortingByRows1_Numbers_Desc; + procedure Test_SortingByRows1_Strings_Asc; + procedure Test_SortingByRows1_Strings_Desc; + procedure Test_SortingByRows1_NumbersStrings_Asc; + procedure Test_SortingByRows1_NumbersStrings_Desc; - procedure Test_SortingByCols2; - procedure Test_SortingByRows2; + procedure Test_SortingByCols2_Asc; + procedure Test_SortingByCols2_Desc; + procedure Test_SortingByRows2_Asc; + procedure Test_SortingByRows2_Desc; end; @@ -103,7 +113,7 @@ begin end; procedure TSpreadSortingTests.Test_Sorting_1(ASortByCols: Boolean; - AMode: Integer); + ADescending: Boolean; AWhat: Integer); const AFormat = sfExcel8; var @@ -115,7 +125,7 @@ var L: TStringList; s: String; sortParams: TsSortParams; - sortDir: TsSortOrder; + sortOptions: TsSortOptions; r1,r2,c1,c2: Cardinal; actualNumber: Double; actualString: String; @@ -134,7 +144,7 @@ begin col := 0; row := 0; if ASortByCols then begin - case AMode of + case AWhat of 0: for i :=0 to High(SollSortNumbers) do MyWorksheet.WriteNumber(i, col, SollSortNumbers[i]); 1: for i := 0 to High(SollSortStrings) do @@ -148,7 +158,7 @@ begin end end else begin - case AMode of + case AWhat of 0: for i := 0 to High(SollSortNumbers) do MyWorksheet.WriteNumber(row, i, SollSortNumbers[i]); 1: for i := 0 to High(SollSortStrings) do @@ -166,92 +176,89 @@ begin MyWorkbook.Free; end; - // Test ascending and descending sort orders - for sortDir in TsSortOrder do - begin - MyWorkbook := TsWorkbook.Create; - try - // Read spreadsheet file... - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, SortingTestSheet); - if MyWorksheet = nil then - fail('Error in test code. Failed to get named worksheet'); + MyWorkbook := TsWorkbook.Create; + try + // Read spreadsheet file... + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, SortingTestSheet); + if MyWorksheet = nil then + fail('Error in test code. Failed to get named worksheet'); - // ... and sort it. - case AMode of - 0: iLast:= High(SollSortNumbers); - 1: iLast := High(SollSortStrings); - 2: iLast := Length(SollSortNumbers) + Length(SollSortStrings) - 1; - end; - r1 := 0; - r2 := 0; - c1 := 0; - c2 := 0; + // ... set up sorting direction + case ADescending of + false: sortParams.Keys[0].Options := []; // Ascending sort + true : sortParams.Keys[0].Options := [ssoDescending]; // Descending sort + end; + + // ... and sort it. + case AWhat of + 0: iLast:= High(SollSortNumbers); + 1: iLast := High(SollSortStrings); + 2: iLast := Length(SollSortNumbers) + Length(SollSortStrings) - 1; + end; + if ASortByCols then + MyWorksheet.Sort(sortParams, 0, 0, iLast, 0) + else + MyWorksheet.Sort(sortParams, 0, 0, 0, iLast); + + // for debugging, to see the sorted data + // MyWorkbook.WriteToFile('sorted.xls', AFormat, true); + + row := 0; + col := 0; + for i:=0 to iLast do + begin if ASortByCols then - r2 := iLast + case ADescending of + false: row := i; // ascending + true : row := iLast - i; // descending + end else - c2 := iLast; - sortParams.Keys[0].Order := sortDir; - MyWorksheet.Sort(sortParams, r1,c1, r2, c2); - - // for debugging, to see the sorted data - // MyWorkbook.WriteToFile('sorted.xls', AFormat, true); - - row := 0; - col := 0; - for i:=0 to iLast do - begin - if ASortByCols then - case sortDir of - ssoAscending : row := i; - ssoDescending: row := iLast - i; - end - else - case sortDir of - ssoAscending : col := i; - ssoDescending: col := iLast - i; - end; - case AMode of - 0: begin - actualNumber := MyWorksheet.ReadAsNumber(row, col); + case ADescending of + false: col := i; // ascending + true : col := iLast - i; // descending + end; + case AWhat of + 0: begin + actualNumber := MyWorksheet.ReadAsNumber(row, col); + expectedNumber := i; + CheckEquals(expectednumber, actualnumber, + 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col)); + end; + 1: begin + actualString := MyWorksheet.ReadAsUTF8Text(row, col); + expectedString := char(ord('A') + i); + CheckEquals(expectedstring, actualstring, + 'Sorted cell string 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); expectedNumber := i; CheckEquals(expectednumber, actualnumber, 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col)); - end; - 1: begin - actualString := MyWorksheet.ReadAsUTF8Text(row, col); - expectedString := char(ord('A') + i); + end else begin + actualstring := MyWorksheet.ReadAsUTF8Text(row, col); + expectedstring := char(ord('A') + i - Length(SollSortNumbers)); CheckEquals(expectedstring, actualstring, 'Sorted cell string 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); - expectedNumber := i; - CheckEquals(expectednumber, actualnumber, - 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col)); - end else begin - actualstring := MyWorksheet.ReadAsUTF8Text(row, col); - expectedstring := char(ord('A') + i - Length(SollSortNumbers)); - CheckEquals(expectedstring, actualstring, - 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col)); - end; - end; - end; + end; end; - - finally - MyWorkbook.Free; end; - end; // for sortDir + + finally + MyWorkbook.Free; + end; DeleteFile(TempFile); end; -procedure TSpreadSortingTests.Test_Sorting_2(ASortByCols: Boolean); +procedure TSpreadSortingTests.Test_Sorting_2(ASortByCols: Boolean; + ADescending: Boolean); const AFormat = sfExcel8; var @@ -263,7 +270,7 @@ var L: TStringList; s: String; sortParams: TsSortParams; - sortDir: TsSortOrder; + sortOptions: TsSortOptions; r1,r2,c1,c2: Cardinal; actualNumber: Double; actualString: String; @@ -310,121 +317,169 @@ begin MyWorkbook.Free; end; - // Test ascending and descending sort orders - for sortDir in TsSortOrder do - begin - MyWorkbook := TsWorkbook.Create; - try - // Read spreadsheet file... - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, SortingTestSheet); - if MyWorksheet = nil then - fail('Error in test code. Failed to get named worksheet'); + MyWorkbook := TsWorkbook.Create; + try + // Read spreadsheet file... + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, SortingTestSheet); + if MyWorksheet = nil then + fail('Error in test code. Failed to get named worksheet'); - // ... and sort it. - sortParams.Keys[0].Order := sortDir; - sortParams.Keys[1].Order := sortDir; - if ASortByCols then - MyWorksheet.Sort(sortParams, 0, 0, iLast, 1) - else - MyWorksheet.Sort(sortParams, 0, 0, 1, iLast); - - // for debugging, to see the sorted data - MyWorkbook.WriteToFile('sorted.xls', AFormat, true); - - for i:=0 to iLast do - begin - if ASortByCols then - begin - // Read the number first, they must be in order 0...9 (if ascending). - col := 1; - case sortDir of - ssoAscending : row := i; - ssoDescending: row := iLast - i; - end; - actualNumber := MyWorksheet.ReadAsNumber(row, col); // col B is the number, must be 0...9 here - expectedNumber := i; - CheckEquals(expectednumber, actualnumber, - 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col)); - - // Now read the string. It must be the character corresponding to the - // half of the number - col := 0; - actualString := MyWorksheet.ReadAsUTF8Text(row, col); - expectedString := char(ord('A') + round(expectedNumber) div 2); - CheckEquals(expectedstring, actualstring, - 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col)); - end else - begin - row := 1; - case sortDir of - ssoAscending : col := i; - ssoDescending: col := iLast - i; - end; - actualNumber := MyWorksheet.ReadAsNumber(row, col); - expectedNumber := i; - CheckEquals(expectednumber, actualnumber, - 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col)); - - row := 0; - actualstring := MyWorksheet.ReadAsUTF8Text(row, col); - expectedString := char(ord('A') + round(expectedNumber) div 2); - CheckEquals(expectedstring, actualstring, - 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col)); - end; - end; - finally - MyWorkbook.Free; + // ... set up sort direction + if ADescending then + begin + sortParams.Keys[0].Options := [ssoDescending]; + sortParams.Keys[1].Options := [ssoDescending]; + end else + begin + sortParams.Keys[0].Options := []; + sortParams.Keys[1].Options := []; end; - end; // for sortDir + + // ... and sort it. + if ASortByCols then + MyWorksheet.Sort(sortParams, 0, 0, iLast, 1) + else + MyWorksheet.Sort(sortParams, 0, 0, 1, iLast); + + // for debugging, to see the sorted data + MyWorkbook.WriteToFile('sorted.xls', AFormat, true); + + for i:=0 to iLast do + begin + if ASortByCols then + begin + // Read the number first, they must be in order 0...9 (if ascending). + col := 1; + case ADescending of + false : row := i; + true : row := iLast - i; + end; + actualNumber := MyWorksheet.ReadAsNumber(row, col); // col B is the number, must be 0...9 here + expectedNumber := i; + CheckEquals(expectednumber, actualnumber, + 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col)); + + // Now read the string. It must be the character corresponding to the + // half of the number + col := 0; + actualString := MyWorksheet.ReadAsUTF8Text(row, col); + expectedString := char(ord('A') + round(expectedNumber) div 2); + CheckEquals(expectedstring, actualstring, + 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col)); + end else + begin + row := 1; + case ADescending of + false : col := i; + true : col := iLast - i; + end; + actualNumber := MyWorksheet.ReadAsNumber(row, col); + expectedNumber := i; + CheckEquals(expectednumber, actualnumber, + 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col)); + + row := 0; + actualstring := MyWorksheet.ReadAsUTF8Text(row, col); + expectedString := char(ord('A') + round(expectedNumber) div 2); + CheckEquals(expectedstring, actualstring, + 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col)); + end; + end; + finally + MyWorkbook.Free; + end; DeleteFile(TempFile); end; - -procedure TSpreadSortingTests.Test_SortingByCols1_Numbers; +{ Sort 1 column } +procedure TSpreadSortingTests.Test_SortingByCols1_Numbers_ASC; begin - Test_Sorting_1(true, 0); + Test_Sorting_1(true, false, 0); end; -procedure TSpreadSortingTests.Test_SortingByCols1_Strings; +procedure TSpreadSortingTests.Test_SortingByCols1_Numbers_DESC; begin - Test_Sorting_1(true, 1); + Test_Sorting_1(true, true, 0); end; -procedure TSpreadSortingTests.Test_SortingByCols1_NumbersStrings; +procedure TSpreadSortingTests.Test_SortingByCols1_Strings_ASC; begin - Test_Sorting_1(true, 2); + Test_Sorting_1(true, false, 1); end; -procedure TSpreadSortingTests.Test_SortingByRows1_Numbers; +procedure TSpreadSortingTests.Test_SortingByCols1_Strings_DESC; begin - Test_Sorting_1(false, 0); + Test_Sorting_1(true, true, 1); end; -procedure TSpreadSortingTests.Test_SortingByRows1_Strings; +procedure TSpreadSortingTests.Test_SortingByCols1_NumbersStrings_ASC; begin - Test_Sorting_1(false, 1); + Test_Sorting_1(true, false, 2); end; -procedure TSpreadSortingTests.Test_SortingByRows1_NumbersStrings; +procedure TSpreadSortingTests.Test_SortingByCols1_NumbersStrings_DESC; begin - Test_Sorting_1(false, 2); + Test_Sorting_1(true, true, 2); end; -procedure TSpreadSortingTests.Test_SortingByCols2; +{ Sort 1 row } +procedure TSpreadSortingTests.Test_SortingByRows1_Numbers_asc; begin - Test_Sorting_2(true); + Test_Sorting_1(false, false, 0); end; -procedure TSpreadSortingTests.Test_SortingByRows2; +procedure TSpreadSortingTests.Test_SortingByRows1_Numbers_Desc; begin - Test_Sorting_2(false); + Test_Sorting_1(false, true, 0); end; +procedure TSpreadSortingTests.Test_SortingByRows1_Strings_Asc; +begin + Test_Sorting_1(false, false, 1); +end; + +procedure TSpreadSortingTests.Test_SortingByRows1_Strings_Desc; +begin + Test_Sorting_1(false, true, 1); +end; + +procedure TSpreadSortingTests.Test_SortingByRows1_NumbersStrings_Asc; +begin + Test_Sorting_1(false, false, 2); +end; + +procedure TSpreadSortingTests.Test_SortingByRows1_NumbersStrings_Desc; +begin + Test_Sorting_1(false, true, 2); +end; + +{ two columns } +procedure TSpreadSortingTests.Test_SortingByCols2_Asc; +begin + Test_Sorting_2(true, false); +end; + +procedure TSpreadSortingTests.Test_SortingByCols2_Desc; +begin + Test_Sorting_2(true, true); +end; + +procedure TSpreadSortingTests.Test_SortingByRows2_Asc; +begin + Test_Sorting_2(false, false); +end; + +procedure TSpreadSortingTests.Test_SortingByRows2_Desc; +begin + Test_Sorting_2(false, true); +end; + + initialization RegisterTest(TSpreadSortingTests); InitUnsortedData;