Results 1 to 11 of 11

Thread: TStringList natural sort

  1. #1

    TStringList natural sort

    Hallo,

    Ik wil een TStringList natuurlijk sorteren. Dus met de waardes 1, 10, 12, 22, 2 een lijst die opvolgt als: 1, 2, 10, 12, 22 en niet als 1, 10, 12, 2, 22.

    Nu heb ik al gevonden:
    Code:
    type TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
    procedure CustomSort(Compare: TStringListSortCompare); virtual;
    Enige probleem is dat dit uit een Delphi 6 manual komt en ik met 7 werk. Ik krijg hiermee dus ook een error.

    Kan ik deze werkende krijgen of heeft iemand een suggestie?

    Alvast bedankt...

  2. #2
    John Kuiper
    Join Date
    Apr 2007
    Location
    Almere
    Posts
    8,622
    Uit mijn hoofd weet ik dat TStringlist gebruik maakt van strings en geen nummering. Daardoor sorteert deze ook op alphanumeric niveau.
    Delphi is great. Lazarus is more powerfull

  3. #3
    Je zou eventueel voorloopnullen kunnen toevoegen.
    De gegevens sorteren en vervolgens de voorloopnullen er weer vanaf halen.
    Niet helemaal jofel, maar het werkt dan wel.
    Zorg dan wel voor een breedte van elke tekst die gelijk is.
    Dus bijvoorbeeld 01, 10, 12, 22, 02
    Of, als je naar de 100 gaat, 001, 010, 012, 022, 002, etc...

  4. #4
    Silly member NGLN's Avatar
    Join Date
    Aug 2004
    Location
    Werkendam
    Posts
    5,076
    Indien er alleen nummers in die lijst staan:

    delphi Code:
    1. function NumericCompare(List: TStringList; Index1, Index2: Integer): Integer;
    2. begin
    3.   Result := StrToInt(List[Index1]) - StrToInt(List[Index2]);
    4. end;
    (Sender as TNLDUser).Signature := 'Groeten van Albert';

  5. #5
    En als er ook tekst bij staat, dan kun je CustomSort gebruiken met GTSmartCompare gebruiken. De inspringing laat wat te wensen over, maar dat is te wijten aan een highlighter die niet zo forward compatible is. Excuses daarvoor.
    1+1=b

  6. #6
    Counting your refs
    Join Date
    Feb 2002
    Location
    Lage Zwaluwe
    Posts
    2,098
    Zelf een stringlist-afgeleide schrijven met een quicksort. De uitvoering van de quicksort hardcoden of eventueel weer via een mee te geven functie regelen, en daarin de natuurlijke compare uitvoeren.

    Ik snap trouwens niet waar je quicksort gebleven is onder Delphi 7. Voor de zekerheid, source is te vinden op de Delphi wiki.

  7. #7
    Quote Originally Posted by SpaceCow
    Code:
    type TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
    procedure CustomSort(Compare: TStringListSortCompare); virtual;
    Is dit gebruikelijk eigenlijk? Een type declaratie en het type is niets anders dan een functie.

  8. #8
    Senior Member Lodewijk's Avatar
    Join Date
    Apr 2004
    Location
    Netherlands
    Posts
    1,934
    Quote Originally Posted by GolezTrol View Post
    En als er ook tekst bij staat, dan kun je CustomSort gebruiken met GTSmartCompare gebruiken. De inspringing laat wat te wensen over, maar dat is te wijten aan een highlighter die niet zo forward compatible is. Excuses daarvoor.
    Delphi Code:
    1. function GTSmartCompare(List: TStringList; Index1, Index2: Integer): Integer;
    2.  
    3.   procedure ExtractPart(var s: string; out Result: string; out Numbers: Boolean);
    4.   var
    5.     n: integer;
    6.   begin
    7.     Numbers := False;
    8.     n := 1;
    9.     while (s[n] in ['0'..'9']) and (n <= Length(s)) do
    10.       Inc(n);
    11.  
    12.     { if n > 1 dan stonden er cijfers aan't begin }
    13.     if n > 1 then
    14.     begin
    15.       Result := Copy(s, 1, n - 1);
    16.       Delete(s, 1, n - 1);
    17.       Numbers := True;
    18.     end //if
    19.  
    20.     else
    21.     begin
    22.       { Geen cijfers }
    23.       n := 1;
    24.       while (not (s[n] in ['0'..'9']) ) and (n <= Length(s)) do
    25.         Inc(n);
    26.  
    27.       if n > 1 then
    28.       begin
    29.         Result := Copy(s, 1, n - 1);
    30.         Delete(s, 1, n - 1);
    31.       end
    32.     end; //else
    33.   end; //ExtractPart()
    34.  
    35.  
    36.   function CompareNextPart(var s1, s2: string): Integer;
    37.   var
    38.     n1, n2: Boolean;
    39.     p1, p2: string;
    40.   begin
    41.     { Knipt elke keer het volgende stukje om te vergelijken }
    42.     ExtractPart(s1, p1, n1);
    43.     ExtractPart(s2, p2, n2);
    44.  
    45.     { Allebei getallen? Dan numeriek vergelijken, anders alfabetisch }
    46.     if n1 and n2 then
    47.       Result := StrToInt(p1) - StrToInt(p2)
    48.     else
    49.       Result := StrIComp(PChar(p1), PChar(p2));
    50.   end; //CompareNextPart()
    51.  
    52. var
    53.   str1, str2, ext1, ext2: string;
    54.  
    55. begin
    56.   Result := 0;
    57.   { Voor 'normaal' vergelijken
    58.     str2 := List[Index1];
    59.     str2 := List[Index2];
    60.     Voor vergelijken van bestandsnamen }
    61.  
    62.   ext1 := ExtractFileExt(List[Index1]);
    63.   ext2 := ExtractFileExt(List[Index2]);
    64.   str1 := ChangeFileExt(List[Index1], '');
    65.   str2 := ChangeFileExt(List[Index2], '');
    66.  
    67.   //msg := str1 + '; ' + str2;
    68.  
    69.   while (str1 <> '') and (str2 <> '') and (Result = 0) do
    70.     Result := CompareNextPart(str1, str2);
    71.  
    72.   { De vergelijking heeft geen verschillen gevonden op numeriek vlak,
    73.     dus checken we nog een keer op de 'normale' manier. }
    74.  
    75.   if Result = 0 then
    76.     Result := StrIComp(PChar(List[Index1]), PChar(List[Index2]));
    77.  
    78.   { Nog steeds geen verschillen? Dan hakken de extenties de knoop door }
    79.  
    80.   if Result = 0 then
    81.     Result := StrIComp(PChar(ext1), PChar(ext2));
    82.  
    83. end; //GTSMartCompare

    Zo dus? In jouw code zag ik een aantal ends teveel en ook een aantal keer "endelse", ken ik dat nog niet of was de code niet op fouten gecontroleerd?
    Last edited by GolezTrol; 20-Jan-09 at 00:59.

  9. #9
    Die code was wel degelijk op fouten gecontroleerd én op funcitonaliteit getest, maar de destijds gebruikte highlighter werkt niet goed met de huidige forum-software, waardoor sommige spaties zijn weggevallen. Er had dus 'end else' moeten staan en niet 'endelse'.

    Al met al niets dat niet meer uit elkaar te pluizen is, zoals je zojuist hebt bewezen.
    1+1=b

  10. #10
    Delphi & OO in Vlaanderen SamWitse's Avatar
    Join Date
    Sep 2007
    Location
    Brussel
    Posts
    804
    @Evert:
    Is dit gebruikelijk eigenlijk? Een type declaratie en het type is niets anders dan een functie.
    Ja.
    Het is natuurlijk de vraag wat je 'gebruikelijk' noemt.
    Maar je kunt functions en procedures gewoon als variabelen declareren, en als parameter gebruiken.
    Eens je het door hebt hoe dit werkt, is dit een heel nuttige mogelijkheid in Delphi.
    Een functie om twee elementen uit een TList te vergelijken is een mooi voorbeeld van een functie als parameter.
    Should array indices start at 0 or 1? My compromise of 0.5 was rejected without, I thought, proper consideration.

    Sam Witse.
    Delphi & OO in Vlaanderen

  11. #11
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,088
    Quote Originally Posted by evert View Post
    Is dit gebruikelijk eigenlijk? Een type declaratie en het type is niets anders dan een functie.
    In aanvulling op Sam: ja, dat is de manier waarop met procedure variabelen wordt omgegaan.

    Let op dat er vele varianten mogelijk zijn, o.a. met andere calling conventies, methods ipv pure procedures/functies e.d.

    B.v. Windows functies zijn meestal stdcall; dus als je een functie aan een windows functie moet meegeven, moet je je functie ook stdcall declareren.

    delphi Code:
    1. Type
    2.   TMyFunc = function (param1,param2:pchar):integer; STDCALL;
    3.  
    4. procedure myfunc1(param1,param2:pchar):integer;
    5.  
    6. begin
    7.  
    8. end;
    9. procedure myfunc2(param1,param2:pchar):integer; stdcall;
    10.  
    11. begin
    12.  
    13. end;
    14.  
    15. var m: TMyFunc;
    16. begin
    17.   m:=myfunc1; // compileert niet, myfunc1 is niet stdcall.
    18.   m:=myfunc2; // werkt wel
    19. end;

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •