Jak mogę posortować zmienną typu string, np. var odp : string;
odp:='DCBA'; ???
To pytanie to bełkot, skup się i napisz po polsku o co Ci chodzi.
Mam do napisania pogram ... TESTY ..Prawo jazdy.. Jeżeli użytkownik poda odpowiedz np. ACB to program nie zaliczy mi punktu bo odpowiedź nie jest ułożona alfabetycznie...
program TESTY;
uses crt;
type
TTablica1= array[1..10] of string;
var
pliktxt,plik: text;
st,s,nazwa,naz,odp: string;
i,j: integer;
zamiana: boolean;
t: TTablica1;
k: word;
zn: char;
{---------------------------------------------------------------}
Procedure zerowanie;
var j : word;
begin
for j:=1 to 4 do
t[j]:='';
end;
{---------------------------------------------------------------------}
Procedure odpowiedz(var odp : string);
var zn:char;
begin
odp:='';
Repeat
zn:=readkey;
case zn of
#49 : begin write('A'); odp:=odp+'A'; end;
#50 : begin write('B'); odp:=odp+'B'; end;
#51 : begin write('C'); odp:=odp+'C'; end;
#52 : begin write('D'); odp:=odp+'D'; end;
#13 : exit;
else
odpowiedz(odp);
end;
Until zn=#13;
end;
{-------------------------------------------------------------}
Procedure sort(var odp : string);
var i,n : integer;
temp : string;
begin
for i:=1 to length(odp)-1 do
begin
zamiana:=false;
for j:=1 to length(odp)-i do
if odp[j] > odp[j+1] then
begin
zamiana:=true;
temp:=odp[j+1];
odp[j+1]:=odp[j];
odp[j]:=temp;
end;
if not zamiana then break;
end;
end;
{---------------------------------------------------------------}
Procedure ocena(punkt : word);
begin
if (k=10) and (punkt >= 8) then
writeln(' ZDALES !!!!! ');
if (k=10) and (punkt < 8) then
writeln(' NIE ZDALES!!!!!');
end;
{-----------------------------------------}
Procedure punkty(k : word; odp : string; var punkt : word);
var t : TTablica1;
l : integer;
begin
l:=1;
if nazwa='test1.txt' then
naz:='odp1.txt'
else
if nazwa='test2.txt' then
naz:='odp2.txt'
else
naz:='odp3.txt';
assign(plik,naz);
reset(plik);
while not eof(plik) do
begin
readln(plik,s);
if (l=k) and (odp = s) then
begin
sound(2000);
delay(30);
nosound;
punkt:=punkt+1;
end
else
begin
{------------------}
end;
l:=l+1;
end;
close(plik);
end;
{---------------------------------------------------------------}
Procedure wczytaj(var k : word);
var punkt : word;
begin
i:=0;
k:=0;
punkt:=0;
textcolor(white);
write('Podaj nazw© testu do odczytu: ');
readln(nazwa);
nazwa:=nazwa+'.txt';
assign(pliktxt,nazwa);
{$I-}reset(pliktxt);{$I+} {otwarcie do odczytu}
if ioresult = 0 then
begin
textcolor(red);
writeln('Podae poprawnĄ nazw© pliku !');
writeln;
textcolor(white);
while not eof(pliktxt) do
begin
readln(pliktxt,st);
writeln(st);
inc(i);
if i mod 10 = 0 then
begin
write('Odpowiedz: ');
zerowanie;
odpowiedz(odp);
k:=k+1;
sort(odp);
punkty(k,odp,punkt);
ocena(punkt);
writeln;
writeln;
end;
end;
close(pliktxt);
end
else
begin
textcolor(red);
writeln('Podae zĄ nazw© pliku !');
end;
end;
{-----------------------------------------------------------------------}
Procedure menu;
begin
textcolor(green);
gotoxy(25,1);
write('TESTY DO WYBORU: TEST1, TEST2, TEST3 ');
gotoxy(70,1);
textcolor(red);
write('ESC-EXIT.');
writeln;
writeln;
textcolor(lightred);
writeln('Nacisnij dowolny klawisz, aby zaczac test !');
writeln;
end;
{-------------------------------------------------------------------}
{ Program g˘wny }
begin
Repeat
clrscr;
menu;
if zn=#0 then
zn:=readkey;
if zn = #27 then halt;
wczytaj(k);
Repeat
textcolor(lightred);
writeln;
write('Zakoäczy† program? (t\n) ');
readln(zn);
Until (zn='t') or (zn='T') or (zn='n') or (zn='N');
Until (zn='t') or (zn='T');
end.
a może bardziej rozbuduj swoją wypowiedź bo nadal nie rozumiem czy ty masz problem z porównaniem string'u
if not ('abc' = 'acb') then ShowMessage('fail!');
wykorzystaj jeden z algorytmów sortowania np tworzysz funkcję sort
sort(string str);
i w pętli od 0 do < str.length() porównujesz znaki np:
if(str[i] > str[i+1])
wtedy do str[i] wprowadzasz str[i+1] a do str[i+1] wprowadzasz str[i] itd.
Wtedy wyskakuje mi taki błąd.... W tej procedurze 'sort' tam gdzie mam zmienną temp... Incompatible types : got "Short String"....
zmienna temp musiała być typu char... I wszystko działa jak powinno;D