Please note, this is a STATIC archive of website www.tutorialspoint.com from 11 May 2019, cach3.com does not collect or store any user information, there is no "phishing" involved.
Program Nettolohn;
var
x,y: real;
begin
write('Geben Sie Anzahl der Arbeitsstunden ein ');
read(x);
if x>=0 then
begin
if X<12.5 then
begin
y:= (x*12)*90/100;
Writeln(y:0:2);
end;
if (x>=12.5) and (x<40) then
begin
y:= (x*12)*80/100;
writeln(y:0:2);
end;
if x>=40 then
begin
y:= (x*18)*80/100;
writeln(y:0:0);
end;
end
else
Writeln('Die Zahlen müssen positiv sein')
End.
program FolgenMinimum (input, output);
{ Liest eine Folge von 5 integer-Zahlen
ein und gibt die kleinste Zahl mit seiner
Position aus }
const
FELDGROESSE = 5;
type
tIndex = 1..FELDGROESSE;
tZahlenFeld = array [tIndex] of integer;
var
Feld : tZahlenfeld;
Minimum : integer;
Position : tIndex;
i : tIndex;
begin
{ Minimum initialisieren }
Minimum := maxint;
{ Einlesen des Feldes und Ermitteln des Minimum }
writeln ('Geben Sie ', FELDGROESSE, ' Werte ein:');
for i := 1 to FELDGROESSE do
begin
readln (Feld[i]);
if Feld[i] < Minimum then
begin
Minimum := Feld[i];
Position := i;
end
end;
{ Ausgabe des Minimums und seiner Position }
writeln ('Der kleinste Wert ist: ', Minimum, ' an der Stelle: ', Position, '.')
end. { FolgenMinimum }
program clock_natalizzio;
uses crt,dos;
var
h, m, s, cent,old_s : Word;
f:char;
procedure seg_a (spost_x:integer;spost_y:integer;lung_seg:integer;c:char);
var i:integer;
begin
for i:=1 to lung_seg*2 do begin
gotoxy (spost_x+(i),spost_y+1);
writeln (c);
end;
end;
procedure seg_b (spost_x:integer;spost_y:integer;lung_seg:integer;c:char);
var i:integer;
begin
for i:=1 to lung_seg do begin
gotoxy (spost_x+(lung_seg*2-1),spost_y+i);
writeln (c);
end;
end;
procedure seg_c (spost_x:integer;spost_y:integer;lung_seg:integer;c:char);
var i:integer;
begin
for i:=1 to lung_seg do begin
gotoxy (spost_x+(lung_seg*2-1),spost_y+lung_seg+i);
writeln (c);
end;
end;
procedure seg_d (spost_x:integer;spost_y:integer;lung_seg:integer;c:char);
var i:integer;
begin
for i:=1 to lung_seg*2 do begin
gotoxy (spost_x+(i),spost_y+(lung_seg*2-1)+1);
writeln (c);
end;
end;
procedure seg_e (spost_x:integer;spost_y:integer;lung_seg:integer;c:char);
var i:integer;
begin
for i:=1 to lung_seg do begin
gotoxy (spost_x+1,spost_y+lung_seg-1+i+1);
writeln (c);
end;
end;
procedure seg_f (spost_x:integer;spost_y:integer;lung_seg:integer;c:char);
var i:integer;
begin
for i:=1 to lung_seg do begin
gotoxy (spost_x+1,spost_y+i);
writeln (c);
end;
end;
procedure seg_g (spost_x:integer;spost_y:integer;lung_seg:integer;c:char);
var i:integer;
begin
for i:=1 to lung_seg*2 do begin
gotoxy (spost_x+(i),spost_y+lung_seg);
writeln (c);
end;
end;
procedure display7_clocK (ore:integer;min:integer;sec:integer) ;
const y=7; //spost_y
var v,z,x(*spost_x*),f:integer;
classificazione: array [1..6] of integer;
carat:char;
begin
s:=3;
x:=0;
z:=0;
classificazione[1]:=(ore div 10); //h1
classificazione[2]:=ore - (classificazione[1]*10); //h2
classificazione[3]:=(min div 10); //m1
classificazione[4]:=min - (classificazione[3]*10); //m2
classificazione[5]:=(sec div 10); //s1
classificazione[6]:=sec - (classificazione[5]*10); //s2
carat:='*';
for v:=1 to 6 do begin
z:=classificazione[v];
x:=x+5;
case z of
0: begin seg_a(x,y,s,carat); seg_b(x,y,s,carat); seg_c(x,y,s,carat); seg_d(x,y,s,carat); seg_e(x,y,s,carat); seg_f(x,y,s,carat); end;
1: begin seg_b(x,y,s,carat); seg_c(x,y,s,carat); end;
2: begin seg_a(x,y,s,carat); seg_b(x,y,s,carat); seg_d(x,y,s,carat); seg_e(x,y,s,carat); seg_g(x,y,s,carat); end;
3: begin seg_a(x,y,s,carat); seg_b(x,y,s,carat); seg_c(x,y,s,carat); seg_d(x,y,s,carat); seg_g(x,y,s,carat); end;
4: begin seg_b(x,y,s,carat); seg_c(x,y,s,carat); seg_f(x,y,s,carat); seg_g(x,y,s,carat); end;
5: begin seg_a(x,y,s,carat); seg_c(x,y,s,carat); seg_d(x,y,s,carat); seg_f(x,y,s,carat); seg_g(x,y,s,carat); end;
6: begin seg_a(x,y,s,carat); seg_c(x,y,s,carat); seg_d(x,y,s,carat); seg_e(x,y,s,carat); seg_f(x,y,s,carat); seg_g(x,y,s,carat); end;
7: begin seg_a(x,y,s,carat); seg_b(x,y,s,carat); seg_c(x,y,s,carat); seg_f(x,y,s,carat); end;
8: begin seg_a(x,y,s,carat); seg_b(x,y,s,carat); seg_c(x,y,s,carat); seg_d(x,y,s,carat); seg_e(x,y,s,carat); seg_f(x,y,s,carat); seg_g(x,y,s,carat); end;
9: begin seg_a(x,y,s,carat); seg_b(x,y,s,carat); seg_c(x,y,s,carat); seg_d(x,y,s,carat); seg_f(x,y,s,carat); seg_g(x,y,s,carat); end;
end;
x:=x+s;
if (v=2) then begin
for f :=1 to s*2 do if ((f=3) or (f=4) or (f=6)or (f=7)) then
begin
gotoxy(x+3,y+f);
write ('*');
end;
x:=x+7;
end;
end;
end;
begin
repeat
old_s:=0;
gettime(h,m,s,cent);
if (s <> old_s) then
begin
gotoxy(1,1);
old_s:=s;
textcolor(lightgreen);
write(h:2,' ',m:2,' ',s:2);
display7_clocK(h,m,s);
textcolor(black);
display7_clocK(8,8,8);
end;
until keypressed;
readln;
end.
program minimo_con_procedure;
uses crt;
const max=100;
var a:array[1..100]of integer;
i,n,min:integer;
risp:char;
procedure input;
begin
repeat
writeln('immetti la dimensione');
readln(n);
until (n>0) and (n<=max);
randomize;
for i:=1 to n do
a[i]:=random(50)+1;
end;
procedure minimo;
begin
min:=a[1];
for i:=1 to n do
if (a[i]<min) then min:=a[i];
end;
procedure output;
begin
for i:= 1 to n do
writeln ('il ',i,'° numero e'' ',a[i]);
writeln('il minimo e'' ',min);
end;
BEGIN
repeat
input;
minimo;
output;
writeln('vuoi ripetere? s o n');
readln(risp);
until (risp='n');
END.
Program sqrt1(output);
const n=10
var s : array [1..n] of integer;
i:integer;
begin
writeln('enter elements');
for i:=1 to n do
read(s[i]);
writeln;
for i:=1 to n do
if trunc(sqrt(a[i]))*trunc(sqrt(a[i]))=a[i]
then writeln('s[',i,']:=',s[i]);
end.
