Dze je subor www.TrSek.com/cover/mersi/mineraly.pas
{ MINERALY.PAS                                  Copyright (c) mersi }
{                                                                   }
{ Zostavte program, ktorý bude vykonáva» nasledujúce èinnosti:      }
{ - naèítavanie údajov N minerálov (názov, tvrdos», hustota,        }
{   teplota topenia),                                               }
{ - zistenie priemernej tvdrosti                                    }
{ - zistenie najni¾¹ej a najvy¹¹ej hustoty                          }
{ - zistenie najvy¹¹ej teploty topenia                              }
{ - zapísanie zistených údajov do textového súboru ,,mineral.txt''  }
{                                                                   }
{ Author: mersi                                                     }
{ Date  : 11.02.2008                           http://www.trsek.com }

program MINERALY_;
uses    Crt;
const   NMAX=200;
type    MINERAL=record
          NAZOV:string;
          TVRDOST:real;
          HUSTOTA:real;
          TEPLOTA:real;
          end;
        MINERALY=array[1..NMAX] of MINERAL;

var     N,i,C,D:integer;
        V:real;
        MI:MINERALY;
        S:string;
        SUB:text;
        PTVRD,CTVRD:real;
        MINHUST,MAXHUST:real;
        MAXTEPLOTA:real;

begin
        ClrScr;
        Writeln('Program pre nacitanie mineralov a vypocet hodnot ich jednotlivych vlastnosti.');
        Writeln('===============================================================================');

        {Vynulovanie hodnot}
        CTVRD:=0;
        PTVRD:=0;
        MINHUST:=0;
        MAXHUST:=0;
        MAXTEPLOTA:=0;

        {Nacitanie poctu mineralov}
        Writeln;
        Write('Zadajte pocet nacitavanych mineralov (Maximalne 200): ');
        repeat
                Readln(S);
                Val(S,D,C);
                if (C<>0) or (D<=0) or (D>200) then
                        begin
                        Writeln;
                        Writeln('Zadali ste nespravny pocet, alebo ste zadali nespravne znaky !');
                        Writeln('Hodnota moze byt  od 1-200');
                        Write('Zadajte pocet mineralov este raz: ');
                        end;
                N:=D;
        until(N>0) and (N<=200) and (C=0);

        {nacitavanie udajov, zistovanie max. a min. hodnot atd.}
        for i:=1 to N do
                begin
                        Writeln;
                        Write('Zadajte nazov mineralu: ');
                        Readln(MI[i].NAZOV);

                        Write('Zadajte tvrdost mineralu (musi byt vacsia ako 0): ');
                        repeat
                                Readln(S);
                                Val(S,V,C);
                                if (C<>0) or (V<0) then
                                        begin
                                        Writeln;
                                        Writeln('Zadali ste nespravnu hodnotu, alebo ste zadali nespravne znaky !');
                                        Write('Zadajte tvrdost este raz (musi byt vacsia ako 0): ');
                                        end;
                        until (V>0) and (C=0);
                        MI[i].TVRDOST:=V;
                        CTVRD:=CTVRD+MI[i].TVRDOST;

                        Write('Zadajte hustotu mineralu (musi byt vacsia ako 0): ');
                        repeat
                                Readln(S);
                                Val(S,V,C);
                                if (C<>0) or (V<0) then
                                        begin
                                        Writeln;
                                        Writeln('Zadali ste nespravnu hodnotu, alebo ste zadali nespravne znaky !');
                                        Write('Zadajte hustotu este raz (musi byt vascia ako 0): ');
                                        end;
                                until (V>0) and (C=0);
                        MI[i].HUSTOTA:=V;

                        if (i=1) then MINHUST:=MI[i].HUSTOTA;
                        if (MI[i].HUSTOTA<MINHUST) then MINHUST:=MI[i].HUSTOTA;
                        if (MI[i].HUSTOTA>MAXHUST) then MAXHUST:=MI[i].HUSTOTA;

                        Write('Zadajte teplotu topenia mineralu: ');
                        repeat
                                Readln(S);
                                Val(S,V,C);
                                if (C<>0) then
                                        begin
                                        Writeln;
                                        Writeln('Zadali ste nespravnu hodnotu, alebo ste zadali nespravne znaky !');
                                        Write('Zadajte teplotu topenia este raz: ');
                                        end;
                                until (C=0);
                        MI[i].TEPLOTA:=V;

                        if (MI[i].TEPLOTA>MAXTEPLOTA) then MAXTEPLOTA:=MI[i].TEPLOTA;
                  end;

        PTVRD:=CTVRD/N;

        Writeln;
        Writeln('Vypocitane hodnoty: ');
        Writeln('===================================');
        Writeln;
        Writeln('Priemerna tvrdost mineralov: ',PTVRD:2:2);
        Writeln('Najnizsia hustota: ',MINHUST:2:2);
        Writeln('Najvyssia hustota: ',MAXHUST:2:2);
        Writeln('Najvyssia teplota topenia: ',MAXTEPLOTA:2:2);

        Assign(SUB,'mineral.txt');
        Rewrite(SUB);
        Writeln(SUB,'Nacitane mineraly: ');
        Writeln(SUB,'===================================');
        Writeln(SUB,'');
        for i:=1 to N do
                begin
                Writeln(SUB,i,'. mineral: ');
                Writeln(SUB,'Nazov: ',MI[i].NAZOV);
                Writeln(SUB,'Tvrdost: ',MI[i].TVRDOST:2:2);
                Writeln(SUB,'Hustota: ',MI[i].HUSTOTA:2:2);
                Writeln(SUB,'Teplota topenia: ',MI[i].TEPLOTA:2:2);
                Writeln(SUB,'');
        end;
        Writeln(SUB,'===================================');
        Writeln(SUB,'Vypocitane hodnoty: ');
        Writeln(SUB,'===================================');
        Writeln(SUB,'');
        Writeln(SUB,'Priemerna tvrdost mineralov: ',PTVRD:2:2);
        Writeln(SUB,'Najnizsia hustota: ',MINHUST:2:2);
        Writeln(SUB,'Najvyssia hustota: ',MAXHUST:2:2);
        Writeln(SUB,'Najvyssia teplota topenia: ',MAXTEPLOTA:2:2);
        Close(SUB);
        Writeln;
        Writeln;
        Writeln('Pre ukoncenie programu stlacte ENTER !');
        Readln;

end.
Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com