gt3070b@prism.gatech.EDU (Jeff Watkins) (05/30/90)
unit GUtil;
interface
const
Bits: array[0..7] of byte= (1,2,4,8,16,32,64,128);
type
LineRec= record
t: string[20];
a: byte;
c: byte;
end;
LineArray= array[0..24] of lineRec;
MenuRec= record
w,h: word;
n: byte;
lines: Linearray;
end;
var
SelectColor: byte;
centered: boolean;
MaxX: word;
MaxY: word;
function BitSet(b:byte;bit:byte):boolean;
function ReadS(S:string;x,y:word;w:byte):string;
function EditS(S:string;x,y:word;w:byte):string;
function FileSelect(P:string;x,y:word):string;
procedure DBox(x,y,x1,y1:word);
procedure UBox(x,y,x1,y1:word);
procedure UpArrow(x,y:word;o:byte);
procedure DownArrow(x,y:word;o:byte);
procedure LeftArrow(x,y:word;o:byte);
procedure RightArrow(x,y:word;o:byte);
procedure VertScroll(x,y,y1:word);
procedure HorizScroll(x,y,x1:word);
procedure VBar(x,y,y1:word;pscroll,pvis:real);
procedure HBar(x,y,x1:word;pscroll,pvis:real);
procedure Setup;
implementation
uses dos,graph,mouse,crt,misc;
const
MaxDirSize= 512;
type
DirPtr= ^DirRec;
DirRec= record
Attr: Byte;
Time: Longint;
Size: Longint;
Name: string[12];
end;
DirList= array[0..MaxDirSize - 1] of DirPtr;
LessFunc= function(X, Y: DirPtr): Boolean;
var
Less: LessFunc;
Path: PathStr;
Dir: DirList;
Count: Integer;
{$F+}
function LessName(X, Y: DirPtr): Boolean;
begin
LessName := X^.Name < Y^.Name;
If (X^.attr=Directory) and (Y^.attr=Directory) then
LessName:= x^.name < Y^.name
else
begin
if (x^.attr=Directory) then
LessName:=true
else if (y^.attr=Directory) then
LessName:=false;
end;
end;
function LessSize(X, Y: DirPtr): Boolean;
begin
LessSize := X^.Size < Y^.Size;
if x^.size=y^.size then
lessSize:= x^.Name < y^.name;
end;
function LessTime(X, Y: DirPtr): Boolean;
begin
LessTime := X^.Time > Y^.Time;
end;
{$F-}
procedure QuickSort(L, R: Integer);
var
I, J: Integer;
X, Y: DirPtr;
begin
I := L;
J := R;
X := Dir[(L + R) div 2];
repeat
while Less(Dir[I], X) do Inc(I);
while Less(X, Dir[J]) do Dec(J);
if I <= J then
begin
Y := Dir[I];
Dir[I] := Dir[J];
Dir[J] := Y;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then QuickSort(L, J);
if I < R then QuickSort(I, R);
end;
procedure FindFiles(path,Pattern:string);
var
F: SearchRec;
x: word;
begin
if count<>0 then
for x:=0 to Count-1 do
Dispose(Dir[x]);
Count := 0;
FindFirst(Path+'*.*', Directory, F);
while (DosError = 0) and (Count < MaxDirSize) do
begin
if (F.Name<>'.') and (F.Attr=Directory) then
begin
New(Dir[Count]);
Move(F.Attr, Dir[Count]^, Length(F.Name) + 10);
Inc(Count);
end;
FindNext(F);
end;
FindFirst(Path+Pattern, ReadOnly + Archive, F);
while (DosError = 0) and (Count < MaxDirSize) do
begin
if F.Name<>'.' then
begin
New(Dir[Count]);
Move(F.Attr, Dir[Count]^, Length(F.Name) + 10);
Inc(Count);
end;
FindNext(F);
end;
end;
procedure SortFiles;
begin
if (Count <> 0) and (\@Less <> nil) then
QuickSort(0, Count - 1);
end;
procedure LeftArrow(x,y:word;o:byte);
begin
if o=1 then
setcolor(8)
else
setcolor(15);
hidem;
line(x+5,y-5,x+5,y-2); { | }
line(x+10,y-2,x+10,y+2); { | }
line(x+10,y+2,x+5,y+2); { - }
line(x+5,y+2,x+5,y+5); { | }
line(x+5,y+5,x,y); { \ }
if o=1 then
setcolor(15)
else
setcolor(8);
line(x+5,y-2,x+10,y-2); { - }
line(x,y,x+5,y-5);
showm;
end;
procedure RightArrow(x,y:word;o:byte);
begin
if o=1 then
setcolor(8)
else
setcolor(15);
hidem;
line(x-10,y+2,x-5,y+2); { - }
line(x-5,y+5,x,y); { \ }
line(x,y,x-5,y-5);
if o=1 then
setcolor(15)
else
setcolor(8);
line(x-5,y-5,x-5,y-2); { | }
line(x-10,y-2,x-10,y+2); { | }
line(x-5,y-2,x-10,y-2); { - }
line(x-5,y+2,x-5,y+5); { | }
showm;
end;
procedure UpArrow(x,y:word;o:byte);
begin
if o=1 then
setcolor(8)
else
setcolor(15);
hidem;
line(x,y,x+5,y+5);
line(x+5,y+5,x+2,y+5);
line(x+2,y+5,x+2,y+10);
line(x-5,y+5,x-2,y+5);
line(x+2,y+10,x-2,y+10);
if o=1 then
setcolor(15)
else
setcolor(8);
line(x,y,x-5,y+5);
line(x-2,y+5,x-2,y+10);
showm;
end;
procedure DownArrow(x,y:word;o:byte);
begin
if o=1 then
setcolor(8)
else
setcolor(15);
hidem;
line(x,y,x+5,y-5);
line(x,y,x-5,y-5);
line(x+2,y-5,x+2,y-10);
if o=1 then
setcolor(15)
else
setcolor(8);
line(x+5,y-5,x+2,y-5);
line(x-5,y-5,x-2,y-5);
line(x-2,y-5,x-2,y-10);
line(x+2,y-10,x-2,y-10);
showm;
end;
procedure VBar(x,y,y1:word;pscroll,pvis:real);
begin
if (y1-y-4)*Pvis+(y1-y-4)*PScroll>(y1-y-4) then
PScroll:=0.0;
UBox(x+2,y+17+trunc(pScroll*(y1-y-4)),x+12,y+17+trunc(PScroll*(y1-y-4)+Pvis*(y1-y-4)));
end;
procedure HBar(x,y,x1:word;PScroll,pvis:real);
begin
if (x1-x-4)*PVis+(x1-x-4)*PScroll>(x1-x-4) then
PScroll:=0.0;
UBox(x+17+trunc(Pscroll*(x1-x-4)),y+2,x+17+trunc(PScroll*(x1-x-4)+PVis*(x1-x-4)),y+12);
end;
procedure VertScroll(x,y,y1:word);
begin
UBox(x,y,x+14,y+14);
UBox(x,y+15,x+14,y1-15);
UBox(x,y1-14,x+14,y1);
UpArrow(x+7,y+2,1);
DownArrow(x+7,y1-2,1);
end;
procedure HorizScroll(x,y,x1:word);
begin
UBox(x,y,x+14,y+14);
UBox(x+15,y,x1-15,y+14);
UBox(x1-14,y,x1,y+14);
LeftArrow(x+2,y+7,1);
RightArrow(x1-2,y+7,1);
end;
function ReadS(S:string;x,y:word;w:byte):string;
var
c: char;
begin
DBox(x,y,x+w*7+15,y+13);
setTextStyle(SmallFont,HorizDir,4);
SetTextJustify(LeftText,TopText);
setfillstyle(1,7);
repeat
c:=readkey;
if (c=#8) and (s>'') then
begin
setcolor(7);
hidem;
OutTextXy(x+2,y+1,s);
setcolor(8);
showm;
dec(s[0]);
end;
if not (c in [#8,#13]) then
s:=s+c;
if length(s)<=w then
begin
hidem;
OutTextXY(x+2,y+1,s);
showm;
end
else
s[0]:=chr(w);
until c=#13;
ReadS:=s;
end;
function BitSet(b:byte;bit:byte):boolean;
begin
BitSet:=(b and Bits[bit])=Bits[bit];
end;
function EditS(S:string;x,y:word;w:byte):string;
var
c: char;
begin
if keypressed then
begin
setfillstyle(1,7);
c:=readkey;
if (c=#8) and (s>'') then
begin
setcolor(7);
hidem;
OutTextXY(x,y,s);
showm;
setcolor(8);
dec(s[0]);
end;
if not (c in [#8,#13]) then
s:=s+c;
if length(s)<=w then
begin
if centered then
begin
setcolor(7);
hidem;
OutTextXy(x,y,copy(s,1,length(s)-1));
showm;
setcolor(8);
end;
hidem;
OutTextXY(x,y,s);
showm;
end
else
s[0]:=chr(w);
end;
EditS:=s;
end;
function FileSelect(P:string;x,y:word):string;
var
Path: string;
Name: string;
Pattern: string;
Ext: string;
bx: word;
top: word;
Sel: word;
Sely: byte;
cx,
cy: word;
done: boolean;
abort: boolean;
B: pointer;
Size: word;
procedure DisplayPath;
begin
UBox(x+10,y+208,x+220,y+220);
hidem;
OutTextXY(x+12,y+209,Path);
showm;
end;
procedure DisplayFile(L:byte);
var
s: string;
begin
if Dir[Top+L]^.attr=directory then
begin
setfillstyle(1,GetColor);
hidem;
circle(x+30,y+35+l*10,2);
floodfill(x+30,y+35+l*10,GetColor);
showm;
end;
s:=Dir[Top+L]^.name;
hidem;
OutTextXY(x+35,y+30+l*10,s);
showm;
end;
procedure DisplayPattern;
begin
UBox(x+26,y+11,x+109,y+25);
hidem;
OutTextXY(x+28,y+12,Pattern);
Showm;
end;
procedure EditPattern;
begin
Pattern:=Edits(Pattern,x+28,y+12,12);
end;
procedure DisplayName;
begin
UBox(x+130,y+11,x+210,y+25);
hidem;
OutTextXY(x+136,y+13,Name);
showm;
end;
procedure EditName;
begin
Name:=Edits(Name,x+136,y+13,12);
end;
procedure EditPath;
begin
Path:=EditS(Path,x+12,y+209,80);
end;
procedure DisplayFiles;
var
y: word;
begin
for y:=0 to 15 do
if top+y<count then
DisplayFile(y);
end;
Procedure Select(l:byte);
begin
UBox(x+26,y+30+l*10,x+109,y+40+l*10);
DisplayFile(L);
end;
procedure UnSelect(L:byte);
begin
setcolor(7);
hidem;
rectangle(x+26,y+30+l*10,x+109,y+40+l*10);
showm;
setcolor(8);
end;
procedure HideScroll;
var
min: word;
max: word;
begin
setcolor(7);
Min:=43;
Max:=179;
if count>0 then
begin
min:=43+trunc(140/Count*Top);
max:=43+trunc(140/Count*(Top+15));
end;
if max>179 then
max:=179;
hidem;
rectangle(x+13,y+Min,x+22,y+max);
showm;
end;
procedure DisplayScroll;
var
max: word;
min: word;
begin
Min:=43;
Max:=179;
if count>0 then
begin
min:=43+trunc(140/Count*Top);
max:=43+trunc(140/Count*(Top+15));
end;
if max>179 then
max:=179;
DBox(x+13,y+Min,x+22,y+max);
end;
procedure DownOne;
var
B: pointer;
S: word;
begin
if Top+16>=count then
exit;
Unselect(Sel);
S:=ImageSize(x+30,y+40,x+105,y+189);
GetMem(B,S);
hidem;
GetImage(x+30,y+40,x+105,y+189,B^);
PutImage(x+30,y+30,B^,CopyPut);
showm;
freemem(B,S);
setcolor(7);
DisplayFile(15);
SetColor(8);
HideScroll;
inc(Top);
DisplayScroll;
if sel>0 then
dec(sel);
DisplayFile(15);
select(sel);
end;
procedure UpOne;
var
B: Pointer;
s: word;
begin
if Top=0 then
exit;
unselect(sel);
S:=ImageSize(x+30,y+30,x+105,y+179);
GetMem(B,S);
hidem;
GetImage(x+30,y+30,x+105,y+179,B^);
PutImage(x+30,y+40,B^,CopyPut);
showm;
freemem(B,S);
setcolor(7);
DisplayFile(0);
SetColor(8);
HideScroll;
dec(Top);
DisplayScroll;
if sel<15 then
inc(sel);
DisplayFile(0);
select(sel);
end;
procedure Redir;
begin
setcolor(7);
displayfiles;
HideScroll;
Path:=FExpand(Path);
FindFiles(Path,Pattern);
SortFiles;
Top:=0;
UnSelect(Sel);
Sel:=0;
setcolor(8);
DisplayFiles;
DisplayPath;
Name:='';
DisplayName;
DisplayScroll;
repeat
until click1;
end;
begin
FSplit(P,Path,Name,Ext);
Pattern:=Name+Ext;
Name:='';
Size:=ImageSize(x,y,x+230,y+230);
GetMem(B,Size);
hidem;
GetImage(x,y,x+230,y+230,B^);
showm;
UBox(x,y,x+230,y+230);
DBox(x+10,y+10,x+110,y+198);
UBox(x+11,y+11,x+25,y+25);
DBox(x+13,y+13,x+22,y+22);
UBox(x+11,y+26,x+25,y+41);
UpArrow(x+18,y+28,0);
UBox(x+11,y+42,x+25,y+181);
UBox(x+11,y+182,x+25,y+197);
DownArrow(x+18,y+195,0);
UBox(x+120,y+35,x+220,y+75);
UBox(x+120,y+85,x+220,y+125);
SetTextJustify(CenterText,TopText);
SetTextStyle(SmallFont,HorizDir,4);
for bx:=0 to 15 do
begin
UBox(x+140+(bx mod 4)*16,y+135+(bx div 4)*16,x+155+(bx mod 4)*16,y+150+(bx div 4)*16);
hidem;
OutTextXY(x+147+(bx mod 4)*16,y+138+(bx div 4)*16,chr(65+bx));
showm;
end;
SetTextJustify(CenterText,TopText);
SetTextStyle(TriplexFont,HorizDir,4);
hidem;
OutTextXY(x+170,y+37,'OK');
OutTextXY(x+170,y+87,'ABORT');
showm;
SetTextJustify(LeftText,TopText);
SetTextStyle(SmallFont,HorizDir,4);
setcolor(8);
DisplayPath;
DisplayName;
DisplayPattern;
count:=0;
FindFiles(Path,Pattern);
Top:=0;
Less:=LessName;
SortFiles;
DisplayFiles;
DisplayScroll;
sel:=0;
Done:=false;
Abort:=false;
repeat
cx:=mx;
cy:=my;
if (cx >= x+120) and (cx <= x+220) and
(cy >= y+35) and (cy <= y+75) and
but1 then
begin
Done:=true;
abort:=false;
end;
if (cx >= x+120) and (cx <= x+220) and
(cy >= y+85) and (cy <= y+125) and
but1 then
begin
Done:=true;
abort:=true;
end;
if (cx >= x+130) and (cx <=x+210) and
(cy >= y+11) and (cy <=y+25) then
EditName;
if (cx >= x+10) and (cx <= x+220) and
(cy >= y+208) and (cy <= y+220) then
EditPath;
if (cx >= x+26) and (cx <= x+109) and
(cy >= y+11) and (cy <= y+25) then
EditPattern;
if (cx >= x+11) and (cx <= x+25) and
(cy >= y+11) and (cy <= y+25) and
but1 then
Redir;
if (cx >= x+140) and (cx <= x+200) and
(cy >= y+135) and (cy <= y+200) and
but1 then
begin
bx:=(cx-x-140) div 16+((cy-y-135) div 16)*4;
Path:=chr(65+bx)+':';
redir;
end;
if (cx >= x+26) and (cx <= x+110) and
(cy >= y+30) and (cy <= y+187) then
begin
sely:=cy-y-30;
sely:=sely div 10;
if sely+top<count then
begin
if sely<>sel then
begin
unselect(sel);
sel:=sely;
select(sel);
end;
if but1 and (Name<> Dir[top+sel]^.Name) then
begin
if (Dir[top+sel]^.attr and Directory)=Directory then
begin
Path:=Path+Dir[top+sel]^.name+'\';
ReDir;
if Sely+top<count then
begin
sel:=Sely;
Select(Sel);
end;
end
else
begin
name:=Dir[top+sel]^.Name;
DisplayName;
end;
end;
end;
end;
if (cx >= x+11) and (cx <= x+25) and
(cy >= y+26) and (cy <= y+41) and
but1 then
UpOne;
if (cx >= x+11) and (cx <= x+25) and
(cy >= y+182) and (cy <= y+197) and
but1 then
DownOne;
until Done;
FileSelect:='';
if not abort then
FileSelect:=Path+Name;
hidem;
PutImage(x,y,B^,CopyPut);
showm;
FreeMem(B,Size);
end;
procedure UBox(x,y,x1,y1:word);
begin
Hidem;
setcolor(15);
rectangle(x,y,x1,y1);
setfillstyle(1,7);
bar(x+1,y+1,x1,y1);
setcolor(8);
line(x,y1,x1,y1);
line(x1,y,x1,y1);
showm;
end;
procedure DBox(x,y,x1,y1:word);
begin
hidem;
setcolor(15);
rectangle(x,y,x1,y1);
setfillstyle(1,7);
bar(x,y,x1-1,y1-1);
setcolor(8);
line(x,y,x1,y);
line(x,y,x,y1);
showm;
end;
procedure Setup;
begin
MaxX:=GetMaxX;
Maxy:=GetMaxy;
end;
begin
centered:=false;
end.
--
Jeff Watkins gt3070b@prism.gatech.edu
"All opinions are mine... so don't even think of keeping some to yourself!"