home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pascal / tplib21.zip / INSTALL.EXE / STRINGS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-24  |  15KB  |  450 lines
  1. (*
  2.     TURBO PASCAL LIBRARY 2.1
  3.     STRINGS unit: Extended string-handling routines
  4. *)
  5.  
  6. UNIT STRINGS;
  7.  
  8. {$L SUCASE}
  9. {$L SUTRIM}
  10. {$L SUPAD}
  11. {$L SUTRUNC}
  12. {$L SUCNVRT}
  13. {$L SUMISC}
  14.  
  15. {$V-}
  16.  
  17. INTERFACE
  18.  
  19. TYPE
  20.     FormatConfigRec =   RECORD
  21.                             Fill,               { Symbol for padding }
  22.                             Currency,           { Floating currency sign }
  23.                             Overflow,           { Overflow indicator }
  24.                             FracSep:    CHAR;   { Int/frac seperator }
  25.                         END;
  26.  
  27.  
  28. CONST
  29.     UCaseLetters = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  30.     LCaseLetters = 'abcdefghijklmnopqrstuvwxyz';
  31.     Letters = UCaseLetters+LCaseLetters;
  32.     DecDigits = '0123456789';
  33.     HexDigits = '0123456789ABCDEF';
  34.     OctDigits = '01234567';
  35.     BinDigits = '01';
  36.  
  37.     { Format symbol record }
  38.     FormatConfig: FormatConfigRec =
  39.             (Fill: '*'; Currency: '$'; Overflow: '?'; FracSep: '-');
  40.  
  41.  
  42.  
  43. FUNCTION LoCase(ch: CHAR): CHAR;
  44. FUNCTION UpperCase(s: STRING): STRING;
  45. FUNCTION LowerCase(s: STRING): STRING;
  46. FUNCTION DuplChar(ch: CHAR; count: BYTE): STRING;
  47. FUNCTION DuplStr(s: STRING; count: BYTE): STRING;
  48. FUNCTION TrimL(s: STRING): STRING;
  49. FUNCTION TrimR(s: STRING): STRING;
  50. FUNCTION PadL(s: STRING; width: BYTE): STRING;
  51. FUNCTION PadR(s: STRING; width: BYTE): STRING;
  52. FUNCTION TruncL(s: STRING; width: BYTE): STRING;
  53. FUNCTION TruncR(s: STRING; width: BYTE): STRING;
  54. FUNCTION JustL(s: STRING; width: BYTE): STRING;
  55. FUNCTION JustR(s: STRING; width: BYTE): STRING;
  56. FUNCTION JustC(s: STRING; width: BYTE): STRING;
  57. FUNCTION Precede(s,target: STRING): STRING;
  58. FUNCTION Follow(s,target: STRING): STRING;
  59. FUNCTION Break(VAR s: STRING; d: STRING): STRING;
  60. FUNCTION Span(VAR s: STRING; d: STRING): STRING;
  61. FUNCTION Replace(s,srch,repl: STRING): STRING;
  62. FUNCTION Remove(s,srch: STRING): STRING;
  63. FUNCTION StripBit7(s: STRING): STRING;
  64. FUNCTION FileSpecDefault(s,path,name,extn: STRING): STRING;
  65. FUNCTION HexStr(n: WORD; count: BYTE): STRING;
  66. FUNCTION OctStr(n: WORD; count: BYTE): STRING;
  67. FUNCTION BinStr(n: WORD; count: BYTE): STRING;
  68. FUNCTION Format(n: REAL; form: STRING): STRING;
  69.  
  70.  
  71. IMPLEMENTATION
  72.  
  73. USES
  74.     DOS;
  75.  
  76.  
  77. FUNCTION LoCase(ch: CHAR): CHAR; EXTERNAL;
  78. FUNCTION UpperCase(s: STRING): STRING; EXTERNAL;
  79. FUNCTION LowerCase(s: STRING): STRING; EXTERNAL;
  80. FUNCTION DuplChar(ch: CHAR; count: BYTE): STRING; EXTERNAL;
  81.  
  82.  
  83. FUNCTION DuplStr(s: STRING; count: BYTE): STRING;
  84.  
  85.     VAR
  86.         ds: STRING;
  87.         i:  BYTE;
  88.  
  89.     BEGIN
  90.         ds:='';
  91.         FOR i:=1 TO count DO
  92.             ds:=CONCAT(ds,s);
  93.         DuplStr:=ds;
  94.     END;
  95.  
  96.  
  97. FUNCTION TrimL(s: STRING): STRING; EXTERNAL;
  98. FUNCTION TrimR(s: STRING): STRING; EXTERNAL;
  99. FUNCTION PadL(s: STRING; width: BYTE): STRING; EXTERNAL;
  100. FUNCTION PadR(s: STRING; width: BYTE): STRING; EXTERNAL;
  101. FUNCTION TruncL(s: STRING; width: BYTE): STRING; EXTERNAL;
  102. FUNCTION TruncR(s: STRING; width: BYTE): STRING; EXTERNAL;
  103.  
  104.  
  105. FUNCTION JustL(s: STRING; width: BYTE): STRING;
  106.  
  107.     BEGIN
  108.         JustL:=PadR(TruncR(TrimL(TrimR(s)),width),width);
  109.     END;
  110.  
  111.  
  112. FUNCTION JustR(s: STRING; width: BYTE): STRING;
  113.  
  114.     BEGIN
  115.         JustR:=PadL(TruncL(TrimL(TrimR(s)),width),width);
  116.     END;
  117.  
  118.  
  119. FUNCTION JustC(s: STRING; width: BYTE): STRING;
  120.  
  121.     BEGIN
  122.         s:=TruncR(TrimL(TrimR(s)),width);
  123.         IF LENGTH(s)>=width THEN
  124.             JustC:=s
  125.         ELSE
  126.             JustC:=PadR(CONCAT(DuplChar(#32,(width-LENGTH(s)) DIV 2),s),width);
  127.     END;
  128.  
  129.  
  130. FUNCTION Precede(s,target: STRING): STRING;
  131.  
  132.     VAR
  133.         i:  BYTE;
  134.  
  135.     BEGIN
  136.         i:=POS(target,s);
  137.         IF i=0 THEN             { Return entire string if target not found }
  138.             Precede:=s
  139.         ELSE
  140.             Precede:=COPY(s,1,i-1);
  141.     END;
  142.  
  143.  
  144. FUNCTION Follow(s,target: STRING): STRING;
  145.  
  146.     VAR
  147.         i:  BYTE;
  148.  
  149.     BEGIN
  150.         i:=POS(target,s);
  151.         IF i=0 THEN             { Return null string if target not found }
  152.             Follow:=''
  153.         ELSE
  154.             Follow:=COPY(s,i+LENGTH(target),255);
  155.     END;
  156.  
  157.  
  158. FUNCTION Break(VAR s: STRING; d: STRING): STRING;
  159.  
  160.     VAR
  161.         i,j:    BYTE;
  162.         f:      BOOLEAN;
  163.  
  164.     BEGIN
  165.         i:=0;                                   { Index to input string }
  166.         f:=FALSE;                               { Set when delim. found }
  167.         WHILE (i<LENGTH(s)) AND (NOT(f)) DO     { For each char. in input }
  168.             BEGIN
  169.                 INC(i);
  170.                 j:=1;                           { Index to delim. string }
  171.                 WHILE (j<=LENGTH(d)) AND (NOT(f)) DO { Scan for each delim. }
  172.                     IF s[i]=d[j] THEN
  173.                         f:=TRUE
  174.                     ELSE
  175.                         INC(j);
  176.             END;
  177.         IF NOT(f) THEN
  178.             INC(i);
  179.         Break:=COPY(s,1,i-1);           { Return sub-string up to delimiter }
  180.         s:=COPY(s,i,255);               { and remove from the input string }
  181.     END;
  182.  
  183.  
  184. FUNCTION Span(VAR s: STRING; d: STRING): STRING;
  185.  
  186.     VAR
  187.         i,j:    BYTE;
  188.         f:      BOOLEAN;
  189.  
  190.     BEGIN
  191.         i:=0;                               { Index to input string }
  192.         f:=FALSE;
  193.         WHILE (i<LENGTH(s)) AND (NOT(f)) DO { For each char. in input }
  194.             BEGIN
  195.                 INC(i);
  196.                 FOR j:=1 TO LENGTH(d) DO    { Check for specified chars. }
  197.                     IF s[i]=d[j] THEN
  198.                         f:=TRUE;
  199.                 f:=NOT(f);
  200.             END;
  201.         IF NOT(f) THEN
  202.             INC(i);
  203.         Span:=COPY(s,1,i-1);                { Return span of specified chrs }
  204.         s:=COPY(s,i,255);                   { and remove from the input }
  205.     END;
  206.  
  207.  
  208.  
  209. FUNCTION Replace(s,srch,repl: STRING): STRING;
  210.  
  211.     VAR
  212.         i,j:    BYTE;
  213.         f:      BOOLEAN;
  214.  
  215.     BEGIN
  216.         IF LENGTH(srch)>LENGTH(repl) THEN       { Ignore search chrs. }
  217.             srch[0]:=CHR(LENGTH(repl));         { without replacements }
  218.         FOR i:=1 TO LENGTH(s) DO                { For each char. in input }
  219.             BEGIN
  220.                 j:=1;
  221.                 f:=FALSE;                       { Scan all search characters }
  222.                 WHILE (j<=LENGTH(srch)) AND (NOT(f)) DO
  223.                     IF s[i]=srch[j] THEN
  224.                         BEGIN
  225.                             s[i]:=repl[j];      { Replace if found }
  226.                             f:=TRUE;
  227.                         END
  228.                     ELSE
  229.                         INC(j);
  230.             END;
  231.         Replace:=s;
  232.     END;
  233.  
  234.  
  235. FUNCTION Remove(s,srch: STRING): STRING;
  236.  
  237.     VAR
  238.         i,j:    BYTE;
  239.  
  240.     BEGIN
  241.         FOR i:=1 TO LENGTH(srch) DO     { For each search character }
  242.             REPEAT
  243.                 j:=POS(srch[i],s);      { Repeat search in input string & }
  244.                 IF j<>0 THEN            { delete if found until no more }
  245.                     DELETE(s,j,1);
  246.             UNTIL j=0;
  247.         Remove:=s;
  248.     END;
  249.  
  250.     
  251. FUNCTION StripBit7(s: STRING): STRING; EXTERNAL;
  252.  
  253.  
  254. FUNCTION FileSpecDefault(s,path,name,extn: STRING): STRING;
  255.  
  256.     VAR
  257.         d:  DirStr;
  258.         n:  NameStr;
  259.         e:  ExtStr;
  260.  
  261.     BEGIN
  262.         FSplit(s,d,n,e);        { Split file spec. into path, name, & ext. }
  263.         IF LENGTH(d)=0 THEN     { For each field, add default if none }
  264.             d:=path;
  265.         IF LENGTH(n)=0 THEN
  266.             n:=name;
  267.         IF LENGTH(e)=0 THEN
  268.             e:=extn;
  269.         FileSpecDefault:=CONCAT(d,n,e);
  270.     END;
  271.  
  272.  
  273. FUNCTION HexStr(n: WORD; count: BYTE): STRING; EXTERNAL;
  274. FUNCTION OctStr(n: WORD; count: BYTE): STRING; EXTERNAL;
  275. FUNCTION BinStr(n: WORD; count: BYTE): STRING; EXTERNAL;
  276.  
  277.  
  278. FUNCTION Format(n: REAL; form: STRING): STRING;
  279.  
  280.     VAR
  281.         s1,s2:                  STRING;
  282.         width,dp,sign,i,j:      BYTE;
  283.         pad,currency:           CHAR;
  284.         blank,zero,left,paren,
  285.         comma,adjust,reduce:    BOOLEAN;
  286.         x:                      INTEGER;
  287.  
  288.  
  289.     { Reduce fraction to lowest possible denominator }
  290.  
  291.     PROCEDURE ReduceFraction(VAR num,denom: BYTE);
  292.  
  293.         VAR
  294.             i:  BYTE;
  295.  
  296.         BEGIN
  297.             FOR i:=denom DOWNTO 2 DO
  298.                 IF ((num MOD i)=0) AND ((denom MOD i)=0) THEN
  299.                     BEGIN
  300.                         num:=num DIV i;
  301.                         denom:=denom DIV i;
  302.                     END;
  303.         END;  { ReduceFraction }
  304.  
  305.  
  306.     BEGIN  { Format }
  307.         form:=UpperCase(form);
  308.         s1:=Break(form,CONCAT(DecDigits,':'));      { Get leading options }
  309.         IF POS('A',s1)<>0 THEN                      { Absolute value, no sign }
  310.             n:=ABS(n);
  311.         blank:=POS('B',s1)<>0;                      { Blank if zero }
  312.         zero:=POS('Z',s1)<>0;                       { Zero-fill/zero-show }
  313.         left:=POS('L',s1)<>0;                       { Left justify }
  314.         comma:=(POS(',',s1)<>0) OR (POS('C',s1)<>0);    { Commas }
  315.         reduce:=POS('R',s1)=0;                      { No reduction }
  316.         paren:=POS('P',s1)<>0;                      { Negative in parenth. }
  317.         IF POS('+',s1)<>0 THEN                      { Check leading + }
  318.             sign:=1
  319.         ELSE
  320.             sign:=0;
  321.         IF POS('*',s1)<>0 THEN                      { Set fill character }
  322.             pad:='*'
  323.         ELSE
  324.             IF POS('F',s1)<>0 THEN
  325.                 pad:=FormatConfig.Fill
  326.             ELSE
  327.                 pad:=' ';
  328.         IF POS('$',s1)<>0 THEN                      { Set currency symbol }
  329.             currency:=FormatConfig.Currency
  330.         ELSE
  331.             currency:=#0;
  332.         s1:=Break(form,CONCAT('+- ',#9));           { Get width:decimals }
  333.         IF POS('-',form)<>0 THEN                    { Check trailing +/- sign }
  334.             sign:=3;
  335.         IF POS('+',form)<>0 THEN                    
  336.             sign:=2;
  337.  
  338.         s2:=Follow(s1,':');             { s2 is decimals }
  339.         s1:=Precede(s1,':');            { s1 is width }
  340.         VAL(s1,width,x);
  341.         IF x<>0 THEN                    { Default width 12 }
  342.             width:=12;
  343.         IF COPY(s2,1,1)='/' THEN        { Use vulgar fractions }
  344.             BEGIN
  345.                 n:=ABS(n);                          { Force absolute value }
  346.                 sign:=0;                            { Disable sign display }
  347.                 DELETE(s2,1,1);
  348.                 VAL(s2,i,x);
  349.                 IF (x<>0) OR (i<2) OR (i>99) THEN   { Default resolution 1/2 }
  350.                     i:=2;
  351.                 j:=ROUND(FRAC(n)/(1.0/i));          { Calculate fraction }
  352.                 adjust:=(j=i);                      { Allow for rounding }
  353.                 IF adjust THEN
  354.                     j:=0;
  355.                 IF reduce THEN                      { Reduce fraction }
  356.                     ReduceFraction(j,i);
  357.                 STR(j,s1);
  358.                 STR(i,s2);
  359.                 IF j=0 THEN                         { Format fraction }
  360.                     s2:=DuplChar(pad,6)
  361.                 ELSE
  362.                     BEGIN
  363.                         s2:=CONCAT(s1,'/',s2);
  364.                         IF (INT(n)=0) AND NOT(zero) THEN
  365.                             s2:=CONCAT(pad,s2)
  366.                         ELSE
  367.                             s2:=CONCAT(FormatConfig.FracSep,s2);
  368.                         s2:=CONCAT(s2,DuplChar(pad,6-LENGTH(s2)));
  369.                     END;
  370.                 IF (INT(n)=0) AND NOT(zero) AND (j<>0) THEN
  371.                     s1:=s2
  372.                 ELSE
  373.                     BEGIN                           { Format integral part }
  374.                         IF adjust THEN
  375.                             STR(INT(n)+1:0:0,s1)
  376.                         ELSE
  377.                             STR(INT(n):0:0,s1);
  378.                         s1:=CONCAT(s1,s2);
  379.                     END;
  380.                 zero:=FALSE;                        { Disable zero-fill }
  381.             END
  382.         ELSE
  383.             BEGIN                       { Use decimal fractions }
  384.                 VAL(s2,dp,x);               { Get number of decimal places }
  385.                 IF x<>0 THEN                { Default to zero decimals }
  386.                     dp:=0;
  387.                 STR(ABS(n):0:dp,s1);
  388.             END;
  389.  
  390.         IF comma THEN                   { Insert commas if necessary }
  391.             BEGIN
  392.                 s2:=Span(s1,DecDigits);
  393.                 i:=(LENGTH(s2)-1) DIV 3;    { i is no. of commas to insert }
  394.                 FOR j:=1 TO i DO
  395.                     INSERT(',',s2,LENGTH(s2)-(j-1)-(j*3-1));
  396.                 s1:=CONCAT(s2,s1);
  397.             END;
  398.         IF currency<>#0 THEN            { Add floating currency symbol }
  399.             s1:=CONCAT(currency,s1);
  400.         IF paren THEN                   { Add signs as required }
  401.             BEGIN
  402.                 IF n<0 THEN
  403.                     s1:=CONCAT('(',s1,')')
  404.                 ELSE
  405.                     IF NOT(left) THEN
  406.                         s1:=CONCAT(s1,' ');
  407.             END
  408.         ELSE
  409.             CASE sign OF
  410.                 0:  IF n<0 THEN                 { Leading - }
  411.                         s1:=CONCAT('-',s1);
  412.                 1:  IF n<0 THEN                 { Leading + }
  413.                         s1:=CONCAT('-', s1)
  414.                     ELSE
  415.                         s1:=CONCAT('+',s1);
  416.                 2:  IF n<0 THEN                 { Trailing + }
  417.                         s1:=CONCAT(s1,'-')
  418.                     ELSE
  419.                         s1:=CONCAT(s1,'+');
  420.                 3:  IF n<0 THEN                 { Trailing - }
  421.                         s1:=CONCAT(s1,'-')
  422.                     ELSE
  423.                         IF NOT(left) THEN
  424.                             s1:=CONCAT(s1,' ');
  425.             END;
  426.         WITH FormatConfig DO
  427.             IF LENGTH(s1)>width THEN            { Check for field overflow }
  428.                 Format:=DuplChar(Overflow,width)
  429.             ELSE
  430.                 IF blank AND
  431.                 (LENGTH(Remove(s1,CONCAT('0. ()+-*',Fill,Currency)))=0) THEN
  432.                     Format:=DuplChar(#32,width) { Blank if rounded=zero }
  433.                 ELSE
  434.                     IF zero THEN                { Pad field to width }
  435.                         BEGIN
  436.                             s2:=Break(s1,DecDigits);
  437.                             Format:=CONCAT(s2,DuplChar('0',
  438.                                         width-(LENGTH(s2)+LENGTH(s1))),s1);
  439.                         END
  440.                     ELSE
  441.                         IF left THEN
  442.                             Format:=CONCAT(s1,DuplChar(pad,width-LENGTH(s1)))
  443.                         ELSE
  444.                             Format:=CONCAT(DuplChar(pad,width-LENGTH(s1)),s1);
  445.     END;  { Format }
  446.  
  447.  
  448. END.
  449.  
  450.