Category : Pascal Source Code
Archive   : BOOST4.ZIP
Filename : PULLDOWN.PAS

Program PullDown;

{ Demonstrates pull-down menus using Boosters v4.0,
a library of routines for Turbo Pascal 4.0
George F. Smith, Lilburn, GA 10/9/88

PullDown calls the following Boosters routines:

Name Description Implementation
---- ----------- --------------
PutStr Writes string to video at x,y MASM 4.0
SetAtt Sets video atts for block MASM 4.0
Heap2Scr Writes block from heap to screen MASM 4.0
Disk2Mem Reads video screen from file to heap MASM 4.0
GetAtt Returns the video attribute at x,y MASM 4.0
SaveScreen Writes current screen to page of heap MASM 4.0
Scr2Heap Writes video block to block of heap MASM 4.0
HeapAtt Sets video attributes of heap block MASM 4.0
}

Uses crt, BOSHARE;

Const
Npage = 2;
ESC = #27;
ALTQ = #16;
ALTT = #20;
ALTF = #33;
ALTE = #18;
ALTV = #47;
ALTS = #31;
RA = #77;
LA = #75;
TX = 6;
FX = 16;
EX = 26;
VX = 36;
SX = 46;
Attributes : array[0..5] of byte = (7,14,30,48,66,112);

Var
Page : array[1..Npage] of HeapBuf;
i, Ecode, Stall : integer;
CurrentAtt, att : byte;
c : char;
MenuSel : 0..4;

{-------------}
function Fstr ( num : longint; width : integer) : String;
var
s : string[80];
begin
str ( num:width, s );
fstr := s;
end; { fstr }

{---------------------}
Procedure ShowMessages;
begin
PutStr (h,
'Sample pull-down menuing routine using BOOSTERS 4.0 library.',
1, 6, 14 );
Writeln;
Writeln;
Writeln('Press ALT-T for TSRs, ALT-F for File, etc. to see first menu,');
Writeln('then use left and right arrow keys to move from menu to menu.');
Writeln;
Writeln('Press ESCAPE to stop menuing, ALT-Q to quit.');
Writeln;
Writeln('When no menus are displayed:');
Writeln(' 1) +/- keys increase/decrease pull-down delay');
Writeln(' Current menu scroll delay value is ',stall:3);
Writeln(' 2) ''A'' changes the video attributes of the menus');
Writeln(' Current video attribute value is ',Attributes[CurrentAtt]:3);
Writeln;
Writeln('P.S.');
Writeln(' Pull-downs are for visual effects only, not for speed.');
end;

{-----------------}
Procedure Wait4Key;
begin
repeat until keypressed;
c := readkey;
if c = #0 then
c := readkey;
end;

{------------------}
Procedure SelectMenu;
begin
case c of
ALTT : MenuSel := 0;
ALTF : MenuSel := 1;
ALTE : MenuSel := 2;
ALTV : MenuSel := 3;
ALTS : MenuSel := 4;
end;
end;

{---------------------}
Procedure ShowNextMenu;
begin
case c of
RA : if MenuSel >= 4 then
MenuSel := 0
else
MenuSel := MenuSel + 1;
LA : if MenuSel <= 0 then
MenuSel := 4
else
MenuSel := MenuSel - 1;
end;

case MenuSel of
0 : begin
setatt ( TX,1,9,1,14 );
for i := 2 to 10 do begin
delay(stall);
heap2scr( Page[1],1,i,25,i,TX,i);
end;
end;
1 : begin
setatt ( FX,1,19,1,14);
for i := 2 to 17 do begin
delay(stall);
heap2scr( Page[1],26,i,50,i ,FX,i);
end;
end;
2 : begin
setatt ( EX,1,29,1,14);
for i := 2 to 9 do begin
delay(stall);
heap2scr( Page[1],51,i,75,i,EX,i);
end;
end;
3 : begin
setatt ( VX,1,39,1,14);
for i := 2 to 7 do begin
delay(stall);
heap2scr( Page[1],1,i+11,25,i+11,VX,i);
end;
end;
4 : begin
setatt ( SX,1,52,1,14);
for i := 2 to 7 do begin
delay(stall);
heap2scr( Page[1],26,i+16,50,i+16,SX,i);
end;
end;
end;
end;

{---------------------}
Procedure EraseCurMenu;
begin
case MenuSel of
0 : begin
SetAtt (6,1,9,1,att);
heap2scr( Page[2],6,2,30,10,6,2);
end;
1 : begin
SetAtt (16,1,19,1,att);
heap2scr( Page[2],16,2,40,17,16,2);
end;
2 : begin
SetAtt (26,1,29,1,att);
heap2scr( Page[2],26,2,50,9,26,2);
end;
3 : begin
SetAtt (36,1,39,1,att);
heap2scr( Page[2],36, 2,60, 7,36,2);
end;
4 : begin
SetAtt (46,1,52,1,att);
heap2scr( Page[2],46, 2,70, 7,46,2);
end;
end;
end;


BEGIN
Mark(HeapTop);
New ( Page[1] );
New ( Page[2] );
ClrScr;
Stall := 10;
CurrentAtt := 0;

{--- Get file of menus that was created with ScrGen ---}
Disk2Mem ( 'PullDown.Gen', 1, Page[1], Ecode );
if Ecode <> 0 then begin
Writeln('PullDown.Gen not found. Program halted.');
Release ( HeapTop );
halt;
end;

{--- Copy menu bar to screen ---}
Heap2Scr ( Page[1], 1,1, 80,1, 1,1);

{--- Get video attribute of menu bar ---}
att := GetAtt (1,1);

{--- Write Program identifying information and instructions ---}
ShowMessages;

{--- Save current screen image to heap page 2 ---}
SaveScreen ( Page[2] );

repeat
{--- Wait for keypress ---}
c := readkey;

{--- Check for plus & minus keys ---}
{--- Plus key increases menu scrolling speed ---}
{--- Minus key decreases menu scrolling speed ---}
if c in ['+','-'] then begin
case c of
'-' : if stall > 0 then
stall := stall - 1;
'+' : stall := stall + 1;
end;
PutStr(h,fstr(stall,3),43,15,14);
Scr2Heap ( Page[2], 43,15,45,15,43,15);
end;

{--- Check for 'A' key to change visual attributes of menus ---}
if UpCase(c) = 'A' then begin
if CurrentAtt < 5 then
CurrentAtt := CurrentAtt + 1
else
CurrentAtt := 0;
HeapAtt ( Page[1],1,2,80,25, Attributes[CurrentAtt] );
PutStr(h,fstr(attributes[CurrentAtt],3),41,17,14);
Scr2Heap ( Page[2], 41,17,43,17,41,17);
end;

{--- Show first menu user selects ---}
if c = #0 then begin
c := readkey;
SelectMenu;
ShowNextMenu;

{--- Display menus as left & right arrow keys pressed ---}
{--- Stop menuing on ESCAPE; Halt program on ALT-Q ---}
if c <> ALTQ then begin
repeat
Wait4Key;
if c in [RA,LA] then begin
EraseCurMenu;
ShowNextMenu;
end
else if c = ESC then
EraseCurMenu;
until c in [ESC,ALTQ];
end;
end;
until c = ALTQ;

Release ( HeapTop );

END.