diff --git a/components/fpspreadsheet/examples/other/demo_sorting.lpi b/components/fpspreadsheet/examples/other/demo_sorting.lpi
new file mode 100644
index 000000000..7376abc10
--- /dev/null
+++ b/components/fpspreadsheet/examples/other/demo_sorting.lpi
@@ -0,0 +1,77 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm
index 76d32ffab..392c34983 100644
--- a/components/fpspreadsheet/examples/spready/mainform.lfm
+++ b/components/fpspreadsheet/examples/spready/mainform.lfm
@@ -4,7 +4,7 @@ object MainFrm: TMainFrm
Top = 258
Width = 884
Caption = 'spready'
- ClientHeight = 614
+ ClientHeight = 619
ClientWidth = 884
Menu = MainMenu
OnActivate = FormActivate
@@ -14,7 +14,7 @@ object MainFrm: TMainFrm
object Panel1: TPanel
Left = 0
Height = 82
- Top = 532
+ Top = 537
Width = 884
Align = alBottom
BevelOuter = bvNone
@@ -23,7 +23,7 @@ object MainFrm: TMainFrm
TabOrder = 6
object EdFrozenCols: TSpinEdit
Left = 429
- Height = 28
+ Height = 23
Top = 8
Width = 52
OnChange = EdFrozenColsChange
@@ -31,7 +31,7 @@ object MainFrm: TMainFrm
end
object EdFrozenRows: TSpinEdit
Left = 429
- Height = 28
+ Height = 23
Top = 39
Width = 52
OnChange = EdFrozenRowsChange
@@ -39,37 +39,37 @@ object MainFrm: TMainFrm
end
object Label1: TLabel
Left = 344
- Height = 20
+ Height = 15
Top = 13
- Width = 77
+ Width = 62
Caption = 'Frozen cols:'
FocusControl = EdFrozenCols
ParentColor = False
end
object Label2: TLabel
Left = 344
- Height = 20
+ Height = 15
Top = 40
- Width = 82
+ Width = 66
Caption = 'Frozen rows:'
FocusControl = EdFrozenRows
ParentColor = False
end
object CbReadFormulas: TCheckBox
Left = 8
- Height = 24
+ Height = 19
Top = 8
- Width = 120
+ Width = 96
Caption = 'Read formulas'
OnChange = CbReadFormulasChange
TabOrder = 0
end
object CbHeaderStyle: TComboBox
Left = 200
- Height = 28
+ Height = 23
Top = 8
Width = 116
- ItemHeight = 20
+ ItemHeight = 15
ItemIndex = 2
Items.Strings = (
'Lazarus'
@@ -83,18 +83,18 @@ object MainFrm: TMainFrm
end
object CbAutoCalcFormulas: TCheckBox
Left = 8
- Height = 24
+ Height = 19
Top = 32
- Width = 158
+ Width = 128
Caption = 'Calculate on change'
OnChange = CbAutoCalcFormulasChange
TabOrder = 1
end
object CbTextOverflow: TCheckBox
Left = 8
- Height = 24
+ Height = 19
Top = 56
- Width = 114
+ Width = 91
Caption = 'Text overflow'
Checked = True
OnChange = CbTextOverflowChange
@@ -206,19 +206,19 @@ object MainFrm: TMainFrm
end
object FontComboBox: TComboBox
Left = 52
- Height = 28
+ Height = 23
Top = 2
Width = 127
- ItemHeight = 20
+ ItemHeight = 15
OnSelect = FontComboBoxSelect
TabOrder = 0
end
object FontSizeComboBox: TComboBox
Left = 179
- Height = 28
+ Height = 23
Top = 2
Width = 48
- ItemHeight = 20
+ ItemHeight = 15
Items.Strings = (
'8'
'9'
@@ -394,7 +394,7 @@ object MainFrm: TMainFrm
TabOrder = 2
object EdCellAddress: TEdit
Left = 0
- Height = 28
+ Height = 23
Top = 0
Width = 170
Align = alTop
@@ -406,7 +406,7 @@ object MainFrm: TMainFrm
end
object InspectorSplitter: TSplitter
Left = 648
- Height = 446
+ Height = 451
Top = 86
Width = 5
Align = alRight
@@ -414,7 +414,7 @@ object MainFrm: TMainFrm
end
object InspectorPageControl: TPageControl
Left = 653
- Height = 446
+ Height = 451
Top = 86
Width = 231
ActivePage = PgCellValue
@@ -424,11 +424,11 @@ object MainFrm: TMainFrm
OnChange = InspectorPageControlChange
object PgCellValue: TTabSheet
Caption = 'Cell value'
- ClientHeight = 413
+ ClientHeight = 423
ClientWidth = 223
object CellInspector: TValueListEditor
Left = 0
- Height = 413
+ Height = 423
Top = 0
Width = 223
Align = alClient
@@ -472,7 +472,7 @@ object MainFrm: TMainFrm
end
object TabControl: TTabControl
Left = 0
- Height = 446
+ Height = 451
Top = 86
Width = 648
OnChange = TabControlChange
@@ -480,7 +480,7 @@ object MainFrm: TMainFrm
TabOrder = 3
object WorksheetGrid: TsWorksheetGrid
Left = 2
- Height = 441
+ Height = 446
Top = 3
Width = 644
FrozenCols = 0
@@ -498,7 +498,7 @@ object MainFrm: TMainFrm
OnHeaderClick = WorksheetGridHeaderClick
OnSelection = WorksheetGridSelection
ColWidths = (
- 56
+ 42
64
64
64
diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas
index 692a75f9d..5762ce244 100644
--- a/components/fpspreadsheet/examples/spready/mainform.pas
+++ b/components/fpspreadsheet/examples/spready/mainform.pas
@@ -761,20 +761,26 @@ end;
procedure TMainFrm.AcSortColAscExecute(Sender: TObject);
var
c, r: Cardinal;
- colIndexes: TsIndexArray;
+ sortParams: TsSortParams;
begin
r := WorksheetGrid.GetWorksheetRow(WorksheetGrid.Row);
c := WorksheetGrid.GetWorksheetCol(WorksheetGrid.Col);
- SetLength(colIndexes, 1);
- colIndexes[0] := c;
- with WorksheetGrid.Worksheet do
- SortCols(ssoAscending, colIndexes, 0, c, GetLastOccupiedRowIndex, c);
+ SetLength(sortParams.Keys, 1);
+ sortParams.Keys[0].ColRowIndex := c;
+ sortParams.Keys[0].Order := ssoAscending;
+ sortParams.SortByCols := true;
+ WorksheetGrid.BeginUpdate;
+ try
+ with WorksheetGrid.Worksheet do
+ Sort(sortParams, 0, c, GetLastOccupiedRowIndex, c);
+ finally
+ WorksheetGrid.EndUpdate;
+ end;
end;
procedure TMainFrm.AcSortExecute(Sender: TObject);
var
F: TSortParamsForm;
- indexes: TsIndexArray;
r1,c1,r2,c2: Cardinal;
begin
F := TSortParamsForm.Create(nil);
@@ -782,23 +788,19 @@ begin
F.WorksheetGrid := WorksheetGrid;
if F.ShowModal = mrOK then
begin
- indexes := F.SortIndex;
- if Length(indexes) > 0 then
- begin
- // Limits of the range to be sorted
- with WorksheetGrid do begin
- r1 := GetWorksheetRow(Selection.Top);
- c1 := GetWorksheetCol(Selection.Left);
- r2 := GetWorksheetRow(Selection.Bottom);
- c2 := GetWorksheetCol(Selection.Right);
- end;
- // Execute sorting. Use Begin/EndUpdate to avoid unnecessary redraws.
- WorksheetGrid.BeginUpdate;
- try
- WorksheetGrid.Worksheet.Sort(F.SortByCols, ssoAscending, indexes, r1, c1, r2, c2)
- finally
- WorksheetGrid.EndUpdate;
- end;
+ // Limits of the range to be sorted
+ with WorksheetGrid do begin
+ r1 := GetWorksheetRow(Selection.Top);
+ c1 := GetWorksheetCol(Selection.Left);
+ r2 := GetWorksheetRow(Selection.Bottom);
+ c2 := GetWorksheetCol(Selection.Right);
+ end;
+ // Execute sorting. Use Begin/EndUpdate to avoid unnecessary redraws.
+ WorksheetGrid.BeginUpdate;
+ try
+ WorksheetGrid.Worksheet.Sort(F.SortParams, r1, c1, r2, c2)
+ finally
+ WorksheetGrid.EndUpdate;
end;
end;
finally
diff --git a/components/fpspreadsheet/examples/spready/spready.lpi b/components/fpspreadsheet/examples/spready/spready.lpi
index b22616152..457404471 100644
--- a/components/fpspreadsheet/examples/spready/spready.lpi
+++ b/components/fpspreadsheet/examples/spready/spready.lpi
@@ -111,12 +111,10 @@
-
-
@@ -124,12 +122,12 @@
-
+
diff --git a/components/fpspreadsheet/examples/spready/ssortparamsform.lfm b/components/fpspreadsheet/examples/spready/ssortparamsform.lfm
index 80342ebf1..0ea1c5efd 100644
--- a/components/fpspreadsheet/examples/spready/ssortparamsform.lfm
+++ b/components/fpspreadsheet/examples/spready/ssortparamsform.lfm
@@ -9,8 +9,8 @@ object SortParamsForm: TSortParamsForm
LCLVersion = '1.3'
object ButtonPanel: TButtonPanel
Left = 6
- Height = 38
- Top = 259
+ Height = 34
+ Top = 263
Width = 362
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
@@ -26,7 +26,7 @@ object SortParamsForm: TSortParamsForm
end
object Grid: TStringGrid
Left = 0
- Height = 203
+ Height = 207
Top = 50
Width = 374
Align = alClient
@@ -34,6 +34,7 @@ object SortParamsForm: TSortParamsForm
Columns = <
item
ButtonStyle = cbsPickList
+ ReadOnly = False
Title.Caption = 'Column'
Width = 120
end
@@ -47,10 +48,11 @@ object SortParamsForm: TSortParamsForm
Width = 150
end>
DefaultColWidth = 100
- Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll]
+ Options = [goFixedVertLine, goFixedHorzLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll]
RowCount = 2
TabOrder = 1
TitleStyle = tsNative
+ OnSelectEditor = GridSelectEditor
Cells = (
1
0
@@ -58,7 +60,7 @@ object SortParamsForm: TSortParamsForm
'Sort by'
)
end
- object Panel1: TPanel
+ object TopPanel: TPanel
Left = 0
Height = 50
Top = 0
@@ -72,26 +74,98 @@ object SortParamsForm: TSortParamsForm
Left = 7
Height = 30
Top = 10
- Width = 75
+ Width = 83
Caption = 'Add'
+ Glyph.Data = {
+ 36040000424D3604000000000000360000002800000010000000100000000100
+ 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF0041924E233D8F497D3A8C44DB368940F332873CF32F84
+ 37DB2C81337D287F3023FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF0049995853459653E6419950FF7DC28FFF96D0A6FF96CFA6FF78BE
+ 89FF368D42FF2C8134E6297F3053FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00519F61534D9C5DF464B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB
+ 98FFA5D9B4FF58AA6BFF2C8134F4297F3053FFFFFF00FFFFFF00FFFFFF0059A6
+ 6B2256A366E56AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5
+ 6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234E5297F3022FFFFFF00FFFFFF005DA9
+ 707E53AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8
+ 70FF58B56EFF5CB774FFA6DAB4FF388F43FF2C82347EFFFFFF00FFFFFF0061AC
+ 75DB8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8
+ 70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539DBFFFFFF00FFFFFF0065AF
+ 7AF6A9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DF6FFFFFF00FFFFFF0069B2
+ 7EF6B6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42F6FFFFFF00FFFFFF006DB5
+ 83DBACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC
+ 6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47DBFFFFFF00FFFFFF0070B8
+ 877E85C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD
+ 85FF6BC37CFF6FC77EFFACDFB5FF459E57FF40914C7EFFFFFF00FFFFFF0073BA
+ 8A2270B887E5AADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4
+ 95FF83D28EFFAFE0B7FF6BB97DFF489856E544945122FFFFFF00FFFFFF00FFFF
+ FF0073BB8B5370B887F4AFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF
+ AFFFC0E8C5FF79C28AFF509E5FF44C9B5B53FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF0073BB8B5371B887E694CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD
+ B8FF6DB97FFF58A569E654A16553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF0074BB8B2371B9887D6EB684DB6AB380F367B17CF363AE
+ 77DB60AB737D5CA86E23FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
+ }
OnClick = BtnAddClick
TabOrder = 0
end
object BtnDelete: TBitBtn
- Left = 87
+ Left = 96
Height = 30
Top = 10
- Width = 75
+ Width = 83
Caption = 'Delete'
+ Glyph.Data = {
+ 36040000424D3604000000000000360000002800000010000000100000000100
+ 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF003F54C3233A50C27D3853BEDB3551BDF3304BBCF32E4E
+ B8DB2B4CB77D2748B523FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF004658C8534255C6E63C52CCFF757AE8FF8F92EEFF8F92EEFF7178
+ E4FF334DC1FF2B4AB7E6294BB553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF004D5ACD534959CBF45C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
+ EEFF9EA0F4FF515DD7FF2B4AB7F4294BB553FFFFFF00FFFFFF00FFFFFF00545F
+ D2225361CFE5616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
+ E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8E5294BB522FFFFFF00FFFFFF005860
+ D47E4B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
+ E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF2A4AB87EFFFFFF00FFFFFF005C62
+ D7DB818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
+ E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBADBFFFFFF00FFFFFF005F63
+ DAF6A1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCF6FFFFFF00FFFFFF006469
+ DBF6AFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEF6FFFFFF00FFFFFF00676A
+ DEDBA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
+ ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0DBFFFFFF00FFFFFF006A69
+ E07E7D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
+ F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF3E54C27EFFFFFF00FFFFFF006C6C
+ E1226A69E0E5A3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
+ F9FF768CF8FFA8B6F8FF636EE3FF4557C7E54156C522FFFFFF00FFFFFF00FFFF
+ FF006D6CE3536A69E0F4AAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
+ FBFFBAC7FCFF707BE9FF4C5BCCF44858CA53FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF006D6CE3536A6ADFE68E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
+ F4FF6670E2FF535ED1E6505DCE53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF006D6DE2236B6AE17D686ADDDB6364DCF36164DAF35D63
+ D9DB5B63D67D5862D423FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
+ }
OnClick = BtnDeleteClick
TabOrder = 1
end
object CbSortColsRows: TComboBox
- Left = 168
- Height = 28
- Top = 11
+ Left = 186
+ Height = 23
+ Top = 13
Width = 160
- ItemHeight = 20
+ ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'Sort top to bottom'
diff --git a/components/fpspreadsheet/examples/spready/ssortparamsform.pas b/components/fpspreadsheet/examples/spready/ssortparamsform.pas
index 3903bf0a5..182182fda 100644
--- a/components/fpspreadsheet/examples/spready/ssortparamsform.pas
+++ b/components/fpspreadsheet/examples/spready/ssortparamsform.pas
@@ -18,25 +18,25 @@ type
BtnDelete: TBitBtn;
ButtonPanel: TButtonPanel;
CbSortColsRows: TComboBox;
- Panel1: TPanel;
+ TopPanel: TPanel;
Grid: TStringGrid;
procedure BtnAddClick(Sender: TObject);
procedure BtnDeleteClick(Sender: TObject);
procedure CbSortColsRowsChange(Sender: TObject);
+ procedure GridSelectEditor(Sender: TObject; aCol, aRow: Integer;
+ var Editor: TWinControl);
procedure OKButtonClick(Sender: TObject);
private
{ private declarations }
FWorksheetGrid: TsWorksheetGrid;
- function GetSortByCols: Boolean;
- function GetSortIndex: TsIndexArray;
+ function GetSortParams: TsSortParams;
procedure SetWorksheetGrid(AValue: TsWorksheetGrid);
procedure UpdateColRowList;
procedure UpdateCmds;
function ValidParams(out AMsg: String): Boolean;
public
{ public declarations }
- property SortByCols: Boolean read GetSortByCols;
- property SortIndex: TsIndexArray read GetSortIndex;
+ property SortParams: TsSortParams read GetSortParams;
property WorksheetGrid: TsWorksheetGrid read FWorksheetGrid write SetWorksheetGrid;
end;
@@ -54,6 +54,13 @@ begin
UpdateCmds;
end;
+procedure TSortParamsForm.GridSelectEditor(Sender: TObject;
+ aCol, aRow: Integer; var Editor: TWinControl);
+begin
+ if (Editor is TCustomComboBox) then
+ (Editor as TCustomComboBox).Style := csDropDownList;
+end;
+
procedure TSortParamsForm.OKButtonClick(Sender: TObject);
var
msg: String;
@@ -88,35 +95,54 @@ begin
UpdateCmds;
end;
-function TSortParamsForm.GetSortByCols: Boolean;
-begin
- Result := CbSortColsRows.ItemIndex = 0;
-end;
-
-function TSortParamsForm.GetSortIndex: TsIndexArray;
+function TSortParamsForm.GetSortParams: TsSortParams;
var
i, p: Integer;
- s: String;
n: Cardinal;
+ sortDir: TsSortOrder;
+ s: String;
begin
- SetLength(Result, 0);
- s:= Grid.Cells[0, 0];
- s := Grid.Cells[0, 1];
- for i:= Grid.FixedRows to Grid.RowCount-1 do
+ Result.SortByCols := CbSortColsRows.ItemIndex = 0;
+ SetLength(Result.Keys, 0);
+ for i:=Grid.FixedRows to Grid.RowCount-1 do
begin
- s := Grid.Cells[1, i];
- if s <> '' then
- begin
- p := pos(' ', s);
- s := Copy(s, p+1, Length(s));
- case CbSortColsRows.ItemIndex of
- 0: if not ParseCellColString(s, n) then continue; // row index
- 1: if not TryStrToInt(s, LongInt(n)) then continue else dec(n); // column index
- end;
- SetLength(Result, Length(Result)+1);
- Result[Length(Result)-1] := n;
+ 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.');
+ // This case should have been detected already by the ValidParams method.
+
+ p := pos(' ', s); // we look for the space and extract column/row index
+ if p = 0 then
+ raise Exception.Create('[TSortParamsForm.GetSortParams] Unexpected string in grid.');
+ s := copy(s, p+1, Length(s));
+ case CbSortColsRows.ItemIndex of
+ 0: if not ParseCellColString(s, n) then
+ raise Exception.CreateFmt('[TSortParamsForm.GetSortParams] '+
+ 'Unexpected column identifier in row %d', [i]);
+ 1: if TryStrToInt(s, LongInt(n)) then
+ dec(n)
+ else
+ raise Exception.CreateFmt('[TSortParamsForm.GetSortParams] ' +
+ 'Unexpected row identifier in row %s', [i]);
end;
- end;
+
+ s := Grid.Cells[2, i];
+ if s = '' then
+ raise Exception.Create('[TSortParamsForm.GetSortParams] No sort direction selected.');
+
+ // 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;
+
+ SetLength(Result.Keys, Length(Result.Keys) + 1);
+ with Result.Keys[Length(Result.Keys)-1] do
+ begin
+ Order := sortDir;
+ ColRowIndex := n;
+ end;
+ end; // for
end;
procedure TSortParamsForm.SetWorksheetGrid(AValue: TsWorksheetGrid);
@@ -124,12 +150,15 @@ begin
FWorksheetGrid := AValue;
UpdateColRowList;
UpdateCmds;
+ Grid.Cells[1, 1] := Grid.Columns[0].PickList[0];
+ Grid.Cells[2, 1] := Grid.Columns[1].PickList[0];
end;
procedure TSortParamsForm.UpdateColRowList;
var
- r,c, r1,c1, r2,c2: Cardinal;
L: TStrings;
+ r,c: Cardinal;
+ r1,c1, r2,c2: Cardinal;
begin
with FWorksheetGrid do begin
r1 := GetWorksheetRow(Selection.Top);
@@ -184,13 +213,24 @@ begin
end;
function TSortParamsForm.ValidParams(out AMsg: String): Boolean;
+var
+ i: Integer;
begin
Result := false;
- if Length(SortIndex) = 0 then
+ for i:=Grid.FixedRows to Grid.RowCount-1 do
begin
- AMsg := 'No sorting criteria selected.';
- Grid.SetFocus;
- exit;
+ if Grid.Cells[1, i] = '' then
+ begin
+ AMsg := Format('No sorting criteria selected in row %d.', [i]);
+ Grid.SetFocus;
+ exit;
+ end;
+ if Grid.Cells[2, i] = '' then
+ begin
+ AMsg := Format('No sort order specified in row %d.', [i]);
+ Grid.SetFocus;
+ exit;
+ end;
end;
Result := true;
end;
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index b2a2951a4..4676e2170 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -442,12 +442,26 @@ type
{@@ Pointer to a TCol record }
PCol = ^TCol;
- {@@ Row and column index array }
- TsIndexArray = array of cardinal;
-
{@@ Sort order }
TsSortOrder = (ssoAscending, ssoDescending);
+ {@@ Sort key: sorted column or row index and sort direction }
+ TsSortKey = record
+ ColRowIndex: Integer;
+ Order: TsSortOrder;
+ end;
+
+ {@@ Array of sort keys for multiple sorting criteria }
+ TsSortKeys = array of TsSortKey;
+
+ {@@ Complete set of sorting parameters
+ @param SortByCols If true sorting is top-down, otherwise left-right
+ @param SortKeys Array of sorting indexes and sorting directions }
+ TsSortParams = record
+ SortByCols: Boolean;
+ Keys: TsSortKeys;
+ end;
+
{@@ Worksheet user interface options:
@param soShowGridLines Show or hide the grid lines in the spreadsheet
@param soShowHeaders Show or hide the column or row headers of the spreadsheet
@@ -494,8 +508,6 @@ type
FLastColIndex: Cardinal;
FDefaultColWidth: Single; // in "characters". Excel uses the width of char "0" in 1st font
FDefaultRowHeight: Single; // in "character heights", i.e. line count
- FSortOrder: TsSortOrder;
- FSortIndexes: TsIndexArray;
FOnChangeCell: TsCellEvent;
FOnChangeFont: TsCellEvent;
FOnCompareCells: TsCellCompareEvent;
@@ -524,7 +536,7 @@ type
procedure RemoveAndFreeCell(ARow, ACol: Cardinal);
// Sorting
- function DoCompareCells(ACell1, ACell2: PCell): Integer;
+ function DoCompareCells(ACell1, ACell2: PCell; ASortOrder: TsSortOrder): Integer;
procedure DoExchangeColRow(AIsColumn: Boolean; AIndex, WithIndex: Cardinal;
AFromIndex, AToIndex: Cardinal);
@@ -763,16 +775,9 @@ type
procedure WriteColWidth(ACol: Cardinal; AWidth: Single);
// Sorting
- procedure Sort(AColSorting: Boolean; ASortOrder: TsSortOrder;
- ASortIndexes: TsIndexArray; ARowFrom, AColFrom, ARowTo, AColTo: Integer);
- procedure SortCols(ASortOrder: TsSortOrder; ASortColumns: TsIndexArray;
+ procedure Sort(const ASortParams: TsSortParams;
ARowFrom, AColFrom, ARowTo, AColTo: Cardinal); overload;
- procedure SortCols(ASortOrder: TsSortOrder; ASortColumns: TsIndexArray;
- const ARange: String); overload;
- procedure SortRows(ASortOrder: TsSortOrder; ASortRows: TsIndexArray;
- ARowFrom, AColFrom, ARowTo, AColTo: Cardinal); overload;
- procedure SortRows(ASortOrder: TsSortOrder; ASortRows: TsIndexArray;
- const ARange: String); overload;
+ procedure Sort(ASortParams: TsSortParams; ARange: String); overload;
{ Properties }
@@ -3189,8 +3194,9 @@ end;
{@@ ----------------------------------------------------------------------------
Compare function for sorting of rows and columns
- @param ACell1 Pointer to the first cell of the comparison
- @param ACell2 Pointer to the second 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 ASortOrder Order of sorting, ascending or descending
@return -1 if the first cell is "smaller"
+1 if the first cell is "larger",
0 if both cells are "equal"
@@ -3203,7 +3209,8 @@ end;
Empty cells are "smallest", Label cells are next, Numeric cells
are "largest"
-------------------------------------------------------------------------------}
-function TsWorksheet.DoCompareCells(ACell1, ACell2: PCell): Integer;
+function TsWorksheet.DoCompareCells(ACell1, ACell2: PCell;
+ ASortOrder: TsSortOrder): Integer;
// Sort priority in Excel:
// blank < alpha < number, dates are sorted according to their number value
var
@@ -3243,7 +3250,8 @@ begin
Result := CompareValue(number1, number2);
end;
end;
- if FSortOrder = ssoDescending then Result := -Result;
+ if ASortOrder = ssoDescending then
+ Result := -Result;
end;
{@@ ----------------------------------------------------------------------------
@@ -3275,9 +3283,38 @@ begin
end;
{@@ ----------------------------------------------------------------------------
+ Sorts a range of cells defined by the cell rectangle from ARowFrom/AColFrom
+ to ARowTo/AColTo according to the parameters specified in ASortParams
+
+ @param ASortParams Set of parameters to define sorting along rows or colums,
+ the sorting key column or row indexes, and the sorting
+ directions
+ @param ARange Cell range to be sorted, in Excel notation, such as 'A1:C8'
-------------------------------------------------------------------------------}
-procedure TsWorksheet.Sort(AColSorting: Boolean; ASortOrder: TsSortOrder;
- ASortIndexes: TsIndexArray; ARowFrom, AColFrom, ARowTo, AColTo: Integer);
+procedure TsWorksheet.Sort(ASortParams: TsSortParams; ARange: String);
+var
+ r1,c1, r2,c2: Cardinal;
+begin
+ if ParseCellRangeString(ARange, r1, c1, r2, c2) then
+ Sort(ASortParams, r1, c1, r2, c2)
+ else
+ raise Exception.CreateFmt(rsNoValidCellRangeAddress, [ARange]);
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Sorts a range of cells defined by the cell rectangle from ARowFrom/AColFrom
+ to ARowTo/AColTo according to the parameters specified in ASortParams
+
+ @param ASortParams Set of parameters to define sorting along rows or colums,
+ the sorting key column or row indexes, and the sorting
+ directions
+ @param ARowFrom Top row of the range to be sorted
+ @param AColFrom Left column of the range to be sorted
+ @param ARowTo Last row of the range to be sorted
+ @param AColTo Right column of the range to be sorted
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
+ ARowFrom, AColFrom, ARowTo, AColTo: Cardinal);
procedure QuickSort(L,R: Integer);
var
@@ -3291,85 +3328,78 @@ procedure TsWorksheet.Sort(AColSorting: Boolean; ASortOrder: TsSortOrder;
J := R;
P := (L+R) div 2;
repeat
- if AColSorting then
+ if ASortParams.SortByCols then
begin
+ // Sorting by columns
K := 0;
- repeat
- cell1 := FindCell(P, ASortIndexes[K]);
- cell2 := FindCell(I, ASortIndexes[K]);
- compareResult := DoCompareCells(cell1, cell2);
- case compareResult of
+ 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(ASortIndexes) then
- inc(K)
- else
- break;
+ 0: if K <= High(ASortParams.Keys) then inc(K) else break;
+1: inc(I);
end;
- until false;
-
+ end;
K := 0;
- repeat
- cell1 := FindCell(P, ASortIndexes[K]);
- cell2 := FindCell(J, ASortIndexes[K]);
- compareResult := DoCompareCells(cell1, cell2);
- case compareResult of
+ 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: dec(J);
- 0: if K < High(ASortIndexes) then
- inc(K)
- else
- break;
+ 0: if K <= High(ASortParams.Keys) then inc(K) else break;
+1: break;
end;
- until false;
+ end;
end else
begin
+ // Sorting by rows
K := 0;
- repeat
- cell1 := FindCell(ASortIndexes[K], P);
- cell2 := FindCell(ASortIndexes[K], I);
- compareResult := DoCompareCells(cell1, cell2);
- case compareResult of
+ 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(ASortIndexes) then
- inc(K)
- else
- break;
+ 0: if K <= High(ASortParams.Keys) then inc(K) else break;
+1: inc(I);
end;
- until False;
+ end;
K := 0;
- repeat
- cell1 := FindCell(ASortIndexes[K], P);
- cell2 := FindCell(ASortIndexes[K], J);
- compareResult := DoCompareCells(cell1, cell2);
- case compareResult of
+ 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: dec(J);
- 0: if K < High(ASortIndexes) then
- inc(K)
- else
- break;
+ 0: if K <= High(ASortParams.Keys) then inc(K) else break;
+1: break;
end;
- until false;
+ end;
end;
if I <= J then
begin
if I <> J then
begin
- if AColSorting then
+ if ASortParams.SortByCols then
begin
- cell1 := FindCell(I, ASortIndexes[0]);
- cell2 := FIndCell(J, ASortIndexes[0]);
- if DoCompareCells(cell1, cell2) <> 0 then
- DoExchangeColRow(not AColSorting, J,I, AColFrom, AColTo);
+ 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);
end else
begin
- cell1 := FindCell(ASortIndexes[0], I);
- cell2 := FIndCell(ASortIndexes[0], J);
- if DoCompareCells(cell1, cell2) <> 0 then
- DoExchangeColRow(not AColSorting, J,I, ARowFrom, ARowTo);
+ 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);
end;
end;
@@ -3392,45 +3422,13 @@ procedure TsWorksheet.Sort(AColSorting: Boolean; ASortOrder: TsSortOrder;
end;
begin
- FSortOrder := ASortOrder;
- FSortIndexes := ASortIndexes;
- if AColSorting then
+ if ASortParams.SortByCols then
QuickSort(ARowFrom, ARowTo)
else
QuickSort(AColFrom, AColTo);
ChangedCell(ARowFrom, AColFrom);
end;
-procedure TsWorksheet.SortCols(ASortOrder: TsSortOrder; ASortColumns: TsIndexArray;
- const ARange: String);
-var
- r1,c1, r2,c2: Cardinal;
-begin
- if ParseCellRangeString(ARange, r1, c1, r2, c2) then
- SortCols(ASortOrder, ASortColumns, r1, c1, r2, c2);
-end;
-
-procedure TsWorksheet.SortCols(ASortOrder: TsSortOrder; ASortColumns: TsIndexArray;
- ARowFrom, AColFrom, ARowTo, AColTo: Cardinal);
-begin
- Sort(true, ASortOrder, ASortColumns, ARowFrom, AColFrom, ARowTo, AColTo);
-end;
-
-procedure TsWorksheet.SortRows(ASortOrder: TsSortOrder; ASortRows: TsIndexArray;
- const ARange: String);
-var
- r1,c1, r2,c2: Cardinal;
-begin
- if ParseCellRangeString(ARange, r1, c1, r2, c2) then
- SortRows(ASortOrder, ASortRows, r1, c1, r2, c2);
-end;
-
-procedure TsWorksheet.SortRows(ASortOrder: TsSortOrder; ASortRows: TsIndexArray;
- ARowFrom, AColFrom, ARowTo, AColTo: Cardinal);
-begin
- Sort(false, ASortOrder, ASortRows, ARowFrom, AColFrom, ARowTo, AColTo);
-end;
-
{@@ ----------------------------------------------------------------------------
Helper method to update internal caching variables
diff --git a/components/fpspreadsheet/tests/sortingtests.pas b/components/fpspreadsheet/tests/sortingtests.pas
new file mode 100644
index 000000000..80363a611
--- /dev/null
+++ b/components/fpspreadsheet/tests/sortingtests.pas
@@ -0,0 +1,285 @@
+unit sortingtests;
+
+{$mode objfpc}{$H+}
+
+interface
+{ Tests for sorting cells
+}
+
+uses
+ // Not using Lazarus package as the user may be working with multiple versions
+ // Instead, add .. to unit search path
+ Classes, SysUtils, fpcunit, testregistry,
+ fpspreadsheet, xlsbiff2, xlsbiff5, xlsbiff8, fpsopendocument, {and a project requirement for lclbase for utf8 handling}
+ testsutility;
+
+var
+ // Norm to test against - list of numbers and strings that will be sorted
+ SollSortNumbers: array[0..9] of Double;
+ SollSortStrings: array[0..9] of String;
+
+ procedure InitUnsortedData;
+
+type
+ { TSpreadSortingTests }
+ TSpreadSortingTests = class(TTestCase)
+ private
+ protected
+ // Set up expected values:
+ procedure SetUp; override;
+ procedure TearDown; override;
+ procedure Test_Sorting(
+ ASortByCols: Boolean;
+ AMode: Integer // AMode = 0: number, 1: strings, 2: mixed
+ );
+
+ published
+ procedure Test_SortingByCols_Numbers;
+ procedure Test_SortingByCols_Strings;
+ procedure Test_SortingByCols_Mixed;
+ {
+ procedure Test_SortingByRows_Numbers;
+ procedure Test_SortingByRows_Strings;
+ procedure Test_SortingByRows_Mixed;
+ }
+ end;
+
+implementation
+
+const
+ SortingTestSheet = 'Sorting';
+
+procedure InitUnsortedData;
+// When sorted the value is equal to the index
+begin
+ SollSortNumbers[0] := 9; // Equal count of numbers and strings needed
+ SollSortNumbers[1] := 8;
+ SollSortNumbers[2] := 5;
+ SollSortNumbers[3] := 2;
+ SollSortNumbers[4] := 6;
+ SollSortNumbers[5] := 7;
+ SollSortNumbers[6] := 1;
+ SollSortNumbers[7] := 3;
+ SollSortNumbers[8] := 4;
+ SollSortNumbers[9] := 0;
+
+ SollSortStrings[0] := 'C';
+ SollSortStrings[1] := 'G';
+ SollSortStrings[2] := 'F';
+ SollSortStrings[3] := 'I';
+ SollSortStrings[4] := 'B';
+ SollSortStrings[5] := 'D';
+ SollSortStrings[6] := 'J';
+ SollSortStrings[7] := 'H';
+ SollSortStrings[8] := 'E';
+ SollSortStrings[9] := 'A';
+end;
+
+
+{ TSpreadSortingTests }
+
+procedure TSpreadSortingTests.SetUp;
+begin
+ inherited SetUp;
+ InitUnsortedData;
+end;
+
+procedure TSpreadSortingTests.TearDown;
+begin
+ inherited TearDown;
+end;
+
+procedure TSpreadSortingTests.Test_Sorting(ASortByCols: Boolean;
+ AMode: Integer);
+const
+ AFormat = sfExcel8;
+var
+ MyWorksheet: TsWorksheet;
+ MyWorkbook: TsWorkbook;
+ i, row, col: Integer;
+ MyCell: PCell;
+ TempFile: string; //write xls/xml to this file and read back from it
+ L: TStringList;
+ s: String;
+ sortParams: TsSortParams;
+ sortDir: TsSortOrder;
+ r1,r2,c1,c2: Cardinal;
+ actualNumber: Double;
+ actualString: String;
+ expectedNumber: Double;
+ expectedString: String;
+
+begin
+ TempFile := GetTempFileName;
+
+ MyWorkbook := TsWorkbook.Create;
+ try
+ MyWorkSheet:= MyWorkBook.AddWorksheet(SortingTestSheet);
+
+ col := 0;
+ row := 0;
+ SetLength(sortParams.Keys, 1);
+ sortparams.Keys[0].ColRowIndex := 0;
+ if ASortByCols then begin
+ sortParams.SortByCols := true;
+ r1 := 0;
+ r2 := High(SollSortNumbers);
+ c1 := 0;
+ c2 := 0;
+ case AMode of
+ 0: for i :=0 to High(SollSortNumbers) do
+ MyWorksheet.WriteNumber(i, col, SollSortNumbers[i]);
+ 1: for i := 0 to High(SollSortStrings) do
+ Myworksheet.WriteUTF8Text(i, col, SollSortStrings[i]);
+ 2: begin
+ for i := 0 to High(SollSortNumbers) do
+ MyWorkSheet.WriteNumber(i*2, col, SollSortNumbers[i]);
+ for i := 0 to High(SollSortStrings) do
+ MyWorksheet.WriteUTF8Text(i*2+1, col, SollSortStrings[i]);
+ end;
+ end
+ end
+ else begin
+ sortParams.SortByCols := false;
+ r1 := 0;
+ r2 := 0;
+ c1 := 0;
+ c2 := High(SollSortNumbers);
+ case AMode of
+ 0: for i := 0 to High(SollSortNumbers) do
+ MyWorksheet.WriteNumber(row, i, SollSortNumbers[i]);
+ 1: for i := 0 to High(SollSortStrings) do
+ MyWorksheet.WriteUTF8Text(row, i, SollSortStrings[i]);
+ 2: begin
+ for i := 0 to High(SollSortNumbers) do
+ myWorkSheet.WriteNumber(row, i*2, SollSortNumbers[i]);
+ for i:=0 to High(SollSortStrings) do
+ MyWorksheet.WriteUTF8Text(row, i*2+1, SollSortStrings[i]);
+ end;
+ end;
+ end;
+ MyWorkBook.WriteToFile(TempFile, AFormat, true);
+ finally
+ MyWorkbook.Free;
+ end;
+
+ // Test ascending and descending sort orders
+ for sortDir in TsSortOrder do
+ begin
+ MyWorkbook := TsWorkbook.Create;
+ try
+ 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');
+
+ sortParams.Keys[0].Order := sortDir;
+ MyWorksheet.Sort(sortParams, r1,c1, r2, c2);
+
+ if ASortByCols then
+ case AMode of
+ 0: for i:=0 to MyWorksheet.GetLastColIndex do
+ begin
+ actualNumber := MyWorksheet.ReadAsNumber(i, col);
+ if sortDir = ssoAscending then expectedNumber := i
+ else expectedNumber := High(SollSortNumbers)-i;
+ CheckEquals(actualnumber, expectedNumber,
+ 'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, i, col));
+ end;
+ 1: for i:=0 to Myworksheet.GetLastColIndex do
+ begin
+ actualString := MyWorksheet.ReadAsUTF8Text(i, col);
+ if sortDir = ssoAscending then expectedString := char(ord('A') + i)
+ else expectedString := char(ord('A') + High(SollSortStrings)-i);
+ CheckEquals(actualString, expectedString,
+ 'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, i, col));
+ end;
+ 2: begin (* to be done...
+ for i:=0 to High(SollNumbers) do
+ begin
+ actualNumber := MyWorkbook.ReadAsNumber(i*2, col);
+ if sortdir =ssoAscending then
+ expectedNumber := i
+ CheckEquals(actualnumber, expectedNumber,
+ 'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, i*2, col));
+ end;
+ for i:=0 to High(SollStrings) do
+ begin
+ actualString := MyWorkbook.ReadAsUTF8String(i*2+1, col);
+ expectedString := SollStrings[i];
+ CheckEquals(actualString, expectedString,
+ 'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, i*2+1, col));
+ end;
+ *)
+ end;
+ end // case
+ else
+ case AMode of
+ 0: for i:=0 to MyWorksheet.GetLastColIndex do
+ begin
+ actualNumber := MyWorksheet.ReadAsNumber(row, i);
+ if sortDir = ssoAscending then expectedNumber := i
+ else expectedNumber := High(SollSortNumbers)-i;
+ CheckEquals(actualnumber, expectedNumber,
+ 'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, row, i));
+ end;
+ 1: for i:=0 to MyWorksheet.GetLastColIndex do
+ begin
+ actualString := MyWorksheet.ReadAsUTF8Text(row, i);
+ if sortDir = ssoAscending then expectedString := char(ord('A')+i)
+ else expectedString := char(ord('A') + High(SollSortStrings)-i);
+ CheckEquals(actualString, expectedString,
+ 'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, row, i));
+ end;
+ 2: begin{
+ for i:=0 to High(SollNumbers) do
+ begin
+ actualNumber := MyWorkbook.ReadAsNumber(row, i*2);
+ expectedNumber := SollNumbers[i];
+ CheckEquals(actualnumber, expectedNumber,
+ 'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, row, i*2));
+ end;
+ for i:=0 to High(SollStrings) do
+ begin
+ actualString := MyWorkbook.ReadAsUTF8String(row, i*2+1);
+ expectedString := SollStrings[i];
+ CheckEquals(actualString, expectedString,
+ 'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, row, i*2+1));
+ end;
+ }
+ end;
+ end; // case
+
+ finally
+ MyWorkbook.Free;
+ end;
+ end; // for sortDir
+
+ DeleteFile(TempFile);
+end;
+
+
+procedure TSpreadSortingTests.Test_SortingByCols_Numbers;
+begin
+ Test_Sorting(true, 0);
+end;
+
+procedure TSpreadSortingTests.Test_SortingByCols_Strings;
+begin
+ Test_Sorting(true, 1);
+end;
+
+procedure TSpreadSortingTests.Test_SortingByCols_Mixed;
+begin
+ //Test_Sorting(true, 2);
+end;
+
+initialization
+ RegisterTest(TSpreadSortingTests);
+ InitUnsortedData;
+
+end.
+
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi
index 9777d67ac..fe7e6b7c0 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpi
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpi
@@ -40,7 +40,7 @@
-
+
@@ -56,7 +56,6 @@
-
@@ -127,8 +126,12 @@
-
+
+
+
+
+
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpr b/components/fpspreadsheet/tests/spreadtestgui.lpr
index b74ade532..f0da3c0c4 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpr
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpr
@@ -12,7 +12,7 @@ uses
manualtests, testsutility, internaltests, formattests, colortests, fonttests,
optiontests, numformatparsertests, formulatests, rpnFormulaUnit,
emptycelltests, errortests, virtualmodetests, insertdeletetests,
- celltypetests;
+ celltypetests, sortingtests;
begin
{$IFDEF HEAPTRC}