Sortowanie pascal

[sabat232]

Baza danych działa ale nie wiem jak dopisać do niej żeby sortowało mi według Marki samochodu… ma ktoś na to jakiś pomysł?

program salon_samo;

uses crt;


type

  auto=record

    marka:string;

    rok:integer;

    ilosc:integer;

    cena:real;

    upust:real;

  end;

  auta=array[1..50] of auto;


var

  plik:text;

  z:char;

  n:integer;

  salon:auta;

  sciezka:string;


procedure DodajMarke;

begin

  n:=n+1;

  write('Podaj nazwe marki: '); readln(salon[n].marka);

  write('Podaj rok produkcji: '); readln(salon[n].rok);

  write('Podaj ilosc sztuk: '); readln(salon[n].ilosc);

  write('Podaj cene: '); readln(salon[n].cena);

  write('Podaj ewentaulny upust: '); readln(salon[n].upust);

end;


procedure UsunMarkeoIndexie(x:integer);

var

  i:integer;

begin

  if (x>n) then writeln('Nie ma takiego wpisu.') else

  for i:=x to n-1 do salon[i]:=salon[i+1];

  n:=n-1;

end;


procedure UsunMarke;

var

  x:integer;

begin

  write('Wybierz numer wpisu ktory ma byc usuniety: ');

  readln(x);

  UsunMarkeoIndexie(x);

end;


procedure PokazBaze;

var

  i:integer;

begin

  clrscr;

  if n=0 then writeln('W bazie nie ma wpisow') else

  for i:=1 to n do

    begin

      writeln('------- Wpis nr ',i,' -----------------------');

      writeln('Marka: ',salon[i].marka);

      writeln('Rok produkcji: ',salon[i].rok);

      writeln('Ilosc sztuk: ',salon[i].ilosc);

      writeln('Cena: ',salon[i].cena:0:2);

      writeln('Upust: ',salon[i].upust:0:2);

    end;

  writeln('Wcisnij cos...');

  readkey;

end;


procedure ZmienDane;

var

  i:integer;

begin

  write('Wybierz numer wpisu ktory ma byc edytowany: ');

  readln(i);

  UsunMarkeoIndexie(i);

  DodajMarke;

end;


procedure PokazMenu;

begin

  clrscr;

  writeln('1. Tworzenie bazy danych');

  writeln('2. Przegladanie bazy danych');

  writeln('3. Dopisywanie danych');

  writeln('4. Zmiana danych');

  writeln('5. Usuwanie rekordu');

  writeln('6. Zapisz baze do pliku');

  writeln('7. Koniec');

end;


procedure ZapiszDoPliku;

var

  i:integer;

begin

  write('Podaj nazwe pliku: ');

  readln(sciezka);

  assign(plik,sciezka);

  rewrite(plik);

  writeln(plik,n);

  for i:=1 to n do

    begin

      writeln(plik,salon[i].marka);

      writeln(plik,salon[i].rok);

      writeln(plik,salon[i].ilosc);

      writeln(plik,salon[i].cena);

      writeln(plik,salon[i].upust);

    end;

  close(plik);

  writeln('Zapisano do pliku, wcisnij cos...');

  readkey;

end;


procedure OdczytajZpliku;

var

  i:integer;

begin

  assign(plik,sciezka);

  reset(plik);

  readln(plik,n);

  for i:=1 to n do

    begin

      readln(plik,salon[i].marka);

      readln(plik,salon[i].rok);

      readln(plik,salon[i].ilosc);

      readln(plik,salon[i].cena);

      readln(plik,salon[i].upust);

    end;

  close(plik);

end;


procedure UtworzBaze;

var

  z:char;

begin

  clrscr;

  writeln('1. Odczytaj baze z pliku');

  writeln('2. Utworz baze recznie (podajc dane)');

  repeat

    z:=readkey;

  until((z<'3') and (z>'0'));

  if z='1' then

    begin

      write('Podaj sciezke i nazwe pliku: ');

      readln(sciezka);

      OdczytajZPliku;

    end;

  if z='2' then

    begin

      n:=0;

      repeat

        DodajMarke;

        writeln('Czy chcesz dodac kolejny rekord? t\n');

        repeat

          z:=readkey;

        until((z='t') or (z='n'));

      until(z='n');

    end;

  writeln;

  writeln('Zakonczono tworzenie bazy, wcisnij cos...');

  readkey;

end;


begin

  n:=0;

  sciezka:='bazaDanych.txt';

  repeat

    PokazMenu;

    repeat

      z:=readkey;

    until((z>'0') and (z<'8'));

    if z='1' then UtworzBaze;

    if z='2' then PokazBaze;

    if z='3' then DodajMarke;

    if z='4' then ZmienDane;

    if z='5' then UsunMarke;

    if z='6' then ZapiszDoPliku;

  until(z='7');

end.

[Airborn]

sabat232 , proszę poprawić tytuł tematu na konkretny, dokładniej mówiący o problemie. W przeciwnym razie temat zostanie usunięty.

[drobok]

Marka to string sprawdzasz kolejne znaki, jeśli poprzednie są takie same. A jeśli są większe np na podstawie chr to zamieniasz. Napisz czego dokładnie nie rozumiesz ;]

[_alex]

Wybierz sobie algorytm sortowania.

Najprostszy do implementacji to sortowanie bąbelkowe.

Porównanie dwóch marek:

if salon_.marka_

[sabat232]

nie rozumiem wogule sortowania dlatego chcę pomocy bo ma sortować według marki a jak posotyować to bym prosił o ten kawałek kodu.

poszedłem za rozumowaniem KOLEGI wyżej

procedure sortowanieMarki;

var 

i:integer;

begin

if salon[i].marka
else Write (' nie ma takiej marki!!!')

end;

i wyskakuj mi error. Może ktoś sprawdzić o co chodzi bo se nie daje rady.

[Marcin511 (Marcin Obala)]

i nie zainicjowane ale sortowanie musi być w pętli, dwie pętle - jedna wewnątrz drugiej. I tam dopiero ten if, po then musi byś kod który zamieni rekordy w tablicy.

[sabat232]

i nie zainicjowane ale sortowanie musi być w pętli, dwie pętle - jedna wewnątrz drugiej. I tam dopiero ten if, po then musi byś kod który zamieni rekordy w tablicy.

A tak jaśniej nie możesz walnąć znacznikiem code?

– Dodane 21.01.2011 (Pt) 15:21 –

wytłumaczy mi ktoś jedną rzecz będzie może dla was lepiej mnie zrozumieć albo w końcu się dowiem…o co tak naprawdę w tym chodzi … ALGORYTM SORTUJĄCY W BAZIE DANYCH FILM DZIAŁA LECZ NIE CHCE SORTOWAĆ NAPISZCIE MI DLACZEGO.

program filmy;


uses crt;

type film = record

imie,nazwisko,tytul:string;

rok:longint;

end;

var w:integer;



{procedura wprowadzania danych filmu}

procedure wprow_f(var f : film);

var i:integer;

begin


write('podaj tytul filmu');

readln(f.tytul);


     write('podaj imie rezysera');

     readln(f.imie);

                    write('podaj nazwisko rezysera');

                    readln(f.nazwisko);

                                       write('podaj rok produkcji');

                                       readln(f.rok);

end;


{procedura wyswietlania danych dla pojedynczego filmu}

procedure wyswietl_f(f : film);


              begin


              writeln(f.tytul,' ',f.imie,' ',f.nazwisko,' ',f.rok);


              end;


{procedura wprowadzania danych do pliku}

procedure dopliku;

var p:file of film;

    f:film; c:char;

            begin

                 assign(p, 'filmy.dat');

                 rewrite(p);

                 repeat

                       wprow_f(f);

                       write (p,f);

                       write('nastepny film ? t=tak');

                       readln(c);

                       until c<>'t';

                       close(p);

            end;


{procedura dopisywania pojedynczego filmu do pliku}


procedure dopisz;

var q,p: file of film;

f:film;


       begin

            assign(p,'filmy.dat');

            assign(q,'tymczasowy');

            reset(p);

            rewrite(q);

            while not eof(p) do

                  begin

                       read(p,f);

                       write(q,f);

                  end;

            close(p);

            close(q);

            rewrite(p);

            reset(q);

            while not eof(q) do

                  begin

                       read(q,f);

                       write(p,f);

                  end;

                  wprow_f(f);

                  write(p,f);

                  close(p);

                  close(q);

            end;

{procedura wyswietlania z pliku}

procedure wyswietl;

var p:file of film;

f:film;

       begin

            assign(p,'filmy.dat');

            reset(p);

            while not eof(p) do

                  begin

                       read(p,f);

                       wyswietl_f(f);

                  end;

                  close(p);

                  readln;

            end;


{procedura edycji danych w pliku (jednej osoby)}

procedure edytuj;

 var q,p:file of film;

    f:film;

    s1,s:string;

            begin

                 write('podaj imie rezysera do zmiany: ');

                 readln(s);

                 write('podaj nazwisko rezysera do zmiany: ');

                 readln(s1);

                 assign(p,'filmy.dat');

                 assign(q,'tymczasowy');

                 reset(p);

                 rewrite(q);

                 while not eof(p) do

                       begin

                            read(p,f);

                            write(q,f);

                       end;

                 close(p);

                 close(q);

                 rewrite(p);

                 reset(q);

                 while not eof(q) do

                       begin

                            read(q,f);

                            if (f.imie=s) and (f.nazwisko=s1) then

                               wprow_f(f);

                            write(p,f);

                       end;

                 close(p);

                 close(q);

            end;



{procedura wyszukiwania filmu wedlug zadanego klucza}

procedure wyszukaj;

var

p : file of film;

f : film;

s : string;

x : integer;

begin

write('podaj tytul filmu ktory chcesz znalezc : ');

readln(s);

assign(p,'filmy.dat'); {otwieramy plik}

reset(p); {reset pliku}

for x:=0 to filesize(p)-1 do {czytamy po kolei rekordy od 1 do rozmiaru pliku}

begin

seek(p,x); {ustawienie wskaznika na rekordzie x}

read(p,f); {odczyt jednego rekordu do zmiennej f}

if (pos(s,f.tytul)>0) then {czy zawiera szukany klucz ? - moze byc tylko czesc}

 writeln(x+1,'. ',f.tytul,' ',f.rok,' ',f.imie,' ',f.nazwisko); {pokazuje dane}

end;

close(p); {zamykamy plik}

writeln('');

writeln('');

writeln('Nacisnij enter aby kontynuowac.');

readln;

end;



procedure sortuj;

var

 i,j : integer;

 f1,f2 : film;

 p : file of film;

begin

{procedura sortowania rekordow z zapisem kolejnosci do pliku}

{bardzo prosta, ale bardzo wolna }

 assign(p,'filmy.dat'); {otwieramy plik}

 reset(p); {reset pliku}

 FOR i := filesize(p) - 1 DOWNTO 1 DO

    FOR j := 1 TO i DO

     BEGIN

       seek(p,j-1);

       read(p,f1);

       seek(p,j);

       read(p,f2); {czytamy 2 rekordy}

       IF f1.tytul > f2.tytul THEN {porownujemy tytuly}

          BEGIN

           seek(p,j-1); {zapisujemy w odwrotnej kolejnosci}

           Write(p,f2);

           seek(p,j);

           Write(p,f1);

          END;

     END;

 close(p); {zamykamy plik}

end;


{wyswietlanie menu}

procedure menu;


begin

clrscr;

writeln('1: wprowadz dane od poczatku');

writeln('2: dodaj nowy film');

writeln('3: wyswietl filmy');

writeln('4: edytuj filmy');

writeln('5: wyszukaj');

writeln('6: sortuj');

end;


begin{poczatek programu}


repeat

menu;

{wybur uzytkownika i akcja-case}

readln(w);

clrscr;

case w of

1: dopliku;

2: dopisz;

3: wyswietl;

4: edytuj;

5: wyszukaj;

6: sortuj;

end;

until (w>6)or(w<1);


end.

KOD działa ale sortowanie jak wciskam 6 to nie trybi nie chce sortować według tytułu.

[_alex]

reset§; - otwiera tylko do odczytu.

Użyj:

extend§;

lub wewnątrz If

begin

append§;

…

reset§;

end;

[sabat232]

":1ibfbwnq]reset§; - otwiera tylko do odczytu. Użyj: extend§; lub wewnątrz If begin append§; … reset§; end;

słowo extend§ jest nie rozpoznawalne w kodzie. taki błąd wyskoczył a jak wziąłem IF-a w begin

append§;

…

reset§;

to też mi się nie skompilowało nie wiem może coś źle robię .

PS: dawajcie znacznikiem CODE proźba…

[_alex]

       IF f1.tytul > f2.tytul THEN  {porownujemy tytuly}BEGIN(p);seek(p,j-1);  {zapisujemy w odwrotnej kolejnosci}Write(p,f2);seek(p,j);Write(p,f1);reset(p);END; [/code]

[sabat232]

Wszystko by było ładnie żeby jeszcze chciało mi się skompilować błąd mi wyskoczył. http://img841.imageshack.us/f/nowyobrazmapabitowawz.png/ błąd jest w linku.

PS: od razu napisze że plik filmy.dat jest zawiera on 2os

[_alex]

Nikt nie zgadnie co nabroiłeś.

Wklej kod, w znacznikach code, na pewno nie jest to związano ani z append ani z reset.

[sabat232]

program filmy;


uses crt;

type film = record

imie,nazwisko,tytul:string;

rok:longint;

end;

var w:integer;



{procedura wprowadzania danych filmu}

procedure wprow_f(var f : film);

var i:integer;

begin


write('podaj tytul filmu');

readln(f.tytul);


     write('podaj imie rezysera');

     readln(f.imie);

                    write('podaj nazwisko rezysera');

                    readln(f.nazwisko);

                                       write('podaj rok produkcji');

                                       readln(f.rok);

end;


{procedura wyswietlania danych dla pojedynczego filmu}

procedure wyswietl_f(f : film);


              begin


              writeln(f.tytul,' ',f.imie,' ',f.nazwisko,' ',f.rok);


              end;


{procedura wprowadzania danych do pliku}

procedure dopliku;

var p:file of film;

    f:film; c:char;

            begin

                 assign(p, 'filmy.dat');

                 rewrite(p);

                 repeat

                       wprow_f(f);

                       write (p,f);

                       write('nastepny film ? t=tak');

                       readln(c);

                       until c<>'t';

                       close(p);

            end;


{procedura dopisywania pojedynczego filmu do pliku}


procedure dopisz;

var q,p: file of film;

f:film;


       begin

            assign(p,'filmy.dat');

            assign(q,'tymczasowy');

            reset(p);

            rewrite(q);

            while not eof(p) do

                  begin

                       read(p,f);

                       write(q,f);

                  end;

            close(p);

            close(q);

            rewrite(p);

            reset(q);

            while not eof(q) do

                  begin

                       read(q,f);

                       write(p,f);

                  end;

                  wprow_f(f);

                  write(p,f);

                  close(p);

                  close(q);

            end;

{procedura wyswietlania z pliku}

procedure wyswietl;

var p:file of film;

f:film;

       begin

            assign(p,'filmy.dat');

            reset(p);

            while not eof(p) do

                  begin

                       read(p,f);

                       wyswietl_f(f);

                  end;

                  close(p);

                  readln;

            end;


{procedura edycji danych w pliku (jednej osoby)}

procedure edytuj;

var q,p:file of film;

    f:film;

    s1,s:string;

            begin

                 write('podaj imie rezysera do zmiany: ');

                 readln(s);

                 write('podaj nazwisko rezysera do zmiany: ');

                 readln(s1);

                 assign(p,'filmy.dat');

                 assign(q,'tymczasowy');

                 reset(p);

                 rewrite(q);

                 while not eof(p) do

                       begin

                            read(p,f);

                            write(q,f);

                       end;

                 close(p);

                 close(q);

                 rewrite(p);

                 reset(q);

                 while not eof(q) do

                       begin

                            read(q,f);

                            if (f.imie=s) and (f.nazwisko=s1) then

                               wprow_f(f);

                            write(p,f);

                       end;

                 close(p);

                 close(q);

            end;



{procedura wyszukiwania filmu wedlug zadanego klucza}

procedure wyszukaj;

var

p : file of film;

f : film;

s : string;

x : integer;

begin

write('podaj tytul filmu ktory chcesz znalezc : ');

readln(s);

assign(p,'filmy.dat'); {otwieramy plik}

reset(p); {reset pliku}

for x:=0 to filesize(p)-1 do {czytamy po kolei rekordy od 1 do rozmiaru pliku}

begin

seek(p,x); {ustawienie wskaznika na rekordzie x}

read(p,f); {odczyt jednego rekordu do zmiennej f}

if (pos(s,f.tytul)>0) then {czy zawiera szukany klucz ? - moze byc tylko czesc}

writeln(x+1,'. ',f.tytul,' ',f.rok,' ',f.imie,' ',f.nazwisko); {pokazuje dane}

end;

close(p); {zamykamy plik}

writeln('');

writeln('');

writeln('Nacisnij enter aby kontynuowac.');

readln;

end;



procedure sortuj;

var

i,j : integer;

f1,f2 : film;

p : file of film;

begin

{procedura sortowania rekordow z zapisem kolejnosci do pliku}

{bardzo prosta, ale bardzo wolna }

assign(p,'filmy.dat'); {otwieramy plik}

reset(p); {reset pliku}

FOR i := filesize(p) - 1 DOWNTO 1 DO

    FOR j := 1 TO i DO

     BEGIN

       seek(p,j-1);

       read(p,f1);

       seek(p,j);

       read(p,f2); {czytamy 2 rekordy}

       IF f1.tytul > f2.tytul THEN {porownujemy tytuly}

          BEGIN

           append(p);

           seek(p,j-1); {zapisujemy w odwrotnej kolejnosci}

           Write(p,f2);

           seek(p,j);

           Write(p,f1);

           reset(p);

          END; 

     END;

close(p); {zamykamy plik}

end;


{wyswietlanie menu}

procedure menu;


begin

clrscr;

writeln('1: wprowadz dane od poczatku');

writeln('2: dodaj nowy film');

writeln('3: wyswietl filmy');

writeln('4: edytuj filmy');

writeln('5: wyszukaj');

writeln('6: sortuj');

end;


begin{poczatek programu}


repeat

menu;

{wybur uzytkownika i akcja-case}

readln(w);

clrscr;

case w of

1: dopliku;

2: dopisz;

3: wyswietl;

4: edytuj;

5: wyszukaj;

6: sortuj;

end;

until (w>6)or(w<1);


end.

Proszę bardzo.

[_alex]

No rzeczywiście, przyzwyczaiłem się do Delphi i Lazarusa.

w starym pascalu:

reset - otwiera wyłącznie do odczytu.

rewrite - otwiera wyłącznie do zapisu.

append - owszem i do zapisu i do odczytu ale tylko dla plików tekstowych.

update - nie istnieje.

Musisz nieco zmienić algorytm sortowania, stary pascal nie pozwala otworzyć plik jednocześnie do zapisu i odczytu.

[sabat232]

A nie da rady mi tego zmieć bo ja nie kumam tego wo gule to wyższa szkoła jazdy jak dla mnie…

jak możesz daj mi to w znaczniku code… bo chyba sobie nie poradzę.

[_alex]

Najprościej: wczytaj całość do pamięci, posortuj i całość zapisz.

[sabat232]

nie obraź się ale nic mi to nie mówi:D