home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / REALST.ZIP / REALSTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-05  |  5.3 KB  |  105 lines
  1. (******************************************************************************
  2.  RealStr.PAS - Routine which formats a double, real or single number to a
  3.                requested number of significant digits.
  4.  Author      - Richard Mullen    CIS 76566,1325
  5.  Date        - 7/5/90, Released to public domain
  6. ******************************************************************************)
  7. {$R+}    { Range checking on               }
  8. {$B-}    { Boolean complete evaluation off }
  9. {$S-}    { Stack checking off              }
  10. {$I-}    { I/O checking off                }
  11. {$V-}    { Relaxed variable checking       }
  12. {$N+}     { Numeric coprocessor             }
  13. {$E+}     { Numeric coprocessor emulation   }
  14.  
  15. UNIT RealStr;
  16.  
  17. INTERFACE
  18.  
  19. function  RealToString  (SigDigits : word; Number : double) : string;
  20.  
  21.                        { SigDigits should be between 2 and 15 for doubles }
  22.                        {                             2 and 11 for reals   }
  23.                        {                             2 and  7 for singles }
  24.  
  25. IMPLEMENTATION
  26.  
  27. (*****************************************************************************)
  28.  
  29. function  RealToString  (SigDigits : word; Number : double) : string;
  30. var
  31. i             : integer;
  32. ErrorCode     : integer;
  33. E_Value       : integer;
  34. E_Position    : word;
  35. Exponent      : string[4];
  36. SDigits       : word;
  37. TempString    : string;
  38.    begin
  39. (*
  40.    if SigDigits > 15 then SigDigits := 15;      { 15 for double, 11 for real, }
  41.    if SigDigits < 2 then SigDigits  := 2;       {  7 for single               }
  42. *)
  43.    str (Number, TempString);
  44.    delete (TempString, 3, 1);                        { Delete decimal point   }
  45.    E_Position := pos ('E', TempString);
  46.    val (copy (TempString, E_Position + 1, 5), E_Value, ErrorCode);
  47.    RealToString := '';
  48.    if ErrorCode <> 0 then exit;                      { E_Value = exponent     }
  49.    delete (TempString, E_Position, 6);               { Delete exponent string }
  50.                                                      {  from TempString       }
  51.    if SigDigits + 2 < E_Position then
  52.       begin                                          {  Round TempString      }
  53.       insert ('0', TempString, 2);                   { Insert 0 for overflow  }   E_Position := pos ('E', TempString);
  54.       if TempString[SigDigits + 3] >='5' then                                {}
  55.          inc (TempString[SigDigits + 2]);                                    {}
  56.       for i := SigDigits + 2 downto 2 do                                     {}
  57.          if TempString [i] = chr (ord ('9') + 1) then                        {}
  58.             begin                                                            {}
  59.             TempString [i] := '0';                                           {}
  60.             inc (TempString [i - 1]);                                        {}
  61.             end;                                                             {}
  62.       if TempString[2] = '0' then delete (TempString, 2, 1) { <-- no overflow }
  63.       else inc (E_Value);                                   { <-- overflow    }
  64.       end;                                                                   {}
  65.                                                      { Delete extra precision }
  66.    delete (TempString, SigDigits + 2, length (TempString));
  67.  
  68.    i := length (TempString);                           { Remove all trailing  }
  69.    while (TempString[i] = '0') AND (i > 2) do          {  zeros, leaving only }
  70.       begin                                            {  significant digits  }
  71.       delete (TempString, i, 1);                                             {}
  72.       dec (i);                                                               {}
  73.       end;                                                                   {}
  74.  
  75.    SDigits := length (TempString) - 1;         { Number of significant digits }
  76.  
  77.    if (E_Value >= SigDigits) OR (SDigits - E_Value - 1 > SigDigits) then
  78.       begin                                             { Scientific notation }
  79.       if SDigits > 1 then insert ('.', TempString, 3);                       {}
  80.       str (E_Value, Exponent);                                               {}
  81.       TempString := Tempstring + ' E' + Exponent;                            {}
  82.       end                                                                    {}
  83.    else
  84.       begin
  85.       if E_Value >= 0 then                             { Exponent is positive }
  86.          begin                                         { |Number|, >= 1, can  }
  87.          for i := 1 to E_Value - SDigits + 1 do        {  be displayed with   }
  88.             TempString := TempString + '0';            {  no exponent         }
  89.          if E_Value < SDigits - 1 then insert ('.', TempString, E_Value + 3);
  90.          end
  91.       else
  92.          begin                                         { Exponent is negative }
  93.          for i := 1 to - E_Value - 1 do                { |Number|, < 1,  can  }
  94.             insert ('0', TempString, 2);               {  be displayed with   }
  95.          insert ('0.', TempString, 2);                 {  no exponent         }
  96.          end;                                          { Add '0.' to number   }
  97.       end;
  98.  
  99.    RealToString := TempString;
  100.    end;
  101.  
  102. (************************   No initialization   ******************************)
  103.  
  104. begin
  105. end.