[Back to MISC SWAG index] [Back to Main SWAG index] [Original]
Unit MiscFunc;
{ MiscFunc version 1.0 Scott D. Ramsay }
{ This is my misc. Function Unit. Some of the Functions have }
{ nothing to do With games design but, my Units use it so ... }
{ MiscFunc.pas is free. Go crazy. }
{ I've been writing comments to these Units all night. Since you }
{ have the source to this, I'll let you figure out what each one }
{ does. }
Interface
Function strint(s:String):LongInt;
Function intstr(l:LongInt):String;
Function ups(s:String):String;
Function st(h:LongInt):String;
Function Compare(s1,s2:String):Boolean;
Function dtcmp(Var s1,s2;size:Word):Boolean;
Function lz(i,w:LongInt):String;
Function vl(h:String):LongInt;
Function spaces(h:Integer):String;
Function repstr(h:Integer;ch:Char):String;
Function anything(s:String):Boolean;
Function exist(f:String):Boolean;
Function errmsg(n:Integer):String;
Function turboerror(errorcode:Integer) : String;
Procedure funpad(Var s:String);
Procedure unpad(Var s:String);
Procedure munpad(Var s:String;b:Byte);
Function fpad(s:String;h:Integer):String;
Procedure pad(Var s:String;h:Integer);
Procedure fix(Var s:String;h:String);
Procedure fixh(Var s:String);
Function range(x,y,x1,y1,x2,y2:Integer) : Boolean;
Function between(x,x1,x2:Integer):Boolean;
Implementation
Function range(x,y,x1,y1,x2,y2:Integer) : Boolean;
{ returns True if (x,y) is in the rectangular region (x1,y1,x2,y2) }
begin
range := ((x>=x1) and (x<=x2) and (y>=y1) and (y<=y2));
end;
Procedure fix(Var s:String;h:String);
begin
if pos('.',s)=0
then s := s+h;
end;
Procedure fixh(Var s:String);
Var
d : Integer;
begin
For d := 1 to length(s) do
if s[d]<#32
then s[d] := ' ';
For d := length(s)+1 to 255 do
s[d] := ' ';
end;
Function strint(s:String):LongInt;
Var
l : LongInt;
begin
move(s[1],l,sizeof(l));
strint := l;
end;
Function intstr(l:LongInt):String;
Var
s : String;
begin
move(l,s[1],sizeof(l));
s[0] := #4;
intstr := s;
end;
Function ups(s:String):String;
Var
d : Integer;
begin
For d := 1 to length(s) do
s[d] := upCase(s[d]);
ups := s;
end;
Function st(h:LongInt):String;
Var
s : String;
begin
str(h,s);
st := s;
end;
Function Compare(s1,s2:String):Boolean;
Var
d : Byte;
e : Boolean;
begin
e := True;
For d := 1 to length(s1) do
if upCase(s1[d])<>upCase(s2[d])
then e := False;
Compare := e;
end;
Function dtcmp(Var s1,s2;size:Word):Boolean;
Var
d : Word;
e : Boolean;
begin
e := True;
d := size;
While (d>0) and e do
begin
dec(d);
e := (mem[seg(s1):ofs(s1)+d]=mem[seg(s2):ofs(s2)+d]);
end;
dtcmp := e;
end;
Function lz(i,w:LongInt):String;
Var
d : LongInt;
s : String;
begin
str(i,s);
For d := length(s) to w-1 do
s := concat('0',s);
lz := s;
end;
Function vl(h:String):LongInt;
Var
d : LongInt;
e : Integer;
begin
val(h,d,e);
vl := d;
end;
Function spaces(h:Integer):String;
Var
s : String;
begin
s := '';
While h>0 do
begin
dec(h);
s := concat(s,' ');
end;
spaces := s;
end;
Function repstr(h:Integer;ch:Char):String;
Var
s : String;
begin
s := '';
While h>0 do
begin
dec(h);
s := s+ch;
end;
repstr := s;
end;
Function anything(s:String):Boolean;
Var
d : Integer;
h : Boolean;
begin
if length(s)=0
then
begin
anything := False;
Exit;
end;
h := False;
For d := 1 to length(s) do
if s[d]>#32
then h := True;
anything := h;
end;
Function exist(f:String):Boolean;
Var
fil : File;
begin
if f=''
then
begin
exist := False;
Exit;
end;
assign(fil,f);
{$i- }
reset(fil);
close(fil);
{$i+ }
exist := (ioresult=0);
end;
Function errmsg(n:Integer):String;
begin
Case n of
-1 : errmsg := '';
-2 : errmsg := 'Error reading data File';
-3 : errmsg := '';
-4 : errmsg := 'equal current data File name';
150 : errmsg := 'Disk is Write protected';
152 : errmsg := 'Drive is not ready';
156 : errmsg := 'Disk seek error';
158 : errmsg := 'Sector not found';
159 : errmsg := 'Out of Paper';
160 : errmsg := 'Error writing to Printer';
1000 : errmsg := 'Record too large';
1001 : errmsg := 'Record too small';
1002 : errmsg := 'Key too large';
1003 : errmsg := 'Record size mismatch';
1004 : errmsg := 'Key size mismatch';
1005 : errmsg := 'Memory overflow';
else errmsg := 'Error result #'+st(n);
end;
end;
Function turboerror(errorcode:Integer) : String;
begin
Case errorcode of
1: turboerror := 'Invalid Dos Function code';
2: turboerror := 'File not found';
3: turboerror := 'Path not found';
4: turboerror := 'too many open Files';
5: turboerror := 'File access denied';
6: turboerror := 'Invalid File handle';
8: turboerror := 'not enough memory';
12: turboerror := 'Invalid File access code';
15: turboerror := 'Invalid drive number';
16: turboerror := 'Cannot remove current directory';
17: turboerror := 'Cannot rename across drives';
100: turboerror := 'Disk read error';
101: turboerror := 'Disk Write error';
102: turboerror := 'File not assigned';
103: turboerror := 'File not open';
104: turboerror := 'File not open For input';
105: turboerror := 'File not open For output';
106: turboerror := 'Invalid numeric Format';
200: turboerror := 'division by zero';
201: turboerror := 'Range check error';
202: turboerror := 'Stack overflow error';
203: turboerror := 'Heap overflow error';
204: turboerror := 'Invalid Pointer operation';
else turboerror := errmsg(errorcode);
end;
end;
Procedure funpad(Var s:String);
begin
While s[1]=' ' do
delete(s,1,1);
end;
Procedure unpad(Var s:String);
begin
While (length(s)>0) and (s[length(s)]<=' ') do
delete(s,length(s),1);
end;
Procedure munpad(Var s:String;b:Byte);
begin
s[0] := Char(b);
While (length(s)>0) and (s[length(s)]<=' ') do
delete(s,length(s),1);
end;
Function fpad(s:String;h:Integer):String;
begin
While length(s)<h do
s := concat(s,' ');
fpad := s;
end;
Procedure pad(Var s:String;h:Integer);
begin
While length(s)<h do
s := concat(s,' ');
end;
Function between(x,x1,x2:Integer):Boolean;
begin
between := ((x>=x1) and (x<=x2));
end;
end.
[Back to MISC SWAG index] [Back to Main SWAG index] [Original]