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

fpspreadsheet: More sorting criteria: case-senstivity, numbers first or text first in case of mixed ranges. Update spready.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3680 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-10-23 13:38:41 +00:00
parent fb8faab20b
commit f9dc0c3370
9 changed files with 396 additions and 488 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
components/fpspreadsheet/examples/other/demo_sorting.pas
View File

@ -33,7 +33,7 @@ var
sortParams := InitSortParams(true, 1); sortParams := InitSortParams(true, 1);
sortParams.Keys[0].ColRowIndex := 0; sortParams.Keys[0].ColRowIndex := 0;
sortParams.Keys[0].Order := ssoAscending; sortParams.Keys[0].Options := [];
worksheet.Sort(sortParams, 0, 0, 3, 0); worksheet.Sort(sortParams, 0, 0, 3, 0);
@ -67,7 +67,7 @@ var
sortParams := InitSortParams(false, 1); sortParams := InitSortParams(false, 1);
sortParams.Keys[0].ColRowIndex := 0; sortParams.Keys[0].ColRowIndex := 0;
sortParams.Keys[0].Order := ssoAscending; sortParams.Keys[0].Options := [];
worksheet.Sort(sortParams, 0, 0, 0, 3); worksheet.Sort(sortParams, 0, 0, 0, 3);
@ -111,7 +111,7 @@ var
sortParams := InitSortParams(true, 1); sortParams := InitSortParams(true, 1);
sortParams.Keys[0].ColRowIndex := 0; sortParams.Keys[0].ColRowIndex := 0;
sortParams.Keys[0].Order := ssoAscending; sortParams.Keys[0].Options := [];
worksheet.Sort(sortParams, 0, 0, 3, 1); worksheet.Sort(sortParams, 0, 0, 3, 1);
@ -152,7 +152,7 @@ var
sortParams := InitSortParams(false, 1); sortParams := InitSortParams(false, 1);
sortParams.Keys[0].ColRowIndex := 0; sortParams.Keys[0].ColRowIndex := 0;
sortParams.Keys[0].Order := ssoAscending; sortParams.Keys[0].Options := [];
worksheet.Sort(sortParams, 0, 0, 1, 3); worksheet.Sort(sortParams, 0, 0, 1, 3);
@ -204,9 +204,9 @@ var
sortParams := InitSortParams(true, 2); sortParams := InitSortParams(true, 2);
sortParams.Keys[0].ColRowIndex := 0; sortParams.Keys[0].ColRowIndex := 0;
sortParams.Keys[0].Order := ssoAscending; sortParams.Keys[0].Options := [];
sortParams.Keys[1].ColRowIndex := 1; sortParams.Keys[1].ColRowIndex := 1;
sortParams.Keys[1].Order := ssoAscending; sortParams.Keys[1].Options := [];
worksheet.Sort(sortParams, 0, 0, 3, 1); worksheet.Sort(sortParams, 0, 0, 3, 1);
@ -246,9 +246,9 @@ var
sortParams := InitSortParams(false, 2); sortParams := InitSortParams(false, 2);
sortParams.Keys[0].ColRowIndex := 0; sortParams.Keys[0].ColRowIndex := 0;
sortParams.Keys[0].Order := ssoAscending; sortParams.Keys[0].Options := [];
sortParams.Keys[1].ColRowIndex := 1; sortParams.Keys[1].ColRowIndex := 1;
sortParams.Keys[1].Order := ssoAscending; sortParams.Keys[1].Options := [];
worksheet.Sort(sortParams, 0, 0, 1, 3); worksheet.Sort(sortParams, 0, 0, 1, 3);
@ -314,9 +314,9 @@ var
sortParams := InitSortParams(true, 2); sortParams := InitSortParams(true, 2);
sortParams.Keys[0].ColRowIndex := 0; sortParams.Keys[0].ColRowIndex := 0;
sortParams.Keys[0].Order := ssoAscending; sortParams.Keys[0].Options := [];
sortParams.Keys[1].ColRowIndex := 1; sortParams.Keys[1].ColRowIndex := 1;
sortParams.Keys[1].Order := ssoAscending; sortParams.Keys[1].Options := [];
worksheet.Sort(sortParams, 0, 0, 9, 1); worksheet.Sort(sortParams, 0, 0, 9, 1);
@ -370,9 +370,9 @@ var
sortParams := InitSortParams(false, 2); sortParams := InitSortParams(false, 2);
sortParams.Keys[0].ColRowIndex := 0; sortParams.Keys[0].ColRowIndex := 0;
sortParams.Keys[0].Order := ssoAscending; sortParams.Keys[0].Options := [];
sortParams.Keys[1].ColRowIndex := 1; sortParams.Keys[1].ColRowIndex := 1;
sortParams.Keys[1].Order := ssoAscending; sortParams.Keys[1].Options := [];
worksheet.Sort(sortParams, 0, 0, 1, 9); worksheet.Sort(sortParams, 0, 0, 1, 9);

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

@ -4,7 +4,7 @@ object MainFrm: TMainFrm
Top = 258 Top = 258
Width = 884 Width = 884
Caption = 'spready' Caption = 'spready'
ClientHeight = 619 ClientHeight = 614
ClientWidth = 884 ClientWidth = 884
Menu = MainMenu Menu = MainMenu
OnActivate = FormActivate OnActivate = FormActivate
@ -14,7 +14,7 @@ object MainFrm: TMainFrm
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 82 Height = 82
Top = 537 Top = 532
Width = 884 Width = 884
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -23,7 +23,7 @@ object MainFrm: TMainFrm
TabOrder = 6 TabOrder = 6
object EdFrozenCols: TSpinEdit object EdFrozenCols: TSpinEdit
Left = 429 Left = 429
Height = 23 Height = 28
Top = 8 Top = 8
Width = 52 Width = 52
OnChange = EdFrozenColsChange OnChange = EdFrozenColsChange
@ -31,7 +31,7 @@ object MainFrm: TMainFrm
end end
object EdFrozenRows: TSpinEdit object EdFrozenRows: TSpinEdit
Left = 429 Left = 429
Height = 23 Height = 28
Top = 39 Top = 39
Width = 52 Width = 52
OnChange = EdFrozenRowsChange OnChange = EdFrozenRowsChange
@ -39,37 +39,37 @@ object MainFrm: TMainFrm
end end
object Label1: TLabel object Label1: TLabel
Left = 344 Left = 344
Height = 15 Height = 20
Top = 13 Top = 13
Width = 62 Width = 77
Caption = 'Frozen cols:' Caption = 'Frozen cols:'
FocusControl = EdFrozenCols FocusControl = EdFrozenCols
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel
Left = 344 Left = 344
Height = 15 Height = 20
Top = 40 Top = 40
Width = 66 Width = 82
Caption = 'Frozen rows:' Caption = 'Frozen rows:'
FocusControl = EdFrozenRows FocusControl = EdFrozenRows
ParentColor = False ParentColor = False
end end
object CbReadFormulas: TCheckBox object CbReadFormulas: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 8 Top = 8
Width = 96 Width = 120
Caption = 'Read formulas' Caption = 'Read formulas'
OnChange = CbReadFormulasChange OnChange = CbReadFormulasChange
TabOrder = 0 TabOrder = 0
end end
object CbHeaderStyle: TComboBox object CbHeaderStyle: TComboBox
Left = 200 Left = 200
Height = 23 Height = 28
Top = 8 Top = 8
Width = 116 Width = 116
ItemHeight = 15 ItemHeight = 20
ItemIndex = 2 ItemIndex = 2
Items.Strings = ( Items.Strings = (
'Lazarus' 'Lazarus'
@ -83,18 +83,18 @@ object MainFrm: TMainFrm
end end
object CbAutoCalcFormulas: TCheckBox object CbAutoCalcFormulas: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 32 Top = 32
Width = 128 Width = 158
Caption = 'Calculate on change' Caption = 'Calculate on change'
OnChange = CbAutoCalcFormulasChange OnChange = CbAutoCalcFormulasChange
TabOrder = 1 TabOrder = 1
end end
object CbTextOverflow: TCheckBox object CbTextOverflow: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 56 Top = 56
Width = 91 Width = 114
Caption = 'Text overflow' Caption = 'Text overflow'
Checked = True Checked = True
OnChange = CbTextOverflowChange OnChange = CbTextOverflowChange
@ -206,19 +206,19 @@ object MainFrm: TMainFrm
end end
object FontComboBox: TComboBox object FontComboBox: TComboBox
Left = 52 Left = 52
Height = 23 Height = 28
Top = 2 Top = 2
Width = 127 Width = 127
ItemHeight = 15 ItemHeight = 20
OnSelect = FontComboBoxSelect OnSelect = FontComboBoxSelect
TabOrder = 0 TabOrder = 0
end end
object FontSizeComboBox: TComboBox object FontSizeComboBox: TComboBox
Left = 179 Left = 179
Height = 23 Height = 28
Top = 2 Top = 2
Width = 48 Width = 48
ItemHeight = 15 ItemHeight = 20
Items.Strings = ( Items.Strings = (
'8' '8'
'9' '9'
@ -394,7 +394,7 @@ object MainFrm: TMainFrm
TabOrder = 2 TabOrder = 2
object EdCellAddress: TEdit object EdCellAddress: TEdit
Left = 0 Left = 0
Height = 23 Height = 28
Top = 0 Top = 0
Width = 170 Width = 170
Align = alTop Align = alTop
@ -406,7 +406,7 @@ object MainFrm: TMainFrm
end end
object InspectorSplitter: TSplitter object InspectorSplitter: TSplitter
Left = 648 Left = 648
Height = 451 Height = 446
Top = 86 Top = 86
Width = 5 Width = 5
Align = alRight Align = alRight
@ -414,7 +414,7 @@ object MainFrm: TMainFrm
end end
object InspectorPageControl: TPageControl object InspectorPageControl: TPageControl
Left = 653 Left = 653
Height = 451 Height = 446
Top = 86 Top = 86
Width = 231 Width = 231
ActivePage = PgCellValue ActivePage = PgCellValue
@ -424,11 +424,11 @@ object MainFrm: TMainFrm
OnChange = InspectorPageControlChange OnChange = InspectorPageControlChange
object PgCellValue: TTabSheet object PgCellValue: TTabSheet
Caption = 'Cell value' Caption = 'Cell value'
ClientHeight = 423 ClientHeight = 413
ClientWidth = 223 ClientWidth = 223
object CellInspector: TValueListEditor object CellInspector: TValueListEditor
Left = 0 Left = 0
Height = 423 Height = 413
Top = 0 Top = 0
Width = 223 Width = 223
Align = alClient Align = alClient
@ -472,7 +472,7 @@ object MainFrm: TMainFrm
end end
object TabControl: TTabControl object TabControl: TTabControl
Left = 0 Left = 0
Height = 451 Height = 446
Top = 86 Top = 86
Width = 648 Width = 648
OnChange = TabControlChange OnChange = TabControlChange
@ -480,7 +480,7 @@ object MainFrm: TMainFrm
TabOrder = 3 TabOrder = 3
object WorksheetGrid: TsWorksheetGrid object WorksheetGrid: TsWorksheetGrid
Left = 2 Left = 2
Height = 446 Height = 441
Top = 3 Top = 3
Width = 644 Width = 644
FrozenCols = 0 FrozenCols = 0
@ -498,7 +498,7 @@ object MainFrm: TMainFrm
OnHeaderClick = WorksheetGridHeaderClick OnHeaderClick = WorksheetGridHeaderClick
OnSelection = WorksheetGridSelection OnSelection = WorksheetGridSelection
ColWidths = ( ColWidths = (
42 56
64 64
64 64
64 64

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

@ -765,10 +765,7 @@ var
begin begin
r := WorksheetGrid.GetWorksheetRow(WorksheetGrid.Row); r := WorksheetGrid.GetWorksheetRow(WorksheetGrid.Row);
c := WorksheetGrid.GetWorksheetCol(WorksheetGrid.Col); c := WorksheetGrid.GetWorksheetCol(WorksheetGrid.Col);
SetLength(sortParams.Keys, 1); sortParams := InitSortParams;
sortParams.Keys[0].ColRowIndex := c;
sortParams.Keys[0].Order := ssoAscending;
sortParams.SortByCols := true;
WorksheetGrid.BeginUpdate; WorksheetGrid.BeginUpdate;
try try
with WorksheetGrid.Worksheet do with WorksheetGrid.Worksheet do

3
components/fpspreadsheet/examples/spready/spready.lpi
View File

@ -111,10 +111,12 @@
<ComponentName Value="CSVParamsForm"/> <ComponentName Value="CSVParamsForm"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="sCSVParamsForm"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="sctrls.pas"/> <Filename Value="sctrls.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="sCtrls"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
<Filename Value="sformatsettingsform.pas"/> <Filename Value="sformatsettingsform.pas"/>
@ -122,6 +124,7 @@
<ComponentName Value="FormatSettingsForm"/> <ComponentName Value="FormatSettingsForm"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="sFormatsettingsForm"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="ssortparamsform.pas"/> <Filename Value="ssortparamsform.pas"/>

71
components/fpspreadsheet/examples/spready/ssortparamsform.lfm
View File

@ -1,17 +1,17 @@
object SortParamsForm: TSortParamsForm object SortParamsForm: TSortParamsForm
Left = 361 Left = 434
Height = 303 Height = 314
Top = 177 Top = 274
Width = 374 Width = 485
Caption = 'Sorting criteria' Caption = 'Sorting criteria'
ClientHeight = 303 ClientHeight = 314
ClientWidth = 374 ClientWidth = 485
LCLVersion = '1.3' LCLVersion = '1.3'
object ButtonPanel: TButtonPanel object ButtonPanel: TButtonPanel
Left = 6 Left = 6
Height = 34 Height = 38
Top = 263 Top = 270
Width = 362 Width = 473
OKButton.Name = 'OKButton' OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True OKButton.DefaultCaption = True
OKButton.OnClick = OKButtonClick OKButton.OnClick = OKButtonClick
@ -26,28 +26,34 @@ object SortParamsForm: TSortParamsForm
end end
object Grid: TStringGrid object Grid: TStringGrid
Left = 0 Left = 0
Height = 207 Height = 214
Top = 50 Top = 50
Width = 374 Width = 485
Align = alClient Align = alClient
ColCount = 3 ColCount = 4
Columns = < Columns = <
item item
ButtonStyle = cbsPickList ButtonStyle = cbsPickList
ReadOnly = False
Title.Caption = 'Column' Title.Caption = 'Column'
Width = 120 Width = 120
end end
item item
ButtonStyle = cbsPickList ButtonStyle = cbsCheckboxColumn
PickList.Strings = ( PickList.Strings = (
'A to Z (ascending)' 'ascending'
'Z to A (descending)' 'descending'
) )
Title.Caption = 'Direction' Title.Alignment = taCenter
Width = 150 Title.Caption = 'Descending'
Width = 120
end
item
ButtonStyle = cbsCheckboxColumn
Title.Alignment = taCenter
Title.Caption = 'Ignore case'
Width = 120
end> end>
DefaultColWidth = 100 DefaultColWidth = 120
Options = [goFixedVertLine, goFixedHorzLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll] Options = [goFixedVertLine, goFixedHorzLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll]
RowCount = 2 RowCount = 2
TabOrder = 1 TabOrder = 1
@ -64,11 +70,11 @@ object SortParamsForm: TSortParamsForm
Left = 0 Left = 0
Height = 50 Height = 50
Top = 0 Top = 0
Width = 374 Width = 485
Align = alTop Align = alTop
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 50 ClientHeight = 50
ClientWidth = 374 ClientWidth = 485
TabOrder = 2 TabOrder = 2
object BtnAdd: TBitBtn object BtnAdd: TBitBtn
Left = 7 Left = 7
@ -161,11 +167,11 @@ object SortParamsForm: TSortParamsForm
TabOrder = 1 TabOrder = 1
end end
object CbSortColsRows: TComboBox object CbSortColsRows: TComboBox
Left = 186 Left = 185
Height = 23 Height = 28
Top = 13 Top = 11
Width = 160 Width = 160
ItemHeight = 15 ItemHeight = 20
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
'Sort top to bottom' 'Sort top to bottom'
@ -176,5 +182,20 @@ object SortParamsForm: TSortParamsForm
TabOrder = 2 TabOrder = 2
Text = 'Sort top to bottom' Text = 'Sort top to bottom'
end 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
end end

38
components/fpspreadsheet/examples/spready/ssortparamsform.pas
View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ButtonPanel, Grids, ExtCtrls, Buttons, StdCtrls, ButtonPanel, Grids, ExtCtrls, Buttons, StdCtrls, ComboEx,
fpspreadsheet, fpspreadsheetgrid; fpspreadsheet, fpspreadsheetgrid;
type type
@ -18,6 +18,7 @@ type
BtnDelete: TBitBtn; BtnDelete: TBitBtn;
ButtonPanel: TButtonPanel; ButtonPanel: TButtonPanel;
CbSortColsRows: TComboBox; CbSortColsRows: TComboBox;
CbPriority: TComboBox;
TopPanel: TPanel; TopPanel: TPanel;
Grid: TStringGrid; Grid: TStringGrid;
procedure BtnAddClick(Sender: TObject); procedure BtnAddClick(Sender: TObject);
@ -83,6 +84,9 @@ begin
exit; // there can't be more conditions than defined by the worksheetgrid selection exit; // there can't be more conditions than defined by the worksheetgrid selection
Grid.RowCount := Grid.RowCount + 1; Grid.RowCount := Grid.RowCount + 1;
Grid.Cells[0, Grid.RowCount-1] := 'Then by'; 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; UpdateCmds;
end; end;
@ -99,13 +103,20 @@ function TSortParamsForm.GetSortParams: TsSortParams;
var var
i, p: Integer; i, p: Integer;
n: Cardinal; n: Cardinal;
sortDir: TsSortOrder; sortOptions: TsSortOptions;
s: String; s: String;
begin begin
Result.SortByCols := CbSortColsRows.ItemIndex = 0; // Sort by column or rows?
SetLength(Result.Keys, 0); 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 for i:=Grid.FixedRows to Grid.RowCount-1 do
begin begin
sortOptions := [];
// Sort index column
s := Grid.Cells[1, i]; // the cell text is "Column A" or "Row A" s := Grid.Cells[1, i]; // the cell text is "Column A" or "Row A"
if s = '' then if s = '' then
raise Exception.Create('[TSortParamsForm.GetSortParams] No sort index selected.'); raise Exception.Create('[TSortParamsForm.GetSortParams] No sort index selected.');
@ -126,20 +137,22 @@ begin
'Unexpected row identifier in row %s', [i]); 'Unexpected row identifier in row %s', [i]);
end; end;
// Sort order column
s := Grid.Cells[2, i]; s := Grid.Cells[2, i];
if s = '' then if s = '' then
raise Exception.Create('[TSortParamsForm.GetSortParams] No sort direction selected.'); 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 sensitivity column
case s[1] of s := Grid.Cells[3, i];
'A': sortDir := ssoAscending; if s = '1' then
'Z': sortDir := ssoDescending; Include(sortOptions, ssoCaseInsensitive);
end;
SetLength(Result.Keys, Length(Result.Keys) + 1); SetLength(Result.Keys, Length(Result.Keys) + 1);
with Result.Keys[Length(Result.Keys)-1] do with Result.Keys[Length(Result.Keys)-1] do
begin begin
Order := sortDir; Options := sortOptions;
ColRowIndex := n; ColRowIndex := n;
end; end;
end; // for end; // for
@ -150,8 +163,9 @@ begin
FWorksheetGrid := AValue; FWorksheetGrid := AValue;
UpdateColRowList; UpdateColRowList;
UpdateCmds; UpdateCmds;
Grid.Cells[1, 1] := Grid.Columns[0].PickList[0]; Grid.Cells[1, 1] := Grid.Columns[0].PickList[0]; // Sorting index
Grid.Cells[2, 1] := Grid.Columns[1].PickList[0]; Grid.Cells[2, 1] := '0'; // Ascending sort order Grid.Columns[1].CheckedPickList[0];
Grid.Cells[3, 1] := '0'; // case-sensitive comparisons
end; end;
procedure TSortParamsForm.UpdateColRowList; procedure TSortParamsForm.UpdateColRowList;

283
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -442,8 +442,12 @@ type
{@@ Pointer to a TCol record } {@@ Pointer to a TCol record }
PCol = ^TCol; PCol = ^TCol;
{@@ Sort order } {@@ Sort options }
TsSortOrder = (ssoAscending, ssoDescending); TsSortOption = (ssoDescending, ssoCaseInsensitive);
TsSortOptions = set of TsSortOption;
// {@@ Sort order }
// TsSortOrder = (ssoAscending, ssoDescending);
{@@ Sort priority } {@@ Sort priority }
TsSortPriority = (spNumAlpha, spAlphaNum); // NumAlph = "number < alpha" TsSortPriority = (spNumAlpha, spAlphaNum); // NumAlph = "number < alpha"
@ -451,7 +455,8 @@ type
{@@ Sort key: sorted column or row index and sort direction } {@@ Sort key: sorted column or row index and sort direction }
TsSortKey = record TsSortKey = record
ColRowIndex: Integer; ColRowIndex: Integer;
Order: TsSortOrder; Options: TsSortOptions;
// Order: TsSortOrder;
end; end;
{@@ Array of sort keys for multiple sorting criteria } {@@ Array of sort keys for multiple sorting criteria }
@ -543,9 +548,9 @@ type
// Sorting // Sorting
function DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal; function DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal;
ASortOrder: TsSortOrder): Integer; ASortOptions: TsSortOptions): Integer;
function DoInternalCompareCells(ACell1, ACell2: PCell; function DoInternalCompareCells(ACell1, ACell2: PCell;
ASortOrder: TsSortOrder): Integer; ASortOptions: TsSortOptions): Integer;
procedure DoExchangeColRow(AIsColumn: Boolean; AIndex, WithIndex: Cardinal; procedure DoExchangeColRow(AIsColumn: Boolean; AIndex, WithIndex: Cardinal;
AFromIndex, AToIndex: 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 to be "equal" the next parameter is set is used until a difference is
found, or all parameters are used. found, or all parameters are used.
@param ARow1 Row index of the first 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 ACol1 Column index of the first cell to be compared
@param ARow2 Row index of the second 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 @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 @return -1 if the first cell is "smaller", i.e. is sorted in front of the
second one second one
+1 if the first cell is "larger", i.e. is behind the second one +1 if the first cell is "larger", i.e. is behind the second one
0 if both cells are equal 0 if both cells are equal
------------------------------------------------------------------------------- } ------------------------------------------------------------------------------- }
function TsWorksheet.DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal; function TsWorksheet.DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal;
ASortOrder: TsSortOrder): Integer; ASortOptions: TsSortOptions): Integer;
var var
cell1, cell2: PCell; // Pointers to the cells to be compared cell1, cell2: PCell; // Pointers to the cells to be compared
key: Integer; key: Integer;
begin begin
cell1 := FindCell(ARow1, ACol1); cell1 := FindCell(ARow1, ACol1);
cell2 := FindCell(ARow2, ACol2); cell2 := FindCell(ARow2, ACol2);
Result := DoInternalCompareCells(cell1, cell2, ASortOrder); Result := DoInternalCompareCells(cell1, cell2, ASortOptions);
if Result = 0 then begin if Result = 0 then begin
key := 1; key := 1;
while (Result = 0) and (key <= High(FSortParams.Keys)) do while (Result = 0) and (key <= High(FSortParams.Keys)) do
@ -3237,7 +3243,7 @@ begin
cell1 := FindCell(FSortParams.Keys[key].ColRowIndex, ACol1); cell1 := FindCell(FSortParams.Keys[key].ColRowIndex, ACol1);
cell2 := FindCell(FSortParams.Keys[key].ColRowIndex, ACol2); cell2 := FindCell(FSortParams.Keys[key].ColRowIndex, ACol2);
end; end;
Result := DoInternalCompareCells(cell1, cell2, ASortOrder); Result := DoInternalCompareCells(cell1, cell2, ASortOptions);
inc(key); inc(key);
end; end;
end; end;
@ -3246,9 +3252,9 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Compare function for sorting of rows and columns. Called by DoCompareCells. Compare function for sorting of rows and columns. Called by DoCompareCells.
@param ACell1 Pointer to the first cell of the comparison @param ACell1 Pointer to the first cell of the comparison
@param ACell2 Pointer to the second cell of the comparison @param ACell2 Pointer to the second cell of the comparison
@param ASortOrder Order of sorting, ascending or descending @param ASortOptions Options for sorting: descending and/or case-insensitive
@return -1 if the first cell is "smaller" @return -1 if the first cell is "smaller"
+1 if the first cell is "larger", +1 if the first cell is "larger",
0 if both cells are "equal" 0 if both cells are "equal"
@ -3263,7 +3269,7 @@ end;
order) order)
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.DoInternalCompareCells(ACell1, ACell2: PCell; function TsWorksheet.DoInternalCompareCells(ACell1, ACell2: PCell;
ASortOrder: TsSortOrder): Integer; ASortOptions: TsSortOptions): Integer;
// Sort priority in Excel: // Sort priority in Excel:
// numbers < alpha < blank (ascending) // numbers < alpha < blank (ascending)
// alpha < numbers < blank (descending) // alpha < numbers < blank (descending)
@ -3278,21 +3284,33 @@ begin
if (ACell1 = nil) and (ACell2 = nil) then if (ACell1 = nil) and (ACell2 = nil) then
Result := 0 Result := 0
else else
if (ACell1 = nil) or (ACell2 = nil) then if (ACell1 = nil) or (ACell1^.ContentType = cctEmpty) then
begin begin
Result := +1; // Empty cells go to the end Result := +1; // Empty cells go to the end
exit; // Avoid SortOrder to bring the empty cell to the top! 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 end else
if (ACell1^.ContentType = cctEmpty) and (ACell2^.ContentType = cctEmpty) then if (ACell1^.ContentType = cctEmpty) and (ACell2^.ContentType = cctEmpty) then
Result := 0 Result := 0
else if (ACell1^.ContentType = cctEmpty) or (ACell2^.ContentType = cctEmpty) then else
{
if (ACell1^.ContentType = cctEmpty) or (ACell2^.ContentType = cctEmpty) then
begin begin
Result := +1; // Empty cells go to the end Result := +1; // Empty cells go to the end
exit; // Avoid SortOrder to bring the empty cell back to the top exit; // Avoid SortOrder to bring the empty cell back to the top
end else end else
}
if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then
Result := CompareText(ACell1^.UTF8StringValue, ACell2^.UTF8StringValue) begin
else 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 if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType <> cctUTF8String) then
case FSortParams.Priority of case FSortParams.Priority of
spNumAlpha: Result := +1; // numbers before text spNumAlpha: Result := +1; // numbers before text
@ -3311,7 +3329,7 @@ begin
Result := CompareValue(number1, number2); Result := CompareValue(number1, number2);
end; end;
end; end;
if ASortOrder = ssoDescending then if ssoDescending in ASortOptions then
Result := -Result; Result := -Result;
end; end;
@ -3376,20 +3394,17 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.Sort(const ASortParams: TsSortParams; procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
ARowFrom, AColFrom, ARowTo, AColTo: Cardinal); ARowFrom, AColFrom, ARowTo, AColTo: Cardinal);
// code "borrowed" from grids.pas and adapted to multi-key sorting
procedure QuickSort(L,R: Integer); procedure QuickSort(L,R: Integer);
var var
I,J,K: Integer; I,J,K: Integer;
P: Integer; P: Integer;
index: Integer; index: Integer;
order: TsSortOrder; options: TsSortOptions;
{
cell1, cell2: PCell;
compareResult: Integer;
}
begin begin
index := ASortParams.Keys[0].ColRowIndex; // less typing... index := ASortParams.Keys[0].ColRowIndex; // less typing...
order := ASortParams.Keys[0].Order; options := ASortParams.Keys[0].Options;
repeat repeat
I := L; I := L;
J := R; J := R;
@ -3397,223 +3412,25 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
repeat repeat
if ASortParams.SortByCols then if ASortParams.SortByCols then
begin begin
while DoCompareCells(P, index, I, index, order) > 0 do inc(I); while DoCompareCells(P, index, I, index, options) > 0 do inc(I);
while DoCompareCells(P, index, J, index, order) < 0 do dec(J); while DoCompareCells(P, index, J, index, options) < 0 do dec(J);
end else end else
begin begin
while DoCompareCells(index, P, index, I, order) > 0 do inc(I); while DoCompareCells(index, P, index, I, options) > 0 do inc(I);
while DoCompareCells(index, P, index, J, order) < 0 do dec(J); while DoCompareCells(index, P, index, J, options) < 0 do dec(J);
end; 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 if I <= J then
begin begin
if I <> J then if I <> J then
begin begin
if ASortParams.SortByCols then if ASortParams.SortByCols then
begin begin
if DoCompareCells(I, index, J, index, order) <> 0 then if DoCompareCells(I, index, J, index, options) <> 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
}
DoExchangeColRow(not ASortParams.SortByCols, J,I, AColFrom, AColTo); DoExchangeColRow(not ASortParams.SortByCols, J,I, AColFrom, AColTo);
end else end else
begin begin
if DoCompareCells(index, I, index, J, order) <> 0 then if DoCompareCells(index, I, index, J, options) <> 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
}
DoExchangeColRow(not ASortParams.SortByCols, J,I, ARowFrom, ARowTo); DoExchangeColRow(not ASortParams.SortByCols, J,I, ARowFrom, ARowTo);
end; end;
end; end;

7
components/fpspreadsheet/fpsutils.pas
View File

@ -2373,7 +2373,8 @@ end;
ColRowIndexes refer to row indexes ColRowIndexes refer to row indexes
Default: true Default: true
@param ANumSortKeys Determines how many columns or rows are used as sorting @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 @param ASortPriority Determines the order or text and numeric data in
mixed content type cell ranges. mixed content type cell ranges.
Default: spNumAlpha, i.e. numbers before text (in Default: spNumAlpha, i.e. numbers before text (in
@ -2389,8 +2390,8 @@ begin
Result.Priority := spNumAlpha; // numbers before text, like in Excel Result.Priority := spNumAlpha; // numbers before text, like in Excel
SetLength(Result.Keys, ANumSortKeys); SetLength(Result.Keys, ANumSortKeys);
for i:=0 to High(Result.Keys) do begin for i:=0 to High(Result.Keys) do begin
Result.Keys[i].ColRowIndex := 0; Result.Keys[i].ColRowIndex := i;
Result.Keys[i].Order := ssoAscending; Result.Keys[i].Options := []; // Ascending & case-sensitive
end; end;
end; end;

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

@ -32,23 +32,33 @@ type
procedure Test_Sorting_1( // one column or row procedure Test_Sorting_1( // one column or row
ASortByCols: Boolean; 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 procedure Test_Sorting_2( // two columns/rows, primary keys equal
ASortByCols: Boolean ASortByCols: Boolean;
ADescending: Boolean
); );
published published
procedure Test_SortingByCols1_Numbers; procedure Test_SortingByCols1_Numbers_Asc;
procedure Test_SortingByCols1_Strings; procedure Test_SortingByCols1_Numbers_Desc;
procedure Test_SortingByCols1_NumbersStrings; 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_Numbers_Asc;
procedure Test_SortingByRows1_Strings; procedure Test_SortingByRows1_Numbers_Desc;
procedure Test_SortingByRows1_NumbersStrings; 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_SortingByCols2_Asc;
procedure Test_SortingByRows2; procedure Test_SortingByCols2_Desc;
procedure Test_SortingByRows2_Asc;
procedure Test_SortingByRows2_Desc;
end; end;
@ -103,7 +113,7 @@ begin
end; end;
procedure TSpreadSortingTests.Test_Sorting_1(ASortByCols: Boolean; procedure TSpreadSortingTests.Test_Sorting_1(ASortByCols: Boolean;
AMode: Integer); ADescending: Boolean; AWhat: Integer);
const const
AFormat = sfExcel8; AFormat = sfExcel8;
var var
@ -115,7 +125,7 @@ var
L: TStringList; L: TStringList;
s: String; s: String;
sortParams: TsSortParams; sortParams: TsSortParams;
sortDir: TsSortOrder; sortOptions: TsSortOptions;
r1,r2,c1,c2: Cardinal; r1,r2,c1,c2: Cardinal;
actualNumber: Double; actualNumber: Double;
actualString: String; actualString: String;
@ -134,7 +144,7 @@ begin
col := 0; col := 0;
row := 0; row := 0;
if ASortByCols then begin if ASortByCols then begin
case AMode of case AWhat of
0: for i :=0 to High(SollSortNumbers) do 0: for i :=0 to High(SollSortNumbers) do
MyWorksheet.WriteNumber(i, col, SollSortNumbers[i]); MyWorksheet.WriteNumber(i, col, SollSortNumbers[i]);
1: for i := 0 to High(SollSortStrings) do 1: for i := 0 to High(SollSortStrings) do
@ -148,7 +158,7 @@ begin
end end
end end
else begin else begin
case AMode of case AWhat of
0: for i := 0 to High(SollSortNumbers) do 0: for i := 0 to High(SollSortNumbers) do
MyWorksheet.WriteNumber(row, i, SollSortNumbers[i]); MyWorksheet.WriteNumber(row, i, SollSortNumbers[i]);
1: for i := 0 to High(SollSortStrings) do 1: for i := 0 to High(SollSortStrings) do
@ -166,92 +176,89 @@ begin
MyWorkbook.Free; MyWorkbook.Free;
end; end;
// Test ascending and descending sort orders MyWorkbook := TsWorkbook.Create;
for sortDir in TsSortOrder do try
begin // Read spreadsheet file...
MyWorkbook := TsWorkbook.Create; MyWorkbook.ReadFromFile(TempFile, AFormat);
try if AFormat = sfExcel2 then
// Read spreadsheet file... MyWorksheet := MyWorkbook.GetFirstWorksheet
MyWorkbook.ReadFromFile(TempFile, AFormat); else
if AFormat = sfExcel2 then MyWorksheet := GetWorksheetByName(MyWorkBook, SortingTestSheet);
MyWorksheet := MyWorkbook.GetFirstWorksheet if MyWorksheet = nil then
else fail('Error in test code. Failed to get named worksheet');
MyWorksheet := GetWorksheetByName(MyWorkBook, SortingTestSheet);
if MyWorksheet = nil then
fail('Error in test code. Failed to get named worksheet');
// ... and sort it. // ... set up sorting direction
case AMode of case ADescending of
0: iLast:= High(SollSortNumbers); false: sortParams.Keys[0].Options := []; // Ascending sort
1: iLast := High(SollSortStrings); true : sortParams.Keys[0].Options := [ssoDescending]; // Descending sort
2: iLast := Length(SollSortNumbers) + Length(SollSortStrings) - 1; end;
end;
r1 := 0; // ... and sort it.
r2 := 0; case AWhat of
c1 := 0; 0: iLast:= High(SollSortNumbers);
c2 := 0; 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 if ASortByCols then
r2 := iLast case ADescending of
false: row := i; // ascending
true : row := iLast - i; // descending
end
else else
c2 := iLast; case ADescending of
sortParams.Keys[0].Order := sortDir; false: col := i; // ascending
MyWorksheet.Sort(sortParams, r1,c1, r2, c2); true : col := iLast - i; // descending
end;
// for debugging, to see the sorted data case AWhat of
// MyWorkbook.WriteToFile('sorted.xls', AFormat, true); 0: begin
actualNumber := MyWorksheet.ReadAsNumber(row, col);
row := 0; expectedNumber := i;
col := 0; CheckEquals(expectednumber, actualnumber,
for i:=0 to iLast do 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
begin end;
if ASortByCols then 1: begin
case sortDir of actualString := MyWorksheet.ReadAsUTF8Text(row, col);
ssoAscending : row := i; expectedString := char(ord('A') + i);
ssoDescending: row := iLast - i; CheckEquals(expectedstring, actualstring,
end 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col));
else end;
case sortDir of 2: begin // with increasing i, we see first the numbers, then the strings
ssoAscending : col := i; if i <= High(SollSortNumbers) then begin
ssoDescending: col := iLast - i; actualnumber := MyWorksheet.ReadAsNumber(row, col);
end;
case AMode of
0: begin
actualNumber := MyWorksheet.ReadAsNumber(row, col);
expectedNumber := i; expectedNumber := i;
CheckEquals(expectednumber, actualnumber, CheckEquals(expectednumber, actualnumber,
'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col)); 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
end; end else begin
1: begin actualstring := MyWorksheet.ReadAsUTF8Text(row, col);
actualString := MyWorksheet.ReadAsUTF8Text(row, col); expectedstring := char(ord('A') + i - Length(SollSortNumbers));
expectedString := char(ord('A') + i);
CheckEquals(expectedstring, actualstring, CheckEquals(expectedstring, actualstring,
'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col)); 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col));
end; end;
2: begin // with increasing i, we see first the numbers, then the strings end;
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;
end; // for sortDir
finally
MyWorkbook.Free;
end;
DeleteFile(TempFile); DeleteFile(TempFile);
end; end;
procedure TSpreadSortingTests.Test_Sorting_2(ASortByCols: Boolean); procedure TSpreadSortingTests.Test_Sorting_2(ASortByCols: Boolean;
ADescending: Boolean);
const const
AFormat = sfExcel8; AFormat = sfExcel8;
var var
@ -263,7 +270,7 @@ var
L: TStringList; L: TStringList;
s: String; s: String;
sortParams: TsSortParams; sortParams: TsSortParams;
sortDir: TsSortOrder; sortOptions: TsSortOptions;
r1,r2,c1,c2: Cardinal; r1,r2,c1,c2: Cardinal;
actualNumber: Double; actualNumber: Double;
actualString: String; actualString: String;
@ -310,121 +317,169 @@ begin
MyWorkbook.Free; MyWorkbook.Free;
end; end;
// Test ascending and descending sort orders MyWorkbook := TsWorkbook.Create;
for sortDir in TsSortOrder do try
begin // Read spreadsheet file...
MyWorkbook := TsWorkbook.Create; MyWorkbook.ReadFromFile(TempFile, AFormat);
try if AFormat = sfExcel2 then
// Read spreadsheet file... MyWorksheet := MyWorkbook.GetFirstWorksheet
MyWorkbook.ReadFromFile(TempFile, AFormat); else
if AFormat = sfExcel2 then MyWorksheet := GetWorksheetByName(MyWorkBook, SortingTestSheet);
MyWorksheet := MyWorkbook.GetFirstWorksheet if MyWorksheet = nil then
else fail('Error in test code. Failed to get named worksheet');
MyWorksheet := GetWorksheetByName(MyWorkBook, SortingTestSheet);
if MyWorksheet = nil then
fail('Error in test code. Failed to get named worksheet');
// ... and sort it. // ... set up sort direction
sortParams.Keys[0].Order := sortDir; if ADescending then
sortParams.Keys[1].Order := sortDir; begin
if ASortByCols then sortParams.Keys[0].Options := [ssoDescending];
MyWorksheet.Sort(sortParams, 0, 0, iLast, 1) sortParams.Keys[1].Options := [ssoDescending];
else end else
MyWorksheet.Sort(sortParams, 0, 0, 1, iLast); begin
sortParams.Keys[0].Options := [];
// for debugging, to see the sorted data sortParams.Keys[1].Options := [];
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;
end; 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); DeleteFile(TempFile);
end; end;
{ Sort 1 column }
procedure TSpreadSortingTests.Test_SortingByCols1_Numbers; procedure TSpreadSortingTests.Test_SortingByCols1_Numbers_ASC;
begin begin
Test_Sorting_1(true, 0); Test_Sorting_1(true, false, 0);
end; end;
procedure TSpreadSortingTests.Test_SortingByCols1_Strings; procedure TSpreadSortingTests.Test_SortingByCols1_Numbers_DESC;
begin begin
Test_Sorting_1(true, 1); Test_Sorting_1(true, true, 0);
end; end;
procedure TSpreadSortingTests.Test_SortingByCols1_NumbersStrings; procedure TSpreadSortingTests.Test_SortingByCols1_Strings_ASC;
begin begin
Test_Sorting_1(true, 2); Test_Sorting_1(true, false, 1);
end; end;
procedure TSpreadSortingTests.Test_SortingByRows1_Numbers; procedure TSpreadSortingTests.Test_SortingByCols1_Strings_DESC;
begin begin
Test_Sorting_1(false, 0); Test_Sorting_1(true, true, 1);
end; end;
procedure TSpreadSortingTests.Test_SortingByRows1_Strings; procedure TSpreadSortingTests.Test_SortingByCols1_NumbersStrings_ASC;
begin begin
Test_Sorting_1(false, 1); Test_Sorting_1(true, false, 2);
end; end;
procedure TSpreadSortingTests.Test_SortingByRows1_NumbersStrings; procedure TSpreadSortingTests.Test_SortingByCols1_NumbersStrings_DESC;
begin begin
Test_Sorting_1(false, 2); Test_Sorting_1(true, true, 2);
end; end;
procedure TSpreadSortingTests.Test_SortingByCols2; { Sort 1 row }
procedure TSpreadSortingTests.Test_SortingByRows1_Numbers_asc;
begin begin
Test_Sorting_2(true); Test_Sorting_1(false, false, 0);
end; end;
procedure TSpreadSortingTests.Test_SortingByRows2; procedure TSpreadSortingTests.Test_SortingByRows1_Numbers_Desc;
begin begin
Test_Sorting_2(false); Test_Sorting_1(false, true, 0);
end; 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 initialization
RegisterTest(TSpreadSortingTests); RegisterTest(TSpreadSortingTests);
InitUnsortedData; InitUnsortedData;