Subversion Repositories oidplus

Rev

Rev 739 | Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
733 daniel-mar 1 
unit VTSFUNCS;
2 
 
3 
(************************************************)
4 
(* VTSFUNCS.PAS                                 *)
5 
(* Author:   Daniel Marschall                   *)
6 
(* Revision: 2022-02-13                         *)
7 
(* License:  Apache 2.0                         *)
8 
(* This file contains:                          *)
9 
(* - Various functions                          *)
10 
(************************************************)
11 
 
12 
interface
13 
 
14 
function CompareEqualLengthString(a, b: string): integer;
15 
function CompareNumericString(a, b: string): integer;
16 
procedure Beep;
17 
function Trim(s: string): string;
18 
function IsNumeric(s: string): boolean;
19 
function ZeroPad(i: LongInt; n: integer): string;
20 
procedure DeleteFile(filename: string);
21 
function FileExists(filename: string): boolean;
22 
function StrToInt(s: string): Integer;
23 
function IntToStr(Value: Integer): string;
24 
 
25 
implementation
26 
 
27 
uses
28 
  Crt;
29 
 
30 
function CompareEqualLengthString(a, b: string): integer;
31 
var
32 
  ao, bo, i: integer;
33 
begin
34 
  CompareEqualLengthString := 0;
35 
  for i := 1 to Length(a) do
36 
  begin
37 
    ao := Ord(a[i]);
38 
    bo := Ord(b[i]);
39 
    if ao > bo then
40 
    begin
41 
      CompareEqualLengthString := 1;
42 
      break;
43 
    end;
44 
    if ao < bo then
45 
    begin
46 
      CompareEqualLengthString := -1;
47 
      break;
48 
    end;
49 
  end;
50 
end;
51 
 
52 
function CompareNumericString(a, b: string): integer;
53 
var
54 
  i, maxlen: integer;
55 
  prefix_a, prefix_b: string;
56 
begin
57 
  maxlen := Length(a);
58 
  if Length(b) > maxlen then maxlen := Length(b);
59 
 
60 
  prefix_a := '';
61 
  for i := 1 to maxlen-Length(a) do
62 
  begin
63 
    prefix_a := prefix_a + '0';
64 
 end;
65 
 
66 
  prefix_b := '';
67 
  for i := 1 to maxlen-Length(b) do
68 
  begin
69 
    prefix_b := prefix_b + '0';
70 
 end;
71 
 
72 
 CompareNumericString := CompareEqualLengthString(prefix_a+a, prefix_b+b);
73 
end;
74 
 
75 
procedure Beep;
76 
begin
77 
  Sound(220); (*220Hz*)
78 
  Delay(200); (*200ms*)
79 
  NoSound;
80 
end;
81 
 
82 
function Trim(s: string): string;
83 
begin
84 
  while Length(s) > 0 do
85 
  begin
86 
    if s[1] in [#9,#10,#13,' '] then
87 
      Delete(s,1,1)
88 
    else
89 
      break;
90 
  end;
91 
  while Length(s) > 0 do
92 
  begin
93 
    if s[Length(s)] in [#9,#10,#13,' '] then
94 
      Delete(s,Length(s),1)
95 
    else
96 
      break;
97 
  end;
98 
  Trim := s;
99 
end;
100 
 
101 
function IsNumeric(s: string): boolean;
102 
var
103 
  i: integer;
104 
begin
105 
  IsNumeric := false;
106 
 
107 
  if Length(s) = 0 then exit;
108 
  if (s[1] = '0') and (s <> '0') then exit;
109 
  for i := 1 to Length(s) do
110 
  begin
111 
    if not (s[i] in ['0'..'9']) then exit;
112 
  end;
113 
 
114 
  IsNumeric := true;
115 
end;
116 
 
117 
function ZeroPad(i: LongInt; n: integer): string;
118 
var
119 
  s: string;
120 
begin
121 
  Str(i, s);
122 
  while Length(s) < n do
123 
  begin
124 
    s := '0' + s;
125 
  end;
126 
  ZeroPad := s;
127 
end;
128 
 
129 
procedure DeleteFile(filename: string);
130 
var
131 
 F:  file;
132 
 Ch: Char;
133 
begin
134 
 { Get file to delete from command line }
135 
 Assign(F, filename);
136 
 {$I-}
137 
 Reset(F);
138 
 {$I+}
139 
 (*
140 
 if IOResult <> 0 then
141 
   Writeln('Cannot find ', filename)
142 
 else
143 
 begin
144 
 *)
145 
   Close(F);
146 
   (*
147 
   Write('Erase ', filename, '? ');
148 
   Readln(Ch);
149 
   if UpCase(CH) = 'Y' then
150 
   *)
151 
     Erase(F);
152 
 (*
153 
 end;
154 
 *)
155 
end;
156 
 
157 
function FileExists(filename: string): boolean;
158 
var
159 
  F: Text;
160 
begin
161 
  Assign(F, filename);
162 
  {$I-}
163 
  Reset(F);
164 
  {$I+}
165 
  FileExists := IoResult = 0;
166 
end;
167 
 
168 
function StrToInt(s: string): Integer;
169 
var
170 
  i, Error: Integer;
171 
begin
172 
  Val(s, i, Error);
173 
  StrToInt := i;
174 
end;
175 
 
176 
function IntToStr(Value: Integer): string;
177 
var
178 
  s: string;
179 
begin
180 
  Str(Value, s);
181 
  IntToStr := s;
182 
end;
183 
 
184 
end.