home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / misc.swg / 0010_MISCFUNC.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  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.