Trier du grec dans une appli en code local français.

Télécharger le projet
Commenter

Description

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'&#8218;&#402;&#8222;&#8230;&#8224;&#8225;&#710;&#8240;S&#8249;Œ'#141'Ž'#143#144'&#8216;&#8217;&#8220;&#8221;&#8226;&#8211;&#8212;&#732;&#8482;s&#8250;œ'#157'zY' +
                #160'¡¢£&#164;¥&#166;§&#168;©ª«¬*®¯°±²³&#180;µ¶·&#184;¹º»&#188;&#189;&#190;¿' +
                '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'&#8218;&#402;&#8222;&#8230;&#8224;&#8225;&#710;&#8240;S&#8249;Œ'#141'Ž'#143#144'&#8216;&#8217;&#8220;&#8221;&#8226;&#8211;&#8212;&#732;&#8482;s&#8250;œ'#157'zY' +
                #160'¡¢£&#164;¥&#166;§&#168;©ª«¬*®¯°±²³&#180;µ¶·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 ...
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.