gt3070b@prism.gatech.EDU (Jeff Watkins) (05/30/90)
unit misc; interface uses crt,dos; const Bits: array[0..15] of word = (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8092,16384,32768); Radix: byte= 1; { Hex or Dec switch } ExtendedChar: char= #0; Procedure Beep(Hz:real;Duration:byte); function SwapC(b:byte):byte; procedure Writec(s:string;y:integer); function Size(s:string;x:integer):string; function extract(l:string;c1,c2:char):string; function ConvertScan(c:char):char; procedure cursoron; procedure cursoroff; function fill(c:char;x:integer):string; function VStr(V:word):string; function Center(S:string;V:byte):string; function Cap(S:string):string; function Bin(N:word):string; function Hex(X:Longint):string; function Ten(S:string):longint; function NumStr(N:LONGINT; D: word): String; function VNum(S:string):longint; implementation const ScanCodes:array[0..35,1..2] of byte=( (65,30), (66,48), (67,46), (68,32), (69,18), (70,33), (71,34), (72,35), (73,23), (74,36), (75,37), (76,38), (77,50), (78,49), (79,24), (80,25), (81,16), (82,19), (83,31), (84,20), (85,22), (86,47), (87,17), (88,45), (89,21), (90,44), (48,129), (49,120), (50,121), (51,122), (52,123), (53,124), (54,125), (55,126), (56,127), (57,128)); Nibbles : array[0..7] of longint = ( 1,$10,$100,$1000,$10000, $100000,$1000000,$10000000); function extract(l:string;c1,c2:char):string; begin extract:=copy(l,pos(c1,l)+1,pos(c2,l)-pos(c1,l)-1); end; function ConvertScan(c:char):char; var x:integer; begin x:=-1; repeat inc(x); until (ScanCodes[x,2]=ord(c)) or (x>35); if x>35 then begin ConvertScan:=#0; ExtendedChar:=C; end else begin ConvertScan:=chr(ScanCodes[x,1]); ExtendedChar:=#0; end; end; procedure cursoron; var regs:registers; begin regs.ah:=1; regs.cx:=$0707; intr($10,regs); end; procedure cursoroff; var regs:registers; begin regs.ah:=1; regs.cx:=$0800; intr($10,regs); end; function fill(c:char;x:integer):string; var t:integer; s:string; begin fill:=''; if x=0 then exit; s:=''; for t:=1 to x do s:=s+c; fill:=s; end; Function Size(s:string;x:integer):string; var t:integer; st:string; begin St:=Copy(s,1,x); t:=length(st); st:=st+fill(' ',x-t); Size:=st; end; procedure Writec(s:string;y:integer); var t:integer; begin if not (y in [1..(hi(windmax)-hi(windmin)+1)]) then exit; t:=lo(windmax)-lo(windmin)+1; if length(s)>t then s:=copy(s,1,t); gotoxy((t-length(s)) div 2+1,y); write(s); end; function SwapC(b:byte):byte; begin SwapC:=b div 16+b mod 16*16; end; function VStr(V:word):string; var s:string; begin Str(v,s); Vstr:=s; end; function Center(S:string;V:byte):string; begin s:=fill(' ',(v-length(S)) div 2)+s; center:=size(s,v); end; function Cap(S:String):string; var x:integer; begin for x:=1 to length(S) do S[x]:=Upcase(S[x]); Cap:=s; end; Function Bin(N:word):string; var B : byte; S : string[17]; begin S:=''; if N>255 then begin for B:=15 downto 8 do if (N and Bits[B])=Bits[B] then S:=S+'1' else S:=S+'0'; S:=S+'|'; end; for B:=7 downto 0 do if (N and Bits[B])=Bits[B] then S:=S+'1' else S:=S+'0'; Bin:=S; end; function Hex(X:LongInt):string; const HexDigit : array[0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'); var s:string; begin s:='00000000'; s[8]:=HexDigit[x mod 16]; s[7]:=HexDigit[x div 16 mod 16]; s[6]:=HexDigit[x div $100 mod 16]; s[5]:=HexDigit[x div $1000 mod 16]; s[4]:=HexDigit[x div $10000 mod 16]; s[3]:=HexDigit[x div $100000 mod 16]; s[2]:=HexDigit[x div $1000000 mod 16]; s[1]:=HexDigit[x div $10000000 mod 16]; hex:=s; if x < $1000000 then hex:=copy(s,3,6); if x < $10000 then hex:=copy(s,5,4); if x < $100 then hex:=copy(s,7,2); end; function NumStr(N:LONGINT; D: word): String; var s:string; begin if radix=0 then begin S:=Hex(N); while length(s)<d do s:=' '+s; exit; end; NumStr[0] := Chr(D); while D > 0 do begin NumStr[D] := Chr(N mod 10 + Ord('0')); N := N div 10; Dec(D); end; end; function Ten(S:string):longint; var t : longint; x : byte; begin t:=0; if upcase(s[length(s)])='B' then begin dec(s[0]); for x:=1 to length(s) do if s[x]='1' then inc(t,bits[length(s)-x]); end else for x:=1 to Length(s)-1 do begin if s[x] in ['0'..'9'] then inc(t,(ord(s[x])-48)*Nibbles[length(s)-x-1]); if upcase(s[x]) in ['A'..'F'] then inc(t,(ord(upcase(s[x]))-55)*Nibbles[length(s)-x-1]); end; ten:=t; end; function VNum(S:string):longint; var t : word; l : Longint; begin if upcase(s[length(s)])='B' then begin L:=Ten(S); Vnum:=l; exit; end; if (upcase(s[length(s)])='H') or (Radix=0) then l:=Ten(S) else Val(s,l,t); if s='' then l:=0; VNum:=l; end; Procedure Beep(Hz:real;Duration:byte); begin Sound(trunc(HZ*100)); delay(Duration*100); NoSound; end; -- Jeff Watkins gt3070b@prism.gatech.edu "All opinions are mine... so don't even think of keeping some to yourself!"