wypisuje prawidlowo ale nic nie sortuje prosze o pomoc pozdrawiam Marcin
cos jest nie tak z procedura sortuj i wypisz
Kod: Zaznacz cały
program szkola;
uses
Crt , logowanie;
Const
K = 1;
p='dane.dat';
plik_tymczasowy = 'tmp.dat';
Type
TOsoba = Record
nr : integer;
imie : String[40];
nazw : String[50];
wiek : Byte;
plec : Char;
end;
moj_plik = file of TOsoba;
Tab = Array [1..K] of TOsoba;
Var
Osoba : TOsoba;
f : file of TOsoba;
x : byte;
zmienna , zmienna1 : string;
temp : moj_plik; {zmienne plikowe}
o : TOsoba;
j,I : integer;
T : Tab;
Procedure Wypisz(T:Tab);
begin
assign(f,p);
Reset(f);
While Not EoF(f) Do {wyswietl cala zawartosc pliku}
begin
read (f, Osoba);
With T[I] Do
begin
Write('Imi�:',Osoba.Imie:10,' ');
Write('Nazwisko:',Osoba.Nazw:15,' ');
Write('Wiek:',Osoba.Wiek:10,' ');
Writeln('Pˆe†:',Osoba.Plec:10);
end;
End;
Close(f);
end;
Procedure Sortuj(var T:Tab);
{
Procedura sortuje wg wieku
dane zawarte w tablicy
}
Var I,J : Byte; {zmienne sterujace petla}
Z : TOsoba; {zmienna pomocnicza potrzebna do sortowania}
begin
assign(f,p);
Reset(f);
While Not EoF(f) Do {wyswietl cala zawartosc pliku}
Begin
read (f, Osoba);
For I:=1 to K-1 do
For J:=I+1 to K do
if T[I].wiek>T[J].wiek then
begin
Z:=T[I];
T[I]:=T[J];
T[J]:=Z;
end;
End; {---of S---}
end;
procedure NoweDane;
begin
repeat
clrscr;
writeln('1 Wywietl menu');
writeln('2 Wyswietl wszystkie rekordy');
writeln('3 Dodaj rekord');
writeln('4 Kasuj rekord');
writeln('5 Posortuj');
writeln('6 Wyszukaj');
writeln('7 Koniec');
writeln;
writeln(' podaj cyfre ');
readln(x);
until (x > 0) and (x < 8)
end;
procedure Pokaz;
begin
if x =1 then
begin
clrscr;
writeln('1 Wywietl menu');
writeln('2 Wyswietl wszystkie rekordy');
writeln('3 Dodaj rekord');
writeln('4 Kasuj rekord');
writeln('5 Posortuj');
writeln('6 Edytuj rekord');
writeln('7 Wyszukaj');
writeln('8 Koniec');
writeln;
writeln(' podaj cyfre ');
end;
if x =2 then
begin
clrscr;
assign(f,p);
Reset(f);
While Not EoF(f) Do
begin
{wyswietl cala zawartosc pliku}
read (f, Osoba);
Write('Nr : ');
Writeln(Osoba.Nr,' ');
Write('Imie : ');
Writeln(Osoba.Imie,' ');
Write('Nazwisko : ');
Writeln(Osoba.Nazw,' ');
Write('Wiek : ');
Writeln(Osoba.Wiek,' ');
Write('Plec : ');
Writeln(Osoba.Plec,' ');
Writeln ('********************************************');
end;
Close(f);
end;
if x =3 then
begin
assign(f,p);
reset(f);
{$I-} seek (f,FileSize(f)); {$I+}
if IOResult=0 then
seek (f,FileSize(f));
With Osoba Do
begin
repeat
Writeln('Podaj dane osob lub enter by skończyć');
Write('Imie : '); Readln(Imie);
if (Imie<>'') then
begin
Write('Nazwisko : '); Readln(Nazw);
Write('Wiek : '); Readln(Wiek);
Write('Plec : '); Readln(Plec);
Write('Nr : '); Readln(Nr);
write (f, Osoba);
end;
until (Osoba.Imie='');
close(f);
end;
end;
if x =4 then
begin
Write('Podaj pozycje do usuniecia:'); ReadLn(j);
Reset(f);
Assign(temp,plik_tymczasowy);
ReWrite(temp);
While Not EoF(f) Do {dopoki nie ma konca pliku}
begin
read(f,o); {czytaj zawartosc pliku}
if o.nr <> j then {jezeli id z rekordu <> od}
begin {pozycji do usuniecia}
o.nr := FilePos(temp)+1; {zacznij od id=1 i zwiekszaj o 1}
write(temp,o); {zapisz rekord do pliku}
end;
end;
Close(temp);
Close(f);
Erase(f); {usun plik_z_danymi}
ReName(temp,p);
end;
if x =5 then
BEGIN
ClrScr;
Writeln('Przed sortowaniem:'); WriteLn;
For I:=1 To K Do
Wypisz(T);
Sortuj(T);
WriteLn;
Writeln('Po sortowaniu:'); WriteLn;
For I:=1 To K Do
Wypisz(T);
ReadLn;
end;
if x =6 then
begin
assign(f,p);
Reset(f);
writeln('Podaj imie');
readln(zmienna);
writeln('Podaj nazwisko');
readln(zmienna1);
While Not EoF(f) Do
begin
read (f, Osoba);
if (pos(Osoba.Imie , zmienna)>0) and
(pos(Osoba.Nazw , zmienna1)>0) then
writeln ('dana jest');
writeln;
end;
Close(f);
end;
if x =7 then
begin
halt;
end;
end;
var
x1 : byte;
begin
haslo1;
repeat
ClrScr;
NoweDane;
Pokaz;
write(' koniec - 7 , 1 - menu ');
readln(x1);
until (x1 = 7);
end. aha chodzi mi zeby ten program tez jak posortuje zapisywal je do innego pliku \
wsumie cos takiego
Zadanie 45
Napisa program, który z pliku tekstowego wczytuje list nazwisk, sortuje je i wypisuje do
innego pliku tekstowego
nie wiem czy dam sam go rade przerobic
