home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / strings.swg / 0021_Format Number Strings.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-16  |  2.6 KB  |  103 lines
  1.  
  2. Uses DOS, Crt;
  3.  
  4. VAR S : String;
  5.  
  6. function CommaString (number : longint) : string;
  7.   var
  8.     TempStr : string;
  9.     OrgLen : byte;
  10.   begin
  11.     Str (number, tempstr);
  12.     OrgLen := Length (tempstr);
  13.     if OrgLen > 3 then
  14.       begin
  15.         if OrgLen < 7 then
  16.           Insert (',', tempstr, Length (tempstr) - 2);
  17.         if OrgLen >= 7 then
  18.           begin
  19.             Insert (',', tempstr, length (tempstr) - 5);
  20.             Insert (',', tempstr, length (tempstr) - 2);
  21.           end;
  22.       end;
  23.     CommaString := tempstr;
  24.   end;
  25.  
  26. FUNCTION FmtStr (STR, Fmt : STRING) : STRING;
  27. VAR
  28. TempStr : STRING;
  29. I, J : BYTE;
  30. BEGIN
  31. TempStr := '';
  32.  
  33.     IF (POS (',', Fmt) > 0) THEN
  34.     BEGIN
  35.     FmtStr := STR;
  36.     IF LENGTH (STR) <= 3 THEN EXIT;
  37.     J := 0;
  38.     FOR I := LENGTH (STR) DOWNTO 1 DO
  39.         BEGIN
  40.         TempStr := STR [i] + TempStr;
  41.         INC (j);
  42.         IF (J MOD 3 = 0) AND (TempStr[1] <> '.') THEN TempStr := ',' + TempStr;
  43.         END;
  44.  
  45.     WHILE TempStr [1] = ',' DO
  46.           TempStr := COPY (TempStr, 2, LENGTH (TempStr) );
  47.     END ELSE
  48.         BEGIN
  49.         J := 0;
  50.         FOR I := 1 TO LENGTH (Fmt) DO
  51.         BEGIN
  52.             IF NOT (Fmt [I] IN ['#', '!', '@', '*']) THEN
  53.             BEGIN
  54.                 TempStr [I] := Fmt [I] ;  {force any none format charcters into string}
  55.                  J := SUCC (J);
  56.             END
  57.             ELSE    {format character}
  58.             BEGIN
  59.                 IF I - J <= LENGTH (STR) THEN
  60.                    TempStr [I] := STR [I - J]
  61.                 ELSE
  62.                    TempStr [I] := ' ';    {pad with underlines}
  63.             END;
  64.         END;
  65.  
  66.         TempStr [0] := CHAR (LENGTH (Fmt) );  {set initial byte to string length}
  67.         END;
  68.  
  69.     FmtStr := Tempstr;
  70.  
  71. END;  {Func FmtStr}
  72.  
  73. FUNCTION FmtReal(Num : REAL; FMT : STRING) : STRING;
  74. VAR Tmp : STRING;
  75. BEGIN
  76.   STR (Num : 12 : 2, Tmp);
  77.   WHILE (NOT (Tmp[1] in ['0'..'9','.'])) AND (Tmp > '') DO DELETE(Tmp,1,1);
  78.   FmtReal := FmtStr(Tmp, FMT);
  79. END;
  80.  
  81. (*
  82.  
  83. Hi boys,
  84.  
  85. These routines are fairly simple to understand and should work for you in
  86. in just about any situation.  I've used them for years, and I've found
  87. them to be the answer to all my needs.
  88.  
  89. If you need more help with these, just call !!
  90.  
  91. Gayle
  92. *)
  93.  
  94.  
  95.  
  96. BEGIN
  97. ClrScr;
  98. WriteLn(CommaString(123456789));   { Format any type of INTEGER }
  99. WriteLn(FmtReal(1234567.89,'##,###,###,###.##'));  { Format Type REAL with decimals }
  100. WriteLn(FmtStr('2198758811','(###) ###-####')); { Format a Phone number }
  101. WriteLn(FmtStr('062593','##/##/##')); { Format a date number }
  102. Readkey;
  103. END.