Witam, tak jak obiecalem podaje kodzik na sortowanie slow z polskimi znakami w kolejnosci malejacej. Slowa sa zamieszczone w tablicy "Wyrazy", ale zmodyfikowanie procedurki, aby sortowala wyrazy chociazby z jakiegos komponentu nie powinno sprawic problemu. Oka a teraz pora na kodzik:
var
Form1: TForm1;
TabAlfabet : array [0 .. 30] of char;
Wyrazy : array [1..10] of string[20];
implementation
{$R *.dfm}
procedure WypelnijTabAlfabetem;
begin
TabAlfabet[0] := ' ';
TabAlfabet[1] := 'a';
TabAlfabet[2] := 'ą';
TabAlfabet[3] := 'b';
TabAlfabet[4] := 'c';
TabAlfabet[5] := 'ć';
TabAlfabet[6] := 'd';
TabAlfabet[7] := 'e';
TabAlfabet[8] := 'ę';
TabAlfabet[9] := 'f';
TabAlfabet[10] := 'g';
TabAlfabet[11] := 'h';
TabAlfabet[12] := 'i';
TabAlfabet[13] := 'j';
TabAlfabet[14] := 'k';
TabAlfabet[15] := 'l';
TabAlfabet[16] := 'ł';
TabAlfabet[17] := 'm';
TabAlfabet[18] := 'n';
TabAlfabet[19] := 'ń';
TabAlfabet[20] := 'o';
TabAlfabet[21] := 'ó';
TabAlfabet[22] := 'p';
TabAlfabet[23] := 'r';
TabAlfabet[24] := 'ś';
TabAlfabet[25] := 't';
TabAlfabet[26] := 'u';
TabAlfabet[27] := 'w';
TabAlfabet[28] := 'y';
TabAlfabet[29] := 'ź';
TabAlfabet[30] := 'ż';
end;
procedure WypelnijWyrazy;
begin
Wyrazy[1] := 'bc';
Wyrazy[2] := 'ac';
Wyrazy[3] := 'agb';
Wyrazy[4] := 'cd';
Wyrazy[5] := 'def';
Wyrazy[6] := 'dfg';
Wyrazy[7] := 'zzzz';
Wyrazy[8] := 'aaaa';
Wyrazy[9] := 'wwww';
Wyrazy[10] := 'mmm';
end;
function WiekszyWyraz1 (slowko1, slowko2 : string): boolean;
var
a, b, i, wynik : integer;
koniec : boolean;
begin
LowerCase(slowko1); //zamien na male litery slowko 1 i 2
LowerCase(slowko2);
if slowko1 = slowko2 then // jezeli slowka sa rowne
koniec := false
else
begin // jesli slowka nie sa rowne to je zbadaj
if length(slowko1) > length(slowko2) then
slowko2 := slowko2 + ' ' // dokleja spacje do krotszego slowka
else // jesli beda rowne w znakach to blizej w alfabecie bedzie slowko krotsze...
slowko1 := slowko1 + ' ';
wynik := 0;
i := 1;
repeat
a := 0;
b := 0;
while slowko1[i] <> TabAlfabet[a] do
Inc(a);
while slowko2[i] <> TabAlfabet[b] do
Inc(b);
if a > b then wynik := 1 // slowko1 jest dalej w alf. niz slowko 2
else if a < b then wynik := 2 // slowko 1 jest blizej w alf. niz slowko2
else Inc(i);
until wynik <> 0;
if wynik = 1 then koniec := true
else if wynik = 2 then koniec := false
end;
WiekszyWyraz1 := koniec;
end;
procedure BubbleSortPLText (N : integer);
var
i, j : integer;
x : string;
begin
for i := N - 1 downto 1 do
for j := 1 to i do
if WiekszyWyraz1(Wyrazy[j], Wyrazy[j + 1]) = false then
begin
x := Wyrazy[j];
Wyrazy[j] := Wyrazy[j+1];
Wyrazy[j+1] := x;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i : integer;
begin
WypelnijTabAlfabetem;
WypelnijWyrazy;
BubbleSortPLText (10);
for i := 1 to 10 do
memo.Items.add ( Wyrazy[i]);
end;
Metoda sortowania chwilowo jest babelkowa, gdyz z metoda QuickSort mam maly problem, mysle ze rozwiaze go jeszcze dzisiaj, ponizej zamieszcze jej kodzik jakby ktos widzial gdzies jakis blad to niech pisze smialo (procedurka niby sortuje, ale tak jakos kosmicznie ):
procedure QuickSortPLText (Lewy, Prawy : integer);
var
i, j : integer;
podzial, x : string[20];
begin
i := Lewy;
j := Prawy;
podzial := Wyrazy[(Lewy + Prawy ) div 2];
repeat
while WiekszyWyraz1(Wyrazy[i], podzial) = false do
Inc(i);
while WiekszyWyraz1(podzial, Wyrazy[j]) = true do
Dec(j);
if i <= j then
begin
x := Wyrazy [i];
Wyrazy[i] := Wyrazy[j];
Wyrazy[j] := x;
Inc(i);
Dec(j);
end;
until (i > j);
{ i rekurencyjnie wywolaj procedurke sortowania dla obu przedzialow}
if Lewy < j then QuickSortPLText (Lewy, j);
if i < Prawy then QuickSortPLText (i, Prawy);
end;