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
Kelvin - LeggiNumeri.pas

LeggiNumeri.pas

Caricato da: Poggi Marco
Scarica il programma completo

  1. unit LeggiNumeri;
  2.  
  3. interface
  4.  
  5. function tasto(fr:string; t:char):string;
  6. function ANumero(fr:string; fallito:double=0.0):double;
  7. function AStringa(x:double; cif:word=0; dec:word=0):string;
  8. function secondi:double;
  9.  
  10. implementation
  11. uses sysutils;
  12.  
  13. function VerificaVirgola(fr:string):boolean;
  14. var ch:boolean;
  15.     i:word;
  16. begin
  17.  i:=1;
  18.  ch:=true;
  19.  while i<=length(fr) do
  20.  begin
  21.    if (fr[i]=',') or (fr[i]='.') then ch:=false;
  22.    i:=i+1;
  23.  end;
  24.  VerificaVirgola:=ch;
  25. end;
  26.  
  27. function tasto(fr:string; t:char):string;
  28.  
  29. begin
  30.   case t of
  31.     '1'..'9': fr:=fr+t;
  32.     '0'     : begin
  33.                 if fr<>'' then fr:=fr+t;
  34.               end;
  35.     ',', '.':begin
  36.                  if VerificaVirgola(fr) then fr:=fr + ',';
  37.                  if fr[1]=',' then fr:='0'+fr;
  38.              end;
  39.     '-'      :begin
  40.                  if fr='' then fr:=''
  41.                  else
  42.                  begin
  43.                    if fr[1]='-' then delete(fr, 1, 1)
  44.                    else fr:='-' + fr;
  45.                  end;
  46.               end;
  47.     char(8)  :begin
  48.                 delete(fr, length(fr), 1);
  49.              end;
  50.   end;
  51.   tasto:=fr;
  52. end;
  53.  
  54. function ANumero(fr:string; fallito:double=0.0):double;
  55. var errore:integer;
  56.     x:double;
  57. begin
  58.   val(fr, x, errore);
  59.   if errore>0 then x:=fallito;
  60.   ANumero:=x;
  61. end;
  62.  
  63. function AStringa(x:double; cif:word=0; dec:word=0):string;
  64. var risultato:string;
  65. begin
  66.   str(x:cif:dec, risultato);
  67.   AStringa:=risultato;
  68. end;
  69.  
  70. function secondi:double;
  71. var h,m,s,cs:word;
  72. begin
  73.   DecodeTime(Time, h,m,s,cs);
  74.   secondi:=3600.0*h + 60.0*m + s + 0.001*cs;
  75. end;
  76.  
  77. end.