home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-LA1.LBR / PRINTUSG.IQC / PRINTUSG.INC
Text File  |  2000-06-30  |  2KB  |  56 lines
  1. {PRINTUSG.INC}
  2. PROCEDURE PrintUsing ( Mask : String80; Number : real; Out : char);
  3.  
  4.     {This procedure emulates the PRINT USING routine available in many
  5.     versions of MicroSoft BASIC.
  6.  
  7.     Author: Bill Collins
  8.     Application: CP/M-80, CP/M-86, MS-DOS, PC-DOS
  9.     Enhanced by: L. L. Smith; 2827 Klusner Ave.; Parma, OH 44134
  10.                  added ability to print to screen or list device
  11.                  depending on passed parameter.}
  12.  
  13.     const
  14.          Comma      : char = ',';
  15.          Point      : char = '.';
  16.          MinusSign  : char = '-';
  17.  
  18.     var
  19.          FieldWidth, IntegerLength, I, J, Places, PointPosition : integer;
  20.          UsingCommas, Decimal, Negative                         : boolean;
  21.          OutString, IntegerString                               : String80;
  22.  
  23.     Begin
  24.         Negative    := Number < 0;
  25.         Number      := abs ( Number );
  26.         Places      := 0;
  27.         FieldWidth  := length ( Mask );
  28.         UsingCommas := pos ( Comma, Mask ) > 0;
  29.         Decimal     := pos ( Point, Mask ) > 0;
  30.         If Decimal then
  31.             begin
  32.                 PointPosition := pos ( Point, Mask );
  33.                 Places        := FieldWidth - PointPosition;
  34.             end;
  35.         Str ( Number : 0 : Places, OutString );
  36.         If UsingCommas then
  37.             begin
  38.                 J             := 0;
  39.                 IntegerString := copy ( OutString, 1, length ( OutString ) - Places );
  40.                 IntegerLength := length ( IntegerString );
  41.                 If Decimal then
  42.                     IntegerLength := IntegerLength - 1;
  43.                 For I := IntegerLength downto 2 do
  44.                     begin
  45.                         J := J + 1;
  46.                         If J mod 3 = 0 then
  47.                             Insert ( Comma, OutString, I )
  48.                     end
  49.                 end;
  50.         If Negative then
  51.             OutString := MinusSign + OutString;
  52.         If UpCase(Out) = 'S'
  53.             Then Write ( OutString : FieldWidth + 1 )
  54.         Else
  55.             Write (Lst, OutString : FieldWidth + 1);
  56.     End; (* PrintUsing *)