TStringList - CustomSort

[CortelliStefano]

Un caro saluto a tutto il forum, volevo sapere se qualcuno riscontra problemi nell'utilizzo del metodo CustomSort della TStringList.

Poiché il metodo Sort presenta un problema nell'ordinamento (in pratica l'underscore e gli altri caratteri diversi da lettere e numeri, anche se Unicode, vengono ordinati inseriti indicativamente tra la P e la S maiuscola), ho provato ad utilizzare il metodo CustomSort, creando una procedura ad hoc (in modo da poterla poi personalizzare) del tipo:

Codice: [Seleziona]

function TfrmStampeReg.StringListCompareStrings(List: TStringList; Index1,
  Index2: Integer): Integer;
begin
  Result := AnsiCompareStr (List[Index1], List[Index2]);
end;

oppure:

Codice: [Seleziona]

function TfrmStampeReg.StringListCompareStringsByOrdinalCharacterValue(
  List: TStringList; Index1, Index2: Integer): Integer;
var
  First: string;
  Second: string;
begin
  First := List[Index1];
  Second := List[Index2];
  if List.CaseSensitive then
    Result := CompareStr(First, Second)
  else
    Result := CompareText(First, Second);
end;

oppure anche questa, trovata proprio sul forum di Lazarus:

Codice: [Seleziona]

function TfrmStampeReg.UTF8Compare(List: TStringList; Index1, Index2: Integer
  ): Integer;
begin
  {http://www.lazarus.freepascal.org/index.php?topic=9443.0}
Result:=WideCompareStr(UTF8Decode(List[Index1]),UTF8Decode(List[Index2]));
end;

Le procedure non danno problemi, ma il metodo CustomSort da' sempre errore, sia con che senza @ davanti al nome della procedura, in particolare:

Codice: [Seleziona]

 MiaStringList.CustomSort (@NomeProcedura);

da'  il seguente errore:

Codice: [Seleziona]

Error: Incompatible type for arg no. 1: Got "<procedure variable type of function(TStringList,LongInt,LongInt):LongInt of object;Register>", expected "<procedure variable type of function(TStringList,LongInt,LongInt):LongInt;Register>"

mentre senza @:

Codice: [Seleziona]

MiaStringList.CustomSort (NomeProcedura);

ritorna l'errore:

Codice: [Seleziona]

Error: Wrong number of parameters specified for call to "NomeProcedura"

Alla fine, visto che il Sort mi crea problemi ed il CustomSort non riesco ad utilizzarlo ho "risolto" intervenendo sul mio codice in modo da bypassare il problema, ma... vorrei capire cosa c'è che non funziona.

Utilizzo Lazarus 0.9.28.2 stable su Debian Squeeze.

Un saluto a tutti,

Stefano

[xinyiman]

Ti va di allegare un codice di esempio, cosichhè noi compiliamo e proviamo la tua situazione in particolare?! 

[CortelliStefano]

La mia situazione particolare è in un modulo piuttosto complesso che genera dei files e li vuole ordinare per una successiva spedizione via e-mail.

Sulla base della mia situazione provo a scrivere un codice di esempio (basato sull'evento OnClick di un bottone di una form chiamat frmMyForm), ricordarsi di cambiare Chr(13) con Chr(10) per gli utenti Windows.

Codice: [Seleziona]

type
  function MySortProcedure(List: TStringList; Index1, Index2: Integer): Integer;

.........



procedure TfrmMyForm.Button1Click(Sender: TObject);
var
  MyStringList: TStringList;
  k: SmallInt;
  S: String;
begin
  S := '';
  Invio := Chr (13); //Carattere di fine riga per Linux (10 per Windows)

  MyStringList := TStringList.Create;
  MyStringList.CaseSensitive := True;
  MyStringList.Add ('/home/miopath/20_Partitari.pdf');
  MyStringList.Add ('/home/miopath/20_BeniAmmortizzabili.pdf');
  MyStringList.Add ('/home/miopath/20_CertCompensi.pdf');
  MyStringList.Add ('/home/miopath/20_IvaAcquisti.pdf');
  MyStringList.Add ('/home/miopath/20_IvaVendite.pdf');
  MyStringList.Add ('/home/miopath/20_LiquidazioneIva.pdf');
  MyStringList.Add ('/home/miopath/20S_BeniAmmortizzabili.pdf');
  MyStringList.Add ('/home/miopath/20_Sit_econfisc.pdf');

  MyStringList.Sort;
  for k := 0 to (MyStringList.Count - 1) do S := S + MyStringList[k] + Invio;
  showmessage ('Metodo Sort: ' + Invio + S);

  MyStringList.CustomSort (MySortProcedure); //Qui da' errore
  S := '';
  for k := 0 to (MyStringList.Count - 1) do S := S + MyStringList[k] + Invio;
  showmessage ('Metodo CustomSort: ' + Invio + S);
end;

function TfrmMyForm.MySortProcedure(
  List: TStringList; Index1, Index2: Integer): Integer;
var
  First: string;
  Second: string;
begin
  First := List[Index1];
  Second := List[Index2];
  if List.CaseSensitive then
    Result := CompareStr(First, Second)
  else
    Result := CompareText(First, Second);
end;

Il codice dovrebbe comunque dare errore sul metodo CustomSort, almeno questo è quanto avviene con Lazarus 0.9.28.2 su Debian.

Aspetto le vostre considerazioni...

Ciao,

Stefano

[xinyiman]

Ok ho fatto una prova e mi da l'errore qui

  MyStringList.CustomSort (MySortProcedure); //Qui da' errore   

Perchè tu passi come parametro una funzione senza i parametri. Mentre la dichiarazione delle funzione MySortProcedure è la seguente

function MySortProcedure(List: TStringList; Index1, Index2: Integer): Integer;

Quindi dovresti farla diventare

MyStringList.CustomSort (MySortProcedure(MyStringList, index1,indexs));

Fammi sapere se così risolvi

[CortelliStefano]

Grazie, ma purtroppo non ho risolto (Wrong number of parameters).

Da quello che ho capito al metodo CustomSort andrebbe passata solamente la funzione, che poi lui utilizzerà per l'ordinamento, inviando alla stessa la StringList con i due parametri aggiuntivi.

Per questo dovrebbe essere utilizzato anche il carattere @ davanti al nome della funzione, e leggendo su Internet sembra che questa sia una differenza tra FPC e Delphi (il quale sembrerebbe accettare che venga passata la funzione senza @).

Anche gli esempi che ho trovato per Delphi, volti spesso ad ordinare correttamente numeri e date, non indicano altri parametri da inserire, p.es.:
http://www.swissdelphicenter.ch/en/showcode.php?id=1664
http://www.delphipraxis.net/78375-tstringlist-umgekehrt-sortieren-%3D-customsort.html
http://stackoverflow.com/questions/2175066/how-can-i-get-tstringlist-to-sort-differently-in-delphi

Qui, riguardo a FPC, si vede che occorre utilizzare @ davanti alla funzione:
http://community.freepascal.org:10000/bboards/message?message_id=269151&forum_id=24092

Grazie e ciao,

Stefano

[xinyiman]

Stefano, penso di aver capito il problema. Prova a compilare questo esempio:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    function MySortProcedure(List: TStringList; Index1: integer; Index2: Integer): TStringListSortCompare;
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  MyStringList: TStringList;
  k: SmallInt;
  S: String;
  Invio: char;
  Index1, Index2: Integer;
begin
  S := '';
  Invio := Chr(10); //Carattere di fine riga per Linux (10 per Windows)

  MyStringList := TStringList.Create;
  MyStringList.CaseSensitive := True;
  MyStringList.Add ('/home/miopath/20_Partitari.pdf');
  MyStringList.Add ('/home/miopath/20_BeniAmmortizzabili.pdf');
  MyStringList.Add ('/home/miopath/20_CertCompensi.pdf');
  MyStringList.Add ('/home/miopath/20_IvaAcquisti.pdf');
  MyStringList.Add ('/home/miopath/20_IvaVendite.pdf');
  MyStringList.Add ('/home/miopath/20_LiquidazioneIva.pdf');
  MyStringList.Add ('/home/miopath/20S_BeniAmmortizzabili.pdf');
  MyStringList.Add ('/home/miopath/20_Sit_econfisc.pdf');

  MyStringList.Sort;
  for k := 0 to (MyStringList.Count - 1) do S := S + MyStringList[k] + Invio;
  showmessage ('Metodo Sort: ' + Invio + S);

  MyStringList.CustomSort(MySortProcedure(MyStringList,index1,index2)); //Qui da' errore
  S := '';
  for k := 0 to (MyStringList.Count - 1) do S := S + MyStringList[k] + Invio;
  showmessage ('Metodo CustomSort: ' + Invio + S);
end;

function TForm1.MySortProcedure(List: TStringList; Index1: integer; Index2: Integer): TStringListSortCompare;
var
  First: string;
  Second: string;
begin
  First := List[Index1];
  Second := List[Index2];
  if List.CaseSensitive then
    {Result :=} CompareStr(First, Second)
  else
    {Result :=} CompareText(First, Second);
end;

end.


Lo compila, poi da errore per altri motivi, ma il problema che tu avevi era dato dal fatto che la costumsort si aspetta un parametro di tipo TStringListSortCompare mentre tu glielo passavi di tutt'altro tipo. Ora il problema di compilazione è risolto. Prova a modificare la funzione di ordinamento in maniera tale che non ritorna un valore integer. Magari risolvi. Fammi sapere

[Goblin]

mmm secondo me vi state perdendo in un bicchiere d'acqua..

function MySortProcedure(List: TStringList; Index1, Index2: Integer): Integer;
var
  First: string;
  Second: string;
begin
  First := List[Index1];
  Second := List[Index2];
  if List.CaseSensitive then
    Result := CompareStr(First, Second)
  else
    Result := CompareText(First, Second);
end;

procedure TForm1.Button1Click(Sender: TObject);
  var
    MyStringList: TStringList;
    k: SmallInt;
    S: String;
    invio: char;
begin
    S := '';
    Invio := Chr (10); //Carattere di fine riga per Linux (10 per Windows)

    MyStringList := TStringList.Create;
    MyStringList.CaseSensitive := True;
    MyStringList.Add ('/home/miopath/20_Partitari.pdf');
    MyStringList.Add ('/home/miopath/20_BeniAmmortizzabili.pdf');
    MyStringList.Add ('/home/miopath/20_CertCompensi.pdf');
    MyStringList.Add ('/home/miopath/20_IvaAcquisti.pdf');
    MyStringList.Add ('/home/miopath/20_IvaVendite.pdf');
    MyStringList.Add ('/home/miopath/20_LiquidazioneIva.pdf');
    MyStringList.Add ('/home/miopath/20S_BeniAmmortizzabili.pdf');
    MyStringList.Add ('/home/miopath/20_Sit_econfisc.pdf');

    MyStringList.Sort;
    for k := 0 to (MyStringList.Count - 1) do S := S + MyStringList[k] + Invio;
    showmessage ('Metodo Sort: ' + Invio + S);

    MyStringList.CustomSort (@MySortProcedure); //Qui ci vuole la chiocciolina !!

    S := '';
    for k := 0 to (MyStringList.Count - 1) do S := S + MyStringList[k] + Invio;
    showmessage ('Metodo CustomSort: ' + Invio + S);
end;


a me funziona benissimo provare per credere

G.

[xinyiman]

Ha ragione goblin, se uso la chiocciola e dichiaro la funzione fuori dalla mia Form, funziona anche a me. Non deve far parte della classe della TForm.

Codice: [Seleziona]

unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

{ TForm1 }

function MySortProcedure(List: TStringList; Index1, Index2: Integer): Integer;
var
  First: string;
  Second: string;
begin
  First := List[Index1];
  Second := List[Index2];
  if List.CaseSensitive then
    Result := CompareStr(First, Second)
  else
    Result := CompareText(First, Second);
end;

procedure TForm1.Button1Click(Sender: TObject);
  var
    MyStringList: TStringList;
    k: SmallInt;
    S: String;
    invio: char;
begin
    S := '';
    Invio := Chr (10); //Carattere di fine riga per Linux (10 per Windows)

    MyStringList := TStringList.Create;
    MyStringList.CaseSensitive := True;
    MyStringList.Add ('/home/miopath/20_Partitari.pdf');
    MyStringList.Add ('/home/miopath/20_BeniAmmortizzabili.pdf');
    MyStringList.Add ('/home/miopath/20_CertCompensi.pdf');
    MyStringList.Add ('/home/miopath/20_IvaAcquisti.pdf');
    MyStringList.Add ('/home/miopath/20_IvaVendite.pdf');
    MyStringList.Add ('/home/miopath/20_LiquidazioneIva.pdf');
    MyStringList.Add ('/home/miopath/20S_BeniAmmortizzabili.pdf');
    MyStringList.Add ('/home/miopath/20_Sit_econfisc.pdf');

    MyStringList.Sort;
    for k := 0 to (MyStringList.Count - 1) do S := S + MyStringList[k] + Invio;
    showmessage ('Metodo Sort: ' + Invio + S);

    MyStringList.CustomSort (@MySortProcedure); //Qui ci vuole la chiocciolina !!

    S := '';
    for k := 0 to (MyStringList.Count - 1) do S := S + MyStringList[k] + Invio;
    showmessage ('Metodo CustomSort: ' + Invio + S);
end;

end.

[CortelliStefano]

Grazie a tutti per le risposte, purtroppo non ho risolto.

Circa la @ lo sapevo, ed infatti l'avevo indicato nel mio post (sembra infatti essere una differenza tra Delphi e FPC, posto che Delphi sembra accettare la funzione senza la @), purtroppo ottengo errore in entrambi i casi, sia con @ che senza.

infatti, anteponendo la chiocciola, ottengo comunqe errore in sede di compilazione:

MyStringList.CustomSort (@MySortProcedure);

mi da' questo errore:

Error: Incompatible type for arg no. 1: Got "<procedure variable type of function(TStringList,LongInt,LongInt):LongInt of object;Register>", expected "<procedure variable type of function(TStringList,LongInt,LongInt):LongInt;Register>"

Se invece cambio l'istruzione CustomSort con:

MyStringList.CustomSort(MySortProcedure(MyStringList,index1,index2));

ottengo comunque errore:

Error: Identifier not found "index1"

Guardando la documentazione di Lazarus sul parametro TStringListSortCompare, si tratta di una funzione a cui vanno passati una TStringList e due parametri Integer, la quale ritorna un integer:
http://lazarus-ccr.sourceforge.net/docs/rtl/classes/tstringlistsortcompare.html

Quindi a questo punto la funzione originaria, che ritorna un Integer, dovrebbe andare bene.

Mi sembra allora di capire, se a voi il codice funziona, che si potrebbe trattare di qualcosa che riguarda la mia versione di Lazarus o il sistema operativo.

Io uso Lazarus 0.9.28.2 su Debian (32 bit).

Voi che versioni avete?

Ancora grazie, ciao,

Stefano

[xinyiman]

Stefano solo una cosa. Nel tuo codice la funzione MySortProcedure è dichiarata così?

function MySortProcedure(List: TStringList; Index1, Index2: Integer): Integer;
var
  First: string;
  Second: string;
begin
  First := List[Index1];
  Second := List[Index2];
  if List.CaseSensitive then
    Result := CompareStr(First, Second)
  else
    Result := CompareText(First, Second);
end;


oppure così

function NOMECLASSE.MySortProcedure(List: TStringList; Index1, Index2: Integer): Integer;
var
  First: string;
  Second: string;
begin
  First := List[Index1];
  Second := List[Index2];
  if List.CaseSensitive then
    Result := CompareStr(First, Second)
  else
    Result := CompareText(First, Second);
end;

Perchè il secondo caso è errato, non deve far parte della classe per funzionare!

[CortelliStefano]

Grazie mille!!!

Era infatti quello il problema, l'avevo dichiarata temporaneamente nel private del Form, con l'intenzione poi di spostarlo nel modulo generale se funzionava...

Dopo provo poi come funziona l'ordinamento usando il CustomSort... -:)

Ancora grazie e W questa nuova comunità!!!

Sterfano

[xinyiman]

Figurati, grazie a Goblin che mi ha  fatto notare l'arcano