fpspreadsheet: More sorting criteria: case-senstivity, numbers first or text first in case of mixed ranges. Update spready.
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
parent
fb8faab20b
commit
f9dc0c3370
@ -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);
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -111,10 +111,12 @@
|
||||
<ComponentName Value="CSVParamsForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="sCSVParamsForm"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="sctrls.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="sCtrls"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="sformatsettingsform.pas"/>
|
||||
@ -122,6 +124,7 @@
|
||||
<ComponentName Value="FormatSettingsForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="sFormatsettingsForm"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="ssortparamsform.pas"/>
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user