home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / g / gametp20.zip / MISCFUNC.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-06  |  7KB  |  320 lines
  1. Unit MiscFunc;
  2.  
  3. { MiscFunc version 1.0 Scott D. Ramsay }
  4.  
  5. {   This is my misc. function unit.  Some of the functions have      }
  6. { nothing to do with games design but, my units use it so ...        }
  7. {   MiscFunc.pas is free.  Go crazy.                                 }
  8. {   I've been writing comments to these units all night.  Since you  }
  9. { have the source to this, I'll let you figure out what each one     }
  10. { does.   }
  11.  
  12. Interface
  13.  
  14. function strint(s:string):longint;
  15. function intstr(l:longint):string;
  16. function ups(s:string):string;
  17. function st(h:longint):string;
  18. function compare(s1,s2:string):boolean;
  19. function dtcmp(var s1,s2;size:word):boolean;
  20. function lz(i,w:longint):string;
  21. function vl(h:string):longint;
  22. function spaces(h:integer):string;
  23. function repstr(h:integer;ch:char):string;
  24. function anything(s:string):boolean;
  25. function exist(f:string):boolean;
  26. function errmsg(n:integer):string;
  27. function turboerror(errorcode:integer) : string;
  28. procedure funpad(var s:string);
  29. procedure unpad(var s:string);
  30. procedure munpad(var s:string;b:byte);
  31. function fpad(s:string;h:integer):string;
  32. procedure pad(var s:string;h:integer);
  33. procedure fix(var s:string;h:string);
  34. procedure fixh(var s:string);
  35. function range(x,y,x1,y1,x2,y2:integer) : boolean;
  36. function between(x,x1,x2:integer):boolean;
  37.  
  38. Implementation
  39.  
  40.  
  41. function range(x,y,x1,y1,x2,y2:integer) : boolean;
  42. { returns true if (x,y) is in the rectangular region (x1,y1,x2,y2) }
  43. begin
  44.   range := ((x>=x1) and (x<=x2) and (y>=y1) and (y<=y2));
  45. end;
  46.  
  47.  
  48. procedure fix(var s:string;h:string);
  49. begin
  50.   if pos('.',s)=0
  51.     then s := s+h;
  52. end;
  53.  
  54.  
  55. procedure fixh(var s:string);
  56. var
  57.   d : integer;
  58. begin
  59.   for d := 1 to length(s) do
  60.     if s[d]<#32
  61.       then s[d] := ' ';
  62.   for d := length(s)+1 to 255 do
  63.     s[d] := ' ';
  64. end;
  65.  
  66.  
  67. function strint(s:string):longint;
  68. var
  69.   l : longint;
  70. begin
  71.   move(s[1],l,sizeof(l));
  72.   strint := l;
  73. end;
  74.  
  75.  
  76. function intstr(l:longint):string;
  77. var
  78.   s : string;
  79. begin
  80.   move(l,s[1],sizeof(l));
  81.   s[0] := #4;
  82.   intstr := s;
  83. end;
  84.  
  85.  
  86. function ups(s:string):string;
  87. var
  88.   d : integer;
  89. begin
  90.   for d := 1 to length(s) do
  91.     s[d] := upcase(s[d]);
  92.   ups := s;
  93. end;
  94.  
  95.  
  96. function st(h:longint):string;
  97. var
  98.   s : string;
  99. begin
  100.   str(h,s);
  101.   st := s;
  102. end;
  103.  
  104.  
  105. function compare(s1,s2:string):boolean;
  106. var
  107.   d : byte;
  108.   e : boolean;
  109. begin
  110.   e := true;
  111.   for d := 1 to length(s1) do
  112.     if upcase(s1[d])<>upcase(s2[d])
  113.       then e := false;
  114.   compare := e;
  115. end;
  116.  
  117.  
  118. function dtcmp(var s1,s2;size:word):boolean;
  119. var
  120.   d : word;
  121.   e : boolean;
  122. begin
  123.   e := true;
  124.   d := size;
  125.   while (d>0) and e do
  126.     begin
  127.       dec(d);
  128.       e := (mem[seg(s1):ofs(s1)+d]=mem[seg(s2):ofs(s2)+d]);
  129.     end;
  130.   dtcmp := e;
  131. end;
  132.  
  133.  
  134. function lz(i,w:longint):string;
  135. var
  136.   d : longint;
  137.   s : string;
  138. begin
  139.   str(i,s);
  140.   for d := length(s) to w-1 do
  141.     s := concat('0',s);
  142.   lz := s;
  143. end;
  144.  
  145.  
  146. function vl(h:string):longint;
  147. var
  148.   d : longint;
  149.   e : integer;
  150. begin
  151.   val(h,d,e);
  152.   vl := d;
  153. end;
  154.  
  155.  
  156. function spaces(h:integer):string;
  157. var
  158.   s : string;
  159. begin
  160.   s := '';
  161.   while h>0 do
  162.     begin
  163.       dec(h);
  164.       s := concat(s,' ');
  165.     end;
  166.   spaces := s;
  167. end;
  168.  
  169.  
  170. function repstr(h:integer;ch:char):string;
  171. var
  172.   s : string;
  173. begin
  174.   s := '';
  175.   while h>0 do
  176.     begin
  177.       dec(h);
  178.       s := s+ch;
  179.     end;
  180.   repstr := s;
  181. end;
  182.  
  183.  
  184. function anything(s:string):boolean;
  185. var
  186.   d : integer;
  187.   h : boolean;
  188. begin
  189.   if length(s)=0
  190.     then
  191.       begin
  192.         anything := false;
  193.         exit;
  194.       end;
  195.   h := false;
  196.   for d := 1 to length(s) do
  197.     if s[d]>#32
  198.       then h := true;
  199.   anything := h;
  200. end;
  201.  
  202.  
  203. function exist(f:string):boolean;
  204. var
  205.   fil : file;
  206. begin
  207.   if f=''
  208.     then
  209.       begin
  210.         exist := false;
  211.         exit;
  212.       end;
  213.   assign(fil,f);
  214.  {$i- }
  215.   reset(fil);
  216.   close(fil);
  217.  {$i+ }
  218.   exist := (ioresult=0);
  219. end;
  220.  
  221.  
  222. function errmsg(n:integer):string;
  223. begin
  224.    case n of
  225.       -1 : errmsg := '';
  226.       -2 : errmsg := 'Error reading data file';
  227.       -3 : errmsg := '';
  228.       -4 : errmsg := 'equal current data file name';
  229.      150 : errmsg := 'Disk is write protected';
  230.      152 : errmsg := 'Drive is not ready';
  231.      156 : errmsg := 'Disk seek error';
  232.      158 : errmsg := 'Sector not found';
  233.      159 : errmsg := 'Out of Paper';
  234.      160 : errmsg := 'Error writing to printer';
  235.     1000 : errmsg := 'Record too large';
  236.     1001 : errmsg := 'Record too small';
  237.     1002 : errmsg := 'Key too large';
  238.     1003 : errmsg := 'Record size mismatch';
  239.     1004 : errmsg := 'Key size mismatch';
  240.     1005 : errmsg := 'Memory overflow';
  241.      else errmsg := 'Error result #'+st(n);
  242.    end;
  243. end;
  244.  
  245.  
  246. function turboerror(errorcode:integer) : string;
  247. begin
  248.   case errorcode of
  249.       1: turboerror := 'Invalid DOS function code';
  250.       2: turboerror := 'File not found';
  251.       3: turboerror := 'Path not found';
  252.       4: turboerror := 'Too many open files';
  253.       5: turboerror := 'File access denied';
  254.       6: turboerror := 'Invalid file handle';
  255.       8: turboerror := 'Not enough memory';
  256.      12: turboerror := 'Invalid file access code';
  257.      15: turboerror := 'Invalid drive number';
  258.      16: turboerror := 'Cannot remove current directory';
  259.      17: turboerror := 'Cannot rename across drives';
  260.     100: turboerror := 'Disk read error';
  261.     101: turboerror := 'Disk write error';
  262.     102: turboerror := 'File not assigned';
  263.     103: turboerror := 'File not open';
  264.     104: turboerror := 'File not open for input';
  265.     105: turboerror := 'File not open for output';
  266.     106: turboerror := 'Invalid numeric format';
  267.     200: turboerror := 'Division by zero';
  268.     201: turboerror := 'Range check error';
  269.     202: turboerror := 'Stack overflow error';
  270.     203: turboerror := 'Heap overflow error';
  271.     204: turboerror := 'Invalid pointer operation';
  272.     else turboerror := errmsg(errorcode);
  273.   end;
  274. end;
  275.  
  276.  
  277. procedure funpad(var s:string);
  278. begin
  279.    while s[1]=' ' do
  280.       delete(s,1,1);
  281. end;
  282.  
  283.  
  284. procedure unpad(var s:string);
  285. begin
  286.    while (length(s)>0) and (s[length(s)]<=' ') do
  287.       delete(s,length(s),1);
  288. end;
  289.  
  290.  
  291. procedure munpad(var s:string;b:byte);
  292. begin
  293.    s[0] := char(b);
  294.    while (length(s)>0) and (s[length(s)]<=' ') do
  295.       delete(s,length(s),1);
  296. end;
  297.  
  298.  
  299. function fpad(s:string;h:integer):string;
  300. begin
  301.    while length(s)<h do
  302.       s := concat(s,' ');
  303.    fpad := s;
  304. end;
  305.  
  306.  
  307. procedure pad(var s:string;h:integer);
  308. begin
  309.    while length(s)<h do
  310.       s := concat(s,' ');
  311. end;
  312.  
  313.  
  314. function between(x,x1,x2:integer):boolean;
  315. begin
  316.   between := ((x>=x1) and (x<=x2));
  317. end;
  318.  
  319.  
  320. end.