home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FORM.ZIP / _FORM.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-11-18  |  4.8 KB  |  151 lines
  1. UNIT _Form;
  2. { Written to take the place of the FORM FUNCTION in Turbo 3.0 with BCD covers }
  3. { most of the 3.0 Function - November 1987 - Paul Mayer CIS [70040,645] }
  4.  
  5. INTERFACE
  6.  
  7. USES CRT;
  8.  
  9.  
  10. FUNCTION Form(Picture : STRING; Number : Real) : STRING;
  11.   { Pseudo form function }
  12.  
  13.   IMPLEMENTATION
  14.  
  15.   FUNCTION Form;
  16.     { Pseudo form function }
  17.  
  18.   VAR
  19.     Position, Dollar, Comma, Comma2, Star_Position,
  20.     Zero_Position, Start_Length, Picture_Length : Word;
  21.     Temp_Picture, Temp_Number : STRING[80];
  22.  
  23.     FUNCTION RealToString(Num : Real; Len, Places : Word) : STRING;
  24.       { Changes a real to a string }
  25.     VAR
  26.       S : STRING[80];
  27.     BEGIN
  28.       Str(Num:Len:Places, S);
  29.       RealToString := S;
  30.     END;                      { RealToString }
  31.  
  32.     FUNCTION Strip(S : STRING) : STRING;
  33.       { Strips our number of spaces so we know how big it is }
  34.     VAR
  35.       I : Word;
  36.       Store : STRING;
  37.     BEGIN
  38.       Store := '';
  39.       FOR I := 1 TO Length(S) DO
  40.         IF S[I] <> ' ' THEN Store := Store+S[I];
  41.       Strip := Store;
  42.     END;                      { Strip }
  43.  
  44.     FUNCTION Add_Dollar(S : STRING) : STRING;
  45.       { Puts dollar sign in figure }
  46.     VAR
  47.       I : Word;
  48.       Store : STRING;
  49.     BEGIN
  50.       Store := '';
  51.       FOR I := 1 TO Length(S) DO
  52.         IF S[I] = ' ' THEN Store := Store+S[I];
  53.       Store := Store+'$'+Copy(S, Length(Store)+1,
  54.       Length(S)-Length(Store));
  55.       Add_Dollar := Copy(Store, 2, Length(Store));
  56.     END;                      { Add_Dollar }
  57.  
  58.     FUNCTION Insert_Stars(S : STRING) : STRING;
  59.  
  60.     BEGIN
  61.       WHILE Pos(' ', S) > 0 DO
  62.         S[Pos(' ', S)] := '*';
  63.       Insert_Stars := S;
  64.     END;                      { Insert_Stars }
  65.  
  66.     FUNCTION Insert_Zeros(S : STRING) : STRING;
  67.  
  68.     BEGIN
  69.       WHILE Pos(' ', S) > 0 DO
  70.         S[Pos(' ', S)] := '0';
  71.       Insert_Zeros := S;
  72.     END;                      { Insert_Zeros }
  73.  
  74.   BEGIN
  75.     Position := Pos('#', Picture);
  76.     Star_Position := Pos('*', Picture);
  77.     Zero_Position := Pos('@', Picture);
  78.     IF Zero_Position > 0 THEN
  79.       BEGIN
  80.         IF ((Zero_Position > 0) AND (Zero_Position < Position)) OR
  81.         ((Zero_Position > 0) AND (Position = 0))
  82.         THEN Position := Zero_Position;
  83.       END
  84.     ELSE
  85.       BEGIN
  86.         IF ((Star_Position > 0) AND (Star_Position < Position)) OR
  87.         ((Star_Position > 0) AND (Position = 0))
  88.         THEN Position := Star_Position;
  89.       END;
  90.     Temp_Picture := Copy(Picture, 1, Position-1);
  91.     Dollar := Pos('$', Temp_Picture);
  92.     Delete(Picture, 1, Position-1);
  93.     Picture_Length := Length(Picture);
  94.     IF Dollar = Length(Temp_Picture) THEN
  95.       Delete(Temp_Picture, Dollar, 1);
  96.     Comma := Pos(',', Picture);
  97.     Comma2 := Pos(',', Copy(Picture, Comma+1, 5));
  98.     Position := Pos('.', Picture);
  99.     IF Dollar > 0 THEN
  100.       BEGIN
  101.         Picture_Length := Picture_Length+1;
  102.         Position := Position+1;
  103.       END;
  104.     Start_Length := Picture_Length;
  105.     IF Position > 0 THEN
  106.       Temp_Number := RealToString(Number, Picture_Length,
  107.       Picture_Length-Position)
  108.     ELSE
  109.       BEGIN
  110.         Temp_Number := RealToString(Number, Picture_Length, 0)
  111.       END;
  112.     IF Picture_Length < 11 THEN
  113.       BEGIN
  114.         IF ((Comma > 0) AND (Length(Strip(Temp_Number)) > 6)) THEN
  115.           Insert(',', Temp_Number, Pos('.', Temp_Number)-3);
  116.       END
  117.     ELSE IF Picture_Length > 10 THEN
  118.       BEGIN
  119.         IF ((Comma > 0) AND (Length(Strip(Temp_Number)) > 6)) THEN
  120.           Insert(',', Temp_Number, Pos('.', Temp_Number)-3);
  121.         IF ((Comma2 > 0) AND (Length(Strip(Temp_Number)) > 10)) THEN
  122.           Insert(',', Temp_Number, Pos('.', Temp_Number)-7);
  123.         IF ((Comma > 0) AND (Length(Strip(Temp_Number)) < 12)) THEN
  124.           Insert(' ', Temp_Number, 1);
  125.         IF ((Comma > 0) AND (Length(Strip(Temp_Number)) < 8)) THEN
  126.           Delete(Temp_Number, 1, 1);
  127.       END;
  128.     IF Dollar > 0 THEN Temp_Number := Add_Dollar(Temp_Number);
  129.     IF ((Comma > 0) AND (Copy(Temp_Number, 1, 1) = ' ')) THEN
  130.       Delete(Temp_Number, 1, 1);
  131.     IF ((Comma2 > 0) AND (Copy(Temp_Number, 1, 1) = ' ')) THEN
  132.       Delete(Temp_Number, 1, 1);
  133.     IF (Comma > 0) AND (Pos(',', Temp_Number) = 0) THEN
  134.       Insert(' ', Temp_Number, 1);
  135.     IF (Comma2 > 0) AND (Comma > 0) AND (Pos(',', Temp_Number) = 0) THEN
  136.       Insert(' ', Temp_Number, 1);
  137.     IF ((Dollar > 0) AND (Copy(Temp_Number, 1, 1) = ' ')) THEN
  138.       BEGIN
  139.         Start_Length := Start_Length+1;
  140.       END;
  141.     IF Zero_Position > 0 THEN Temp_Number := Insert_Zeros(Temp_Number)
  142.     ELSE
  143.       IF Star_Position > 0 THEN Temp_Number := Insert_Stars(Temp_Number);
  144.     Form := Temp_Picture+Temp_Number;
  145.     IF Length(Temp_Number) > Start_Length THEN
  146.       FORM := Temp_Picture+Copy('********************************',
  147.       1, Start_Length);
  148.   END;                        { Pseudo form function }
  149.  
  150.   END.
  151.