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!"