Subversion Repositories oidplus

Rev

Rev 733 | Rev 740 | 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 ZeroPad(i: LongInt; n: integer): string;
  24. function LeftPadStr(s: string; n: integer; ch: char): string;
  25. function RightPadStr(s: string; n: integer; ch: char): string;
  26.  
  27. function DeleteFile(filename: string): boolean;
  28. function FileExists(filename: string): boolean;
  29.  
  30. function IsPositiveInteger(s: string): boolean;
  31. function StrToInt(s: string): Integer;
  32. function IntToStr(Value: Integer): string;
  33.  
  34. implementation
  35.  
  36. uses
  37.   Crt;
  38.  
  39. function Max(a, b: integer): integer;
  40. begin
  41.   if a > b then
  42.     Max := a
  43.   else
  44.     Max := b;
  45. end;
  46.  
  47. function Min(a, b: integer): integer;
  48. begin
  49.   if a < b then
  50.     Min := a
  51.   else
  52.     Min := b;
  53. end;
  54.  
  55. function CompareEqualLengthString(a, b: string): integer;
  56. var
  57.   ao, bo, i: integer;
  58. begin
  59.   CompareEqualLengthString := 0;
  60.   for i := 1 to Length(a) do
  61.   begin
  62.     ao := Ord(a[i]);
  63.     bo := Ord(b[i]);
  64.     if ao > bo then
  65.     begin
  66.       CompareEqualLengthString := 1;
  67.       break;
  68.     end;
  69.     if ao < bo then
  70.     begin
  71.       CompareEqualLengthString := -1;
  72.       break;
  73.     end;
  74.   end;
  75. end;
  76.  
  77. function CompareNumericString(a, b: string): integer;
  78. var
  79.   EqualLength: integer;
  80. begin
  81.   EqualLength := Max(Length(a), Length(b));
  82.   a := LeftPadStr(a, EqualLength, '0');
  83.   b := LeftPadStr(b, EqualLength, '0');
  84.   CompareNumericString := CompareEqualLengthString(a, b);
  85. end;
  86.  
  87. procedure Beep;
  88. begin
  89.   Sound(220); (*220Hz*)
  90.   Delay(200); (*200ms*)
  91.   NoSound;
  92. end;
  93.  
  94. function Trim(s: string): string;
  95. begin
  96.   while Length(s) > 0 do
  97.   begin
  98.     if s[1] in [#9,#10,#13,' '] then
  99.       Delete(s,1,1)
  100.     else
  101.       break;
  102.   end;
  103.   while Length(s) > 0 do
  104.   begin
  105.     if s[Length(s)] in [#9,#10,#13,' '] then
  106.       Delete(s,Length(s),1)
  107.     else
  108.       break;
  109.   end;
  110.   Trim := s;
  111. end;
  112.  
  113. function ZeroPad(i: LongInt; n: integer): string;
  114. var
  115.   s: string;
  116. begin
  117.   s := IntToStr(i);
  118.   ZeroPad := LeftPadStr(s, n, '0');
  119. end;
  120.  
  121. function LeftPadStr(s: string; n: integer; ch: char): string;
  122. begin
  123.   while Length(s) < n do
  124.   begin
  125.     s := ch + s;
  126.   end;
  127.   LeftPadStr := s;
  128. end;
  129.  
  130. function RightPadStr(s: string; n: integer; ch: char): string;
  131. begin
  132.   while Length(s) < n do
  133.   begin
  134.     s := s + ch;
  135.   end;
  136.   RightPadStr := s;
  137. end;
  138.  
  139. function DeleteFile(filename: string): boolean;
  140. var
  141.   F:  file;
  142.   Ch: Char;
  143. begin
  144.   Assign(F, filename);
  145.   {$I-}
  146.   Reset(F);
  147.   {$I+}
  148.   if IOResult <> 0 then
  149.   begin
  150.     DeleteFile := false; (* cannot find file *)
  151.   end
  152.   else
  153.   begin
  154.     Close(F);
  155.     {$I-}
  156.     Erase(F);
  157.     {$I+}
  158.     DeleteFile := IOResult = 0;
  159.   end;
  160. end;
  161.  
  162. function FileExists(filename: string): boolean;
  163. var
  164.   F: Text;
  165. begin
  166.   Assign(F, filename);
  167.   {$I-}
  168.   Reset(F);
  169.   {$I+}
  170.   FileExists := IoResult = 0;
  171. end;
  172.  
  173. function IsPositiveInteger(s: string): boolean;
  174. var
  175.   i: integer;
  176. begin
  177.   IsPositiveInteger := false;
  178.  
  179.   if Length(s) = 0 then exit;
  180.   if (s[1] = '0') and (s <> '0') then exit;
  181.   for i := 1 to Length(s) do
  182.   begin
  183.     if not (s[i] in ['0'..'9']) then exit;
  184.   end;
  185.  
  186.   IsPositiveInteger := true;
  187. end;
  188.  
  189. function StrToInt(s: string): Integer;
  190. var
  191.   i, Error: Integer;
  192. begin
  193.   Val(s, i, Error);
  194.   StrToInt := i;
  195. end;
  196.  
  197. function IntToStr(Value: Integer): string;
  198. var
  199.   s: string;
  200. begin
  201.   Str(Value, s);
  202.   IntToStr := s;
  203. end;
  204.  
  205. end.
  206.