{Bilaga 8.2 nytt

Filnamn: uppg1.pas
Vem: Phunlapha Suwaphanich
När: 2002-10-04
Vad:Programmet skapar betygsregister, genom att göra menyval på skärmen. Det ka$
 }
program Betygslista(input, output);
const
   MAX     = 32;
   min_fil = 'Betygsregister.txt';
type
   str255      = string[255];
   elevPost  = record
                    namn  : str255;
                    kurs1 : str255;
                    kurs2 : str255;
                    kurs3 : str255;
                    kurs4 : str255;
                               [ Read 284 lines ]

spartacus(nb99psh): cat uppg1.pas 
{Bilaga 8.2 nytt

Filnamn: uppg1.pas
Vem: Phunlapha Suwaphanich
När: 2002-10-04
Vad:Programmet skapar betygsregister, genom att göra menyval på skärmen. Det kan lägga till nya elever, laddar ner på en textfil osv.
 }
program Betygslista(input, output);
const
   MAX     = 32;
   min_fil = 'Betygsregister.txt';
type
   str255      = string[255];
   elevPost  = record
                    namn  : str255;
                    kurs1 : str255;
                    kurs2 : str255;
                    kurs3 : str255;
                    kurs4 : str255;
                 end;
   rubrikPost = record
                    namn : str255;
                    matte : str255;
                    sv    : str255;
                    eng   : str255;
                    hem   : str255;
                 end;
   
   elevInmat = array[1..500] of elevPost; {arrayen kan innehålla 1 till 500 ele ment, 
varje element är en typ av elevPost}

var

        lista      : elevInmat;
        antal_elev : integer;
        elev_post  : elevPost;
{Proceduren läser in den sparade filen för ev. skrivning/läsning }
procedure LasInfil(var lista : elevInmat;
                   var antal_elev: integer);
var
   f       : text;
   filnamn : string[50];
   rad  : string[200];

begin
   write('filnamn >> ');
   readln(filnamn);
   assign(f,filnamn); 
   reset(f);
   antal_elev := -1;

   while not Eof(f) do {medan det är inte slut på filen}
   begin
      inc(antal_elev); {öka räknaren med 1}
      readln(f,rad); {läser av filen}
      writeln(rad);
   end;
   close(f);
   readln;
end; { LasInfil }

{Funktionenen används för att göra olika sökningar}
function SokningsMenyval : integer;
var
        sokmenyval : integer;
begin
        writeln;
        writeln('Sökningsalternativ');
        writeln;
        writeln('1. Sök ut elever med visst betyg i valfritt ämne.');
        writeln('2. Sök ut elever med IG i någon kurs.');
        writeln('3. Sök ut elever och deras betyg efter del i namnet.');
        writeln('4. Återgå till huvudmeny.');
        write('val >> ');
        readln(sokmenyval);
        SokningsMenyval := sokmenyval;
end;

{Funktionen används för att kunna göra olika sökningar.}
function MenySokElevVisstBetyg : integer;
var
        val : integer;
begin
        writeln;
        writeln('Följande ämne finns:');
        writeln;
        writeln('1. Matematik');
        writeln('2. Svenska');
        writeln('3. Engelska');
        writeln('4. Hemkundskap');
        MenySokElevVisstBetyg := val;
end;

{Proceduren skriver ut betyget för ett visst ämne.}
{function elementSokning(var lista : elevInmat;
                        var antal_element : integer;
                        var element_typ : string;
                        var i : integer) : boolean;
var
        finns : boolean;
begin
        finns := false;
        i := 1;
        while not finns and (i <= antal_element) do begin
         if element_typ = lista[i] then
          finns := true
         else
          inc(i);
        end;
        elementSokning := finns;
end;}

procedure skrivUtEnElev(var epost : elevPost);
begin
        with epost do begin
                write(namn:15);
                writeln;
        end;
end;

procedure skrivUtSoktaElever(var l : elevInmat;
                                var a : integer;
                                var v : integer;
                                var btyg : string);
var
        i : integer;
begin
                if btyg = l[i].kurs1 then
                        writeln(l[i].namn)
                else if btyg = l[i].kurs2 then
                        writeln(l[i].namn)
                else
                        writeln('Det finns inte någon som har ',btyg);
end;

{Proceduren lägger till nya elever}
procedure LaggTillElev(var lista      : elevInmat;
                       var antal_elev : integer);
begin
   write('Namn >> ');
   antal_elev := antal_elev + 1;
   readln(lista[antal_elev].namn);
   
   write('Betyg i matematik >> ');
   readln(lista[antal_elev].kurs1);
   
   write('Betyg i svenska >> ');
   readln(lista[antal_elev].kurs2);
   
   write('Betyg i  engelska >> ');
   readln(lista[antal_elev].kurs3);
   
   write('Betyg i hemkundskap >> ');
   readln(lista[antal_elev].kurs4);
end;

{Proceduren sparar varje elev i textfilen}
procedure SparaElevTillFil(var fil  : text;
                    var en_elev : elevPost);
var
   tecken : char;

begin
   tecken := ',';
   with en_elev do begin
        write(fil, namn);
        write(fil, tecken);
        write(fil, kurs1);
        write(fil, tecken);
        write(fil, kurs2);
        write(fil, tecken);
        write(fil, kurs3);
        write(fil, tecken);
        write(fil, kurs4);
        end;
end; { SparaElev }

procedure SparaEleverTillFil(var antal_elever : integer);
var
        fil : text;
        i : integer;
begin
        rewrite(fil, min_fil);
        for i := 1 to antal_elever do
                SparaElevTillFil(fil, lista[i]);
        close(fil);
end;

procedure AndraBetyg(var elev : elevInmat;
                     var antal: integer);
var
   delnamn : string[50];
   i,flagg         : integer;
begin                       
   write('Ange del i namnet : ');
   readln(delnamn);
   writeln('Välj en :');
   for i := 1 to length(elev[i].namn) do
      begin{stega igenom strängen}
         if elev[i].namn = delnamn[i] then      {när är strängens bokstav lika med tn}
            writeln(flagg,' - ',elev[i].namn);
          flagg := flagg +1;
      end;
end;

{Funktionen skriver ut meny på skärmen}
function menyval : Integer;
var
   val : Integer;
begin
   writeln;
   writeln('Välkommen till Betygsprogrammet! ');
   writeln('1 - Ladda in ett register');
   writeln('2 - Spara nuvarande register');
   writeln('3 - Sökaningar');
   writeln('4 - Ändra betyg');
   writeln('5 - Lägg till elev');
   writeln('6 - Avsluta');
   write('val > ');
   readln(val);
   menyval := val;
end;

{******************** Här börjar huvudprogrammet **********************}

var
   huvudval, sokval,
   sokval1, val1, i             : Integer;
   filnamn, betyg            : string[50];
   element_sok               : boolean;

begin
   repeat
      huvudval := menyval;
      case huvudval of
        1 : begin
               LasInfil(lista,antal_elev);
               writeln('Filen laddad, 4 ämnen, ',antal_elev,' elever.');
            end;
        2 : SparaEleverTillFil(antal_elev);
        3 : begin
             repeat
              sokval := SokningsMenyval;
               case sokval of
                1 : begin
                      sokval1 := MenySokElevVisstBetyg;
                      case sokval1 of
                       1 : begin
                                write('val >>> ');
                                readln(val1);
                                write('Betyg >>> ');
                                readln(betyg);
                                writeln('a har värde ',antal_elev);
                                skrivUtSoktaElever(lista,antal_elev,val1,betyg);
                            writeln('Hallooooo, här är jag');
                           end;
                       2 : writeln('dkfjdf');
                      end;
                    end;
                2 : writeln('2. fungar');
                3 : writeln('3. fungar');
                4 : break;
               end;
            until (sokval = 4);
            end;
        5 : Begin
                LaggTillElev(lista, antal_elev);
                {skrivUtEnElev(elev_post);}
                writeln(lista[antal_elev].namn,' är inlagd i registret.');
            end;
        6 : Writeln('Fenito :)')
      else
        writeln('********* Välj mellan 1 och 6, gör ett nytt försök. *********');
      end; { case }
   until (huvudval = 6);
end.