Subversion Repositories oidplus

Rev

Rev 740 | Rev 748 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit VTSFUNCS;
  2.  
  3. (************************************************)
  4. (* VTSFUNCS.PAS                                 *)
  5. (* Author:   Daniel Marschall                   *)
  6. (* Revision: 2022-02-14                         *)
  7. (* License:  Apache 2.0                         *)
  8. (* This file contains:                          *)
  9. (* - Various functions                          *)
  10. (************************************************)
  11.  
  12. interface
  13.  
  14. function Max(a, b: integer): integer;
  15. function Min(a, b: integer): integer;
  16.  
  17. function CompareEqualLengthString(a, b: string): integer;
  18. function CompareNumericString(a, b: string): integer;
  19.  
  20. procedure Beep;
  21.  
  22. function Trim(s: string): string;
  23. function TrimLineToWidth(s: string; width: integer): string;
  24. function ZeroPad(i: LongInt; n: integer): string;
  25. function LeftPadStr(s: string; n: integer; ch: char): string;
  26. function RightPadStr(s: string; n: integer; ch: char): string;
  27. function RepeatStr(ch: char; n: integer): string;
  28.  
  29. function DeleteFile(filename: string): boolean;
  30. function FileExists(filename: string): boolean;
  31.  
  32. function IsPositiveInteger(s: string): boolean;
  33. function StrToInt(s: string): Integer;
  34. function IntToStr(Value: Integer): string;
  35.  
  36. implementation
  37.  
  38. uses
  39.   Crt;
  40.  
  41. function Max(a, b: integer): integer;
  42. begin
  43.   if a > b then
  44.     Max := a
  45.   else
  46.     Max := b;
  47. end;
  48.  
  49. function Min(a, b: integer): integer;
  50. begin
  51.   if a < b then
  52.     Min := a
  53.   else
  54.     Min := b;
  55. end;
  56.  
  57. function CompareEqualLengthString(a, b: string): integer;
  58. var
  59.   ao, bo, i: integer;
  60. begin
  61.   CompareEqualLengthString := 0;
  62.   for i := 1 to Length(a) do
  63.   begin
  64.     ao := Ord(a[i]);
  65.     bo := Ord(b[i]);
  66.     if ao > bo then
  67.     begin
  68.       CompareEqualLengthString := 1;
  69.       break;
  70.     end;
  71.     if ao < bo then
  72.     begin
  73.       CompareEqualLengthString := -1;
  74.       break;
  75.     end;
  76.   end;
  77. end;
  78.  
  79. function CompareNumericString(a, b: string): integer;
  80. var
  81.   EqualLength: integer;
  82. begin
  83.   EqualLength := Max(Length(a), Length(b));
  84.   a := LeftPadStr(a, EqualLength, '0');
  85.   b := LeftPadStr(b, EqualLength, '0');
  86.   CompareNumericString := CompareEqualLengthString(a, b);
  87. end;
  88.  
  89. procedure Beep;
  90. begin
  91.   Sound(220); (*220Hz*)
  92.   Delay(200); (*200ms*)
  93.   NoSound;
  94. end;
  95.  
  96. function Trim(s: string): string;
  97. begin
  98.   while Length(s) > 0 do
  99.   begin
  100.     if s[1] in [#9,#10,#13,' '] then
  101.       Delete(s,1,1)
  102.     else
  103.       break;
  104.   end;
  105.   while Length(s) > 0 do
  106.   begin
  107.     if s[Length(s)] in [#9,#10,#13,' '] then
  108.       Delete(s,Length(s),1)
  109.     else
  110.       break;
  111.   end;
  112.   Trim := s;
  113. end;
  114.  
  115. function TrimLineToWidth(s: string; width: integer): string;
  116. begin
  117.   if Length(s) > width then
  118.   begin
  119.     s := Copy(s, 1, width-3) + '...';
  120.   end;
  121.   TrimLineToWidth := s;
  122. end;
  123.  
  124. function ZeroPad(i: LongInt; n: integer): string;
  125. var
  126.   s: string;
  127. begin
  128.   s := IntToStr(i);
  129.   ZeroPad := LeftPadStr(s, n, '0');
  130. end;
  131.  
  132. function LeftPadStr(s: string; n: integer; ch: char): string;
  133. begin
  134.   while Length(s) < n do
  135.   begin
  136.     s := ch + s;
  137.   end;
  138.   LeftPadStr := s;
  139. end;
  140.  
  141. function RightPadStr(s: string; n: integer; ch: char): string;
  142. begin
  143.   while Length(s) < n do
  144.   begin
  145.     s := s + ch;
  146.   end;
  147.   RightPadStr := s;
  148. end;
  149.  
  150. function RepeatStr(ch: char; n: integer): string;
  151. var
  152.   i: integer;
  153.   res: string;
  154. begin
  155.   res := '';
  156.   for i := 1 to n do
  157.   begin
  158.     res := res + ch;
  159.   end;
  160.   RepeatStr := res;
  161. end;
  162.  
  163. function DeleteFile(filename: string): boolean;
  164. var
  165.   F:  file;
  166.   Ch: Char;
  167. begin
  168.   Assign(F, filename);
  169.   {$I-}
  170.   Reset(F);
  171.   {$I+}
  172.   if IOResult <> 0 then
  173.   begin
  174.     DeleteFile := false; (* cannot find file *)
  175.   end
  176.   else
  177.   begin
  178.     Close(F);
  179.     {$I-}
  180.     Erase(F);
  181.     {$I+}
  182.     DeleteFile := IOResult = 0;
  183.   end;
  184. end;
  185.  
  186. function FileExists(filename: string): boolean;
  187. var
  188.   F: Text;
  189. begin
  190.   Assign(F, filename);
  191.   {$I-}
  192.   Reset(F);
  193.   {$I+}
  194.   if IoResult = 0 then
  195.   begin
  196.     Close(F);
  197.     FileExists := true;
  198.   end
  199.   else
  200.   begin
  201.     FileExists := false;
  202.   end;
  203. end;
  204.  
  205. function IsPositiveInteger(s: string): boolean;
  206. var
  207.   i: integer;
  208. begin
  209.   IsPositiveInteger := false;
  210.  
  211.   if Length(s) = 0 then exit;
  212.   if (s[1] = '0') and (s <> '0') then exit;
  213.   for i := 1 to Length(s) do
  214.   begin
  215.     if not (s[i] in ['0'..'9']) then exit;
  216.   end;
  217.  
  218.   IsPositiveInteger := true;
  219. end;
  220.  
  221. function StrToInt(s: string): Integer;
  222. var
  223.   i, Error: Integer;
  224. begin
  225.   Val(s, i, Error);
  226.   StrToInt := i;
  227. end;
  228.  
  229. function IntToStr(Value: Integer): string;
  230. var
  231.   s: string;
  232. begin
  233.   Str(Value, s);
  234.   IntToStr := s;
  235. end;
  236.  
  237. end.
  238.