Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue51/Alfresco/CvtSingleUnit.pas

Pascal/Delphi Source File | 1999-10-03 | 4.9 KB | 189 lines

unit CvtSingleUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function ConvertSingle(S : single) : string;
const
  RadixPoint = 40;
var
  L : longint absolute S;
  i, Inx   : integer;
  Carry    : integer;
  Sign     : char;
  FirstDigit, LastDigit : integer;
  Exponent : integer;
  MantStr  : string;
  Value    : array [0..255] of byte;
begin
  {extract out the sign, exponent and mantissa}
  if (L < 0) then
    Sign := '-'
  else
    Sign := '+';
  Exponent := (L shr 23) and $FF;
  L := L and $007FFFFF;

  {check for the special cases first: inf, nan, zero, denormal}
  if (Exponent = 0) then begin
    if (L = 0) then begin
      {it's zero}
      Result := Sign + '0.0';
      Exit;
    end;
    {it's a denormal}
    Exponent := -126 - 23;
  end
  else if (Exponent = 255) then begin
    if (L = 0) then begin
      {it's an infinity}
      Result := Sign + 'infinity';
      Exit;
    end;
    {it's a NaN}
    Result := 'NaN';
    Exit;
  end
  else {0 < Exponent < 255} begin
    {it's a normal value}
    L := L or $00800000;
    Exponent := Exponent - 127 - 23;
  end;

  {convert the mantissa to ASCII, and thence to our multiprecision
   array for multiplication with a suitable power of 2; the decimal
   point is assumed to be between elements [39] and [40]}
  MantStr := IntToStr(L);
  FillChar(Value, sizeof(Value), 0);
  Inx := RadixPoint;
  for i := length(MantStr) downto 1 do begin
    dec(Inx);
    Value[Inx] := ord(MantStr[i]) - (ord('0'));
  end;

  {if the exponent is less than 0, we have to multiply Value by a
   negative power of 2, ie dividing by a power of 2}
  if (Exponent < 0) then begin
    for i := 1 to -Exponent do begin
      for Inx := 0 to 255 do begin
        if Odd(Value[Inx]) then
          inc(Value[Inx+1], 10);
        Value[Inx] := Value[Inx] div 2;
      end;
    end;
  end

  {if the exponent is greater than 0, we have to multiply Value by a
   power of 2}
  else if (Exponent > 0) then begin
    for i := 1 to Exponent do begin
      Carry := 0;
      for Inx := 255 downto 0 do begin
        Value[Inx] := Value[Inx] * 2 + Carry;
        if (Value[Inx] < 10) then
          Carry := 0
        else begin
          Carry := 1;
          Value[Inx] := Value[Inx] - 10;
        end;
      end;
    end;
  end;

  {we now have our answer in the Value array; find the first and the
   last non-zero digits}
  FirstDigit := 255;
  for Inx := 0 to 255 do
    if (Value[Inx] <> 0) then begin
      FirstDigit := Inx;
      Break;
    end;

  LastDigit := 0;
  for Inx := 255 downto 0 do
    if (Value[Inx] <> 0) then begin
      LastDigit := Inx;
      Break;
    end;

  {to make sure we include a decimal point, make sure that the first
   digit index is prior to the decimal point, and the last digit index
   is after the decimal point; that way we can show 0.nnn and nnn.0}
  if (FirstDigit >= RadixPoint) then
    FirstDigit := RadixPoint - 1;
  if (LastDigit <= RadixPoint) then
    LastDigit := RadixPoint;

  {now convert the digits in the Value array to a string; note that
   the string will have LastDigit - FirstDigit + 1 digits, plus a
   sign, plus a decimal point}
  {$IFDEF Windows}
  Result[0] := char(LastDigit - FirstDigit + 3);
  {$ELSE}
  SetLength(Result, LastDigit - FirstDigit + 3);
  {$ENDIF}
  Result[1] := Sign;
  i := 2;
  for Inx := FirstDigit to LastDigit do begin
    if Inx = RadixPoint then begin
      Result[i] := '.';
      inc(i);
    end;
    Result[i] := char(Value[Inx] + ord('0'));
    inc(i);
  end;
end;

const
  LargestSingle = $7F7FFFFF;
  SmallestSingle = $00800000;
  SmallestDenormalSingle = $00000001;

procedure TForm1.Button1Click(Sender: TObject);
var
  s : single;
  l : longint absolute s;
begin
  l := SmallestDenormalSingle;
  Label1.Caption := ConvertSingle(s);
  Label2.Caption := FloattoStr(s);

  writeln('1         ', ConvertSingle(1.0));
  writeln('12        ', ConvertSingle(12.0));
  writeln('123       ', ConvertSingle(123.0));
  writeln('1234      ', ConvertSingle(1234.0));
  writeln('12345     ', ConvertSingle(12345.0));
  writeln('123456    ', ConvertSingle(123456.0));
  writeln('1234567   ', ConvertSingle(1234567.0));
  writeln('12345678  ', ConvertSingle(12345678.0));
  writeln('123456789 ', ConvertSingle(123456789.0));
  writeln('1/2       ', ConvertSingle(1.0/2.0));
  writeln('1/3       ', ConvertSingle(1.0/3.0));
  writeln('1/4       ', ConvertSingle(1.0/4.0));
  writeln('1/5       ', ConvertSingle(1.0/5.0));
end;

end.