### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### Author Topic: [solved] TStringList Sorting  (Read 472 times)

#### Handoko

• Hero Member
• Posts: 4006
• My goal: build my own game engine using Lazarus
##### [solved] TStringList Sorting
« on: October 21, 2020, 06:38:53 pm »
Hello fellas, please help me.

I know there are many sorting algorithms but honestly I have never really studied any of them.
https://en.wikipedia.org/wiki/Sorting_algorithm

I have a TStringList with all of the items are numbered strings. The automatic sorted result is:
Quote
111
45
4516
4523
4534
4547
547
999

But what I want is like this:
Quote
45
111
547
999
4516
4523
4534
4547

Writing something that I'm not sure, I rather ask someone to write it for me. Performance is not important because the item count is usually less than a hundred.

Code: Pascal  [Select][+][-]
1. unit Unit1;
2.
3. {\$mode objfpc}{\$H+}
4.
5. interface
6.
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, StdCtrls;
9.
10. type
11.
12.   { TForm1 }
13.
14.   TForm1 = class(TForm)
15.     Button1: TButton;
16.     Memo1: TMemo;
17.     procedure Button1Click(Sender: TObject);
18.   end;
19.
20. var
21.   Form1: TForm1;
22.
23. implementation
24.
25. {\$R *.lfm}
26.
27. { TForm1 }
28.
29. procedure TForm1.Button1Click(Sender: TObject);
30. var
31.   aList: TStringList;
32.   i: Integer;
33. begin
34.   aList := TStringList.Create;
35.   aList.Sorted := True;
36.   aList.Append('4516');
37.   aList.Append('4547');
38.   aList.Append('4534');
39.   aList.Append('4523');
40.   aList.Append('45');
41.   aList.Append('547');
42.   aList.Append('999');
43.   aList.Append('111');
44.   Memo1.Clear;
45.   for i := 0 to aList.Count - 1 do
46.     Memo1.Append(aList[i]);
47.   aList.Free;
48. end;
49.
50. end.

Below is the screenshot and the downloadable source code.
« Last Edit: October 22, 2020, 07:54:23 pm by Handoko »

#### bytebites

• Sr. Member
• Posts: 364
##### Re: TStringList Sorting
« Reply #1 on: October 21, 2020, 06:47:52 pm »

#### Fred vS

• Hero Member
• Posts: 2019
##### Re: TStringList Sorting
« Reply #2 on: October 21, 2020, 06:55:50 pm »
Hello.

Afaik, with a TStringList, it will be difficult to sort numbers in a "numbers" way.

I do this as work-around, adding '  ' (space) before the numbers.

Example (only the idea that will work if StrNum > 0):

Code: Pascal  [Select][+][-]
1.  MaxChar := 10;
2.
3.   for i := 0 to NumCharCount do
4.   begin
5.    ....
6.     z := Length(theStrNum[i]);
7.
8.     if z < MaxChar then
9.           for y := 0 to MaxChar - z do
10.             theStrNum[i] := ' ' + theStrNum[i];
11.
12.      aList.Append(theStrNum[i]);
13.    ...
14.     end;

This will work because  '       987' is <  '      1234';

Fre;D
« Last Edit: October 21, 2020, 07:40:48 pm by Fred vS »
I use Lazarus 2.0.6 32/64 and FPC 3.2.0 32/64 on Debian 10.2 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64 and Mac OS X Snow Leopard 32.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt, Carbon.

https://github.com/fredvs
https://gitlab.com/fredvs

#### howardpc

• Hero Member
• Posts: 3607
##### Re: TStringList Sorting
« Reply #3 on: October 21, 2020, 07:26:55 pm »
For reasonably small numbers of string-numbers, you can do this without sorting at all.
Code: Pascal  [Select][+][-]
1. unit Unit1;
2.
3. {\$mode objfpc}{\$H+}
4.
5. interface
6.
7. uses
8.   Classes, SysUtils, Forms, StdCtrls;
9.
10. type
11.   TForm1 = class(TForm)
12.     Memo1: TMemo;
13.     SortNumericalButton: TButton;
14.     procedure FormCreate(Sender: TObject);
15.     procedure SortNumericalButtonClick(Sender: TObject);
16.   private
17.     procedure PopulateMemo;
18.     procedure SortMemoNumerically(aMemo: TMemo);
19.   public
20.
21.   end;
22.
23. var
24.   Form1: TForm1;
25.
26. implementation
27.
28. {\$R *.lfm}
29.
30. { TForm1 }
31.
32. procedure TForm1.FormCreate(Sender: TObject);
33. begin
34.   PopulateMemo;
35. end;
36.
37. procedure TForm1.PopulateMemo;
38. begin
39.   Memo1.Clear;
40.   Memo1.Append('4516');
41.   Memo1.Append('4547');
42.   Memo1.Append('4534');
43.   Memo1.Append('4523');
44.   Memo1.Append('45');
45.   Memo1.Append('547');
46.   Memo1.Append('999');
47.   Memo1.Append('111');
48. end;
49.
50. procedure TForm1.SortMemoNumerically(aMemo: TMemo);
51. var
52.   mn, mx, si: SizeInt;
53.   arr: array of SizeInt;
54.   sl: TStringList;
55.   i, hi, tmp: Integer;
56.
57.   function InArray: Boolean;
58.   var
59.     j: Integer;
60.   begin
61.     for j := 0 to hi do
62.       case (arr[j] = si) of
63.         True: Exit(True);
64.         False: ;
65.       end;
66.     Result := False;
67.   end;
68.
69. begin
70.   SetLength(arr{%H-}, aMemo.Lines.Count);
71.   hi := High(arr);
72.   sl := TStringList.Create;
73.   mn := MaxInt;
74.   mx := -MaxInt;
75.   try
76.     for i := 0 to hi do
77.       case TryStrToInt(aMemo.Lines[i], tmp) of
78.         True: begin
79.                 arr[i] := tmp;
80.                 if mn > tmp then
81.                   mn := tmp
82.                 else
83.                 if mx < tmp then
84.                   mx := tmp;
85.               end;
86.         False: arr[i] := -MaxInt;
87.       end;
88.
89.     i := 0;
90.     for si := mn to mx do
91.       if InArray then
92.         begin
93.           sl.Add(si.ToString);
94.           Inc(i);
95.         end;
96.
97.     aMemo.Lines.Assign(sl);
98.   finally
99.     sl.Free;
100.   end;
101. end;
102.
103. procedure TForm1.SortNumericalButtonClick(Sender: TObject);
104. begin
105.   SortMemoNumerically(Memo1);
106. end;
107.
108. end.
« Last Edit: October 22, 2020, 08:24:50 pm by howardpc »

#### avk

• Sr. Member
• Posts: 331
##### Re: TStringList Sorting
« Reply #4 on: October 21, 2020, 07:52:01 pm »
The StrUtils unit already contains the NaturalCompareText function. So it is enough to create a comparator like this:
Code: Pascal  [Select][+][-]
1. function NaturalCompare(aList: TStringList; aIndex1, aIndex2: Integer): Integer;
2. begin
3.   Result := NaturalCompareText(aList[aIndex1], aList[aIndex2]);
4. end;
5.
and pass it to TStringList.CustomSort.

#### winni

• Hero Member
• Posts: 2113
##### Re: TStringList Sorting
« Reply #5 on: October 21, 2020, 08:10:37 pm »
Hi!

I was bothered that the StringGrid only sorts in a lexical and not in a numeric way.

The StringGrid has the event onCompareCells.

There you can interfere.

First you define:

Code: Pascal  [Select][+][-]
1. Type
2. TSortType = (SortInt,SortUint, SortFloat,SortString);
3.
4. var SortArray: array of TSortType;
5.

Then you fill the Sortarray according to your columns.

Finaly you write  the procedure for onCompareCells.

Code: Pascal  [Select][+][-]
1. procedure TForm1.StringGrid1CompareCells(Sender: TObject; ACol, ARow, BCol,
2.  BRow: Integer; var Result: integer);
3. var  SortTag: TSortType;
4.
5. begin
6. result := 0;
7. SortTag := SortArray[ACol];
8. with StringGrid1 do
9.    begin
10.      case SortTag of
11.        SortInt :result := StrToInt64Def(Cells[ACol,ARow],0)-StrToInt64Def(Cells[BCol,BRow],0);
12.        SortUint :result := StrToQWordDef(Cells[ACol,ARow],0)-StrToQwordDef(Cells[BCol,BRow],0);
13.        SortFloat :result := round(StrToFloatDef(Cells[ACol,ARow],0)-StrToFloatDef(Cells[BCol,BRow],0));
14.        SortString:result := UTF8CompareStr(Cells[ACol,ARow], Cells[BCol,BRow]);
15.      end; // case
16.   if SortOrder = soDescending then result := -result;
17. end;// with
18. end;
19.
20.

The result of StringGrid1CompareCells is given into a Quicksort.
And this is quick as hell.
Below 10.000 rows you wont notice a delay.

Winni
« Last Edit: October 21, 2020, 08:12:19 pm by winni »

#### Handoko

• Hero Member
• Posts: 4006
• My goal: build my own game engine using Lazarus
##### Re: TStringList Sorting
« Reply #6 on: October 22, 2020, 07:53:51 pm »
Thank you everyone.
I have a collected many suggestions, now examining which one I should use.