home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB20.ZIP / FMT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-01-19  |  7.8 KB  |  195 lines
  1. program fmt;
  2.  
  3. TYPE
  4.   STRING20 = STRING[20];
  5.  
  6. { *************************************************************************** }
  7.  
  8. {   Turbo  function to format real numbers for report output                  }
  9.  
  10. { *************************************************************************** }
  11.  
  12. function fmt ( source : real; mask : string20 ) : string20;
  13.  
  14. {  This function will format a subject real or integer number into a format  }
  15. {  as defined by the mask.                                                   }
  16.  
  17. {  9  A digit position of the number, where leading zeroes are output as '0' }
  18. {  Z  A digit position of the number, where leading zeroes are output as ' ' }
  19. {  *  A digit position of the number, where leading zeroes are output as '*' }
  20. {  V  Specifies alignment of the decimal point.  If a V is not present, it   }
  21. {         is assumed the decimal is to be at the far right                   }
  22. {  $  A digit position of the number.  If more than one '$' appears, the     }
  23. {         the digit position closest to the first non-zero digit of the      }
  24. {         number is output as a '$'.  Leading zeroes are output as spaces.   }
  25. {  ,  A comma appearing before the leading digit is output as a space,       }
  26. {         dollar sign, or asterick depending upon the mask.                  }
  27. {  ' ' All other characters are output unchanged.                            }
  28.  
  29. {  A negative real number and a mask with leading '9's will inbed the        }
  30. {         negative sign in the output number.                                }
  31.  
  32. {  If there are insufficient significant digits in the mask to format the    }
  33. {         number the entire field will be returned filled with '?'.          }
  34.  
  35. var
  36.   count,decimals,
  37.   length_of_mask,
  38.   significant_digit,
  39.   source_position            : integer;
  40.   work_str,
  41.   source_str                 : string20;
  42.   leading_zero,
  43.   floating_dollar,
  44.   decimal_flag               : boolean;
  45.   limit                      : real;
  46.  
  47. begin
  48.   decimals          := 0;
  49.   significant_digit := 0;
  50.   limit             := 1;
  51.   floating_dollar   := false;
  52.   decimal_flag      := false;
  53.   leading_zero      := true;
  54.   length_of_mask    := length(mask);
  55.   for count := 1 to length_of_mask do
  56.     begin
  57.       case mask [count] of
  58.           'V' : begin
  59.                   significant_digit := succ(significant_digit);
  60.                   decimal_flag := true;
  61.                 end;
  62.           '9' : begin
  63.                   significant_digit := succ(significant_digit);
  64.                   if decimal_flag then
  65.                       decimals := succ(decimals);
  66.                 end;
  67.           'Z' : begin
  68.                   significant_digit := succ(significant_digit);
  69.                   if decimal_flag then
  70.                       decimals := succ(decimals);
  71.                 end;
  72.           '*' : begin
  73.                   significant_digit := succ(significant_digit);
  74.                   if decimal_flag then
  75.                       decimals := succ(decimals);
  76.                 end;
  77.           '$' : begin
  78.                   floating_dollar   := true;
  79.                   significant_digit := succ(significant_digit);
  80.                   if decimal_flag then
  81.                       decimals := succ(decimals);
  82.                 end;
  83.       end;
  84.     end;
  85.   for count := 1 to significant_digit - decimals - 1 do
  86.       limit := limit * 10;
  87.   if not decimal_flag then
  88.       limit := limit * 10;
  89.   if source < 0 then
  90.       limit := limit / 10;
  91.   if abs(source) >= limit then
  92.       fillchar(work_str,20,'?')
  93.   else
  94.     begin
  95.       fillchar(work_str,20,' ');
  96.       str(source:significant_digit:decimals,source_str);
  97.       source_position := significant_digit;
  98.       for count := 1 to significant_digit do
  99.         begin
  100.           if leading_zero and (source_str[count] = '0') then
  101.                source_str[count] := ' ';
  102.           if leading_zero and (source_str[count] = '.') then
  103.                leading_zero := false;
  104.           if source_str[count] in ['1'..'9'] then
  105.                leading_zero := false;
  106.        end;
  107.      for count :=  length_of_mask downto 1 do
  108.        begin
  109.          case mask [count] of
  110.              '9' : begin
  111.                      if source_str [source_position] = ' ' then
  112.                          work_str [count] := '0'
  113.                      else
  114.                          work_str [count] := source_str [source_position];
  115.                      source_position := pred(source_position);
  116.                    end;
  117.              'Z' : begin
  118.                      if source_str [source_position] = ' ' then
  119.                          work_str [count] := ' '
  120.                      else
  121.                          work_str [count] := source_str [source_position];
  122.                      source_position := pred(source_position);
  123.                    end;
  124.              ',' : begin
  125.                      if source_str [source_position] <> ' ' then
  126.                          if source_str [source_position] = '-' then
  127.                            begin;
  128.                              work_str [count] := '-';
  129.                              source_str [source_position] := ' ';
  130.                            end
  131.                          else
  132.                              work_str [count] := ','
  133.                      else
  134.                          case mask [count-1] of
  135.                              '9' : work_str [count] := ',';
  136.                              'Z' : work_str [count] := ' ';
  137.                              ',' : work_str [count] := ',';
  138.                              'V' : work_str [count] := '0';
  139.                              '*' : work_str [count] := '*';
  140.                              '$' : begin
  141.                                      if floating_dollar then
  142.                                          work_str [count] := '$'
  143.                                      else
  144.                                          work_str := ' ';
  145.                                          floating_dollar := false;
  146.                                    end;
  147.                          end;
  148.                    end;
  149.              'V' : begin
  150.                      work_str [count] := '.';
  151.                      source_position := pred(source_position);
  152.                    end;
  153.              '*' : begin
  154.                      if source_str [source_position] = ' ' then
  155.                          work_str [count] := '*'
  156.                      else
  157.                          work_str [count] := source_str [source_position];
  158.                      source_position := pred(source_position);
  159.                    end;
  160.              '$' : begin
  161.                      if (source_str [source_position] = ' ') and floating_dollar then
  162.                        begin
  163.                          floating_dollar := false;
  164.                          work_str [count] := '$'
  165.                        end
  166.                      else
  167.                          work_str [count] := source_str [source_position];
  168.                      source_position := pred(source_position);
  169.                    end;
  170.              '!'..'~' :                    { this will bypass previous finds }
  171.                      work_str [count] := mask [count];
  172.            end;
  173.        end;
  174.     end;
  175.   work_str [0] := chr(length_of_mask);
  176.   fmt := work_str;
  177. end;
  178.  
  179. { END OF FUNCTION FMT(real,mask); ******************************************* }
  180.  
  181. begin
  182.  writeln(fmt(12345.67,'         ZZ,ZZZ'));
  183.  writeln(fmt(12345.67,'      ZZ,ZZZV99'));
  184.  writeln(fmt(12345.67,'      ZZ,ZZZV9 '));
  185.  writeln(fmt(12345.67,'      ZZ,ZZZV99'));
  186.  writeln(fmt(12345.67,'        $$$,ZZZ'));
  187.  writeln(fmt(12345.67,'AMT   $$$$$$V99'));
  188.  writeln(fmt(12345.67,' $$$,$$$,$$$V99'));
  189.  writeln(fmt(12345.67,' ***,***,***V99'));
  190.  writeln(fmt(12345.67,'      Z Z Z Z Z'));
  191.  writeln(fmt(12345.67,'NUMBER -  ZZZZZ'));
  192.  writeln(fmt(12345.67,'        Z-ZZ-ZZ'));
  193.  writeln(fmt(12345.67,'    999 999 999'));
  194.  writeln(fmt(12345.67,'  NO DIGITS!   '));
  195. END.