Ce petit programme teste des procédures pour trier du grec dans une appli en code local français.
Principe :
Lors du tri français, tous les a accentués ou non sont regroupés, soit les caractères 65 92 192 ... 197 ... or la zone des caractères accentués est la zone utilisée pour afficher des caractères non latins;
Donc par exemple alpha et gamma sont triés indistinctement mais pas alpha accentué.
La manip consiste donc à modifier les chaînes juste dans la fonction comparative.
0n peut l'adapter au russe , etc
Source / Exemple :
unit triGreek;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
BtnTri: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
RadioGroup1: TRadioGroup;
RadioGroup2: TRadioGroup;
Label1: TLabel;
Label2: TLabel;
procedure BtnTriClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure RadioGroup2Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
maj,typ:integer;
a:string;
implementation
{$R *.dfm}
// constante de psudo3 comme modele
const SansAccents : array[Char] of Char
= #0#1#2#3#4#5#6#7#8#9#10#11#12#13#14#15 +
#16#17#18#19#20#21#22#23#24#25#26#27#28#29#30#31 +
' !"#$%&''()*+,-./0123456789:;<=>?' +
'@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'+
'`abcdefghijklmnopqrstuvwxyz
''#129'‚ƒ„…†‡ˆ‰S‹'#141''#143#144'‘’“”•–—˜™s›'#157'zY' +
#160'¡¢£¤¥¦§¨©ª«¬*®¯°±²³´µ¶·¸¹º»¼½¾¿' +
'AAAAAAÆCEEEEIIIIDNOOOOO×ØUUUUYÞß' +
'aaaaaaæceeeeiiiidnooooo÷øuuuuyþy';
// tri greek_charset
const gcs : array[Char] of Char
= #0#1#2#3#4#5#6#7#8#9#10#11#12#13#14#15 +
#16#17#18#19#20#21#22#23#24#25#26#27#28#29#30#31 +
' !"#$%&''()*+,-./0123456789:;<=>?' +
'@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'+
'`abcdefghijklmnopqrstuvwxyz{
~'#127 +
''#129'‚ƒ„…†‡ˆ‰S‹'#141''#143#144'‘’“”•–—˜™s›'#157'zY' +
#160'¡¢£¤¥¦§¨©ª«¬*®¯°±²³´µ¶·A<EHIOYW<ABCDEZHQIKLMNXOPR<STYFVUW'+
'<<aehi<abcdezhqiklmnxoprsstyfvuw<<oyw<';
//tri police greek
const pg : array[Char] of Char
= #0#1#2#3#4#5#6#7#8#9#10#11#12#13#14#15 +
#16#17#18#19#20#21#22#23#24#25#26#27#28#29#30#31 +
' !"#$%&''()*+,-./0123456789:;<=>?' +
'@ABCDEFGHIwKLMNOPQRSTUVWXYZ<<<<<<abcdefghisklmnopqrstuvwxyz'+
'<<<<<<<<iiiiiiiiiiizii<<<<<<<eeeeeeee<aaaaaaaaaaaaaaaaaaaaaa'+
'<rhhhhhhhhhhh<hhhhhhhhhhhoooooooouuuuuuuuuuuuuuowwwwwwwwwwwwwwwwwwwwweo<<';
function modifstring(const AText : String;t:integer) : string;
var
i:integer;
p:pchar;
begin
Result:=AText;
if Result='' then EXIT; //<<<
p:=@Result[1];
if t>1 then for i:=1 to Length(Result) do
begin
case t of
2: p^:=gcs[p^];
3: p^:=pg[p^];
end;
inc(p);
end;
end;
function TriListe(LaListe: TStringList; Index1, Index2: Integer): Integer;
var
s1, s2: string;
begin
// Chaines à comparer
s1 := modifstring(LaListe[Index1],typ);
s2 := modifstring(laListe[Index2],typ);
// Valeur de retour pour classement
a:=a+' / '+s1+'-'+s2; // juste pour test
case typ of
1..3: if maj=0 then result:=AnsiCompareText(s1,s2) else result:=AnsiCompareStr(s1,s2) ;
0:begin
if s1 > s2 then
Result := 1
else if s1 < s2 then
Result := -1
else
Result := 0;
end;
end;
end;
procedure TForm1.BtnTriClick(Sender: TObject);
var
lstListe : TStringList;
begin
// Liste exemple
lstListe := TStringList.Create;
with listbox1 do
begin
lstListe.Assign(Items);
lstListe.CustomSort(TriListe);
Clear;
Items.Assign(lstListe);
end;
with listbox2 do
begin
lstListe.Assign(Items);
lstListe.CustomSort(TriListe);
Clear;
Items.Assign(lstListe);
end;
with listbox3 do
begin
lstListe.Assign(Items);
lstListe.CustomSort(TriListe);
Clear;
Items.Assign(lstListe);
end;
// Libère les ressources
lstListe.Clear;
lstListe.Free;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
maj:=0;
typ:=1;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
maj:=RadioGroup1.ItemIndex;
BtnTriClick(sender);
end;
procedure TForm1.RadioGroup2Click(Sender: TObject);
begin
typ:=RadioGroup2.ItemIndex;
BtnTriClick(sender);
end;
end.
Conclusion :
Limites :
Ordre alphabétique grec parfois malmené ; phi avant gamma ou zeta après omega ...
codage multi-octet non traité.
Test à optimiser un peu, beaucoup ...
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.