Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Evolvente - MODELLO.PAS

MODELLO.PAS

Caricato da: Poggi Marco
Scarica il programma completo

  1. unit modello;
  2.  
  3. interface
  4. uses crt, dos;
  5.  
  6.  function getchar:char;
  7.  procedure pausa(fr:string; linee:word);
  8.  procedure linea(s:char);
  9.  function exit_not(fr:string; p:char):boolean;
  10.  function intDomanda(f:string; l1,l2:longint):longint;
  11.  function realDomanda(f:string; l1,l2:double):double;
  12.  procedure CentraFrase(f:string; lin:word);
  13.  function CentraFrase(f:string; r:char; fine:word):string;
  14.  function tempo:double;
  15.  function numero(n:double; cifre,dec:byte):string;
  16.  function destra(fr:string; t:char; fine:word):string;
  17.  
  18. implementation
  19.  
  20. function getchar:char;
  21. begin
  22.  if keypressed then getchar:=readkey
  23.  else getchar:=chr(0);
  24. end;
  25.  
  26. procedure pausa(fr:string; linee:word);
  27. var i,fine:byte;
  28. begin
  29.  while linee>0 do
  30.  begin
  31.   writeln;
  32.   linee:=linee-1;
  33.  end;
  34.  // fine:=ord(fr[0]);
  35.  fine:=length(fr);
  36.  for i:=1 to fine do write(fr[i]);
  37.  write(' '+readkey);
  38. end;
  39.  
  40. procedure linea(s:char);
  41. var i:byte;
  42.  begin
  43.   writeln;
  44.   for i:=0 to 79 do  write(s);
  45. end;
  46.  
  47. function exit_not(fr:string; p:char):boolean;
  48. var r:char;
  49.  begin
  50.   write(fr);
  51.   r:=upcase(getchar);
  52.   p:=upcase(p);
  53.   writeln(r);
  54.   if r=p then exit_not:=true else exit_not:=false;
  55.   linea('-');
  56. end;
  57.  
  58. function intDomanda(f:string; l1,l2:longint):longint;
  59. begin
  60.  intDomanda:=trunc(realDomanda(f, l1, l2));
  61. end;
  62.  
  63. function realDomanda(f:string; l1,l2:double):double;
  64. var t:double;
  65.     num:string;
  66.     errore:integer;
  67.     ch:boolean;
  68. begin
  69.  repeat
  70.   write(f+' ');
  71.   readln(num);
  72.   val(num, t, errore);
  73.   if errore=0 then
  74.   begin
  75.    ch:=((t>=l1) and (t<=l2));
  76.    if not ch then
  77.    begin
  78.     writeln('Limiti ammessi { ',l1:8:3,' -> ',l2:8:3,' }');
  79.    end;
  80.   end
  81.   else
  82.   begin
  83.    writeln('Sono ammessi solo numeri!');
  84.    ch:=false;
  85.   end;
  86.  until ch;
  87.  realDomanda:=t;
  88. end;
  89.  
  90. procedure CentraFrase(f:string; lin:word);
  91. var l,x0:word;
  92. begin
  93.  l:=length(f);
  94.  x0:=(80-l) div 2;
  95.  gotoxy(x0,lin);
  96.  writeln(f);
  97. end;
  98.  
  99. function CentraFrase(f:string; r:char; fine:word):string;
  100. var stop,i:word;
  101. begin
  102.  if length(f)<fine then
  103.  begin
  104.   stop:=(fine div 2) - (length(f) div 2);
  105.   for i:=1 to stop do   f:=r+f;
  106.   while length(f)<fine do   f:=f+r;
  107.  end;
  108.  CentraFrase:=f;
  109. end;
  110.  
  111. function tempo:double;
  112. var h,m,s,cs:word;
  113. begin
  114.  GetTime(h, m, s, cs);
  115.  tempo:=3600.0 * (h+0.0) + 60.0*m + s + 0.01*cs;
  116. end;
  117.  
  118. function numero(n:double; cifre,dec:byte):string;
  119. var s:string;
  120. begin
  121.  str(n:cifre:dec, s);
  122.  numero:=s;
  123. end;
  124.  
  125. function destra(fr:string; t:char; fine:word):string;
  126. begin
  127.  while length(fr)<=fine do
  128.  begin
  129.   fr:=fr+t;
  130.  end;
  131.  destra:=fr;
  132. end;
  133.  
  134. begin
  135.  
  136. end.