home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 June
/
SIMTEL_0692.cdr
/
msdos
/
turbopas
/
pull15.arc
/
PULLDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-08-31
|
37KB
|
897 lines
{ PullDemo.pas - full-featured demo for PULL15.INC ver 1.5, 08-31-87 }
{ ***************************** STEP 1 ********************************* }
{$C-} { Be sure to set this in your final program. A special case of
fast keyboard repeat programs will produce errors when the buffer
is full and $C+. }
{ Place data storage limits on include files. When you first start a program,
give yourself some breathing room and make the constants large. In your
final version, you can trim them down. }
{$I qwik30.inc }
const
MaxWndw = 15; { Max Number of Windows on display at one time. }
{$I window34.inc }
const
MaxMenuLines = 15; { For Main and Sub menus }
MaxCharsPerLine = 20; { For Main and Sub menus and Data Windows }
MaxStringLength = 80; { Screen limit }
LastMainMenu = 8; { 1 - 255 }
NumOfMainMenus = 8; { 1 - 255 }
NumOfSubMenus = 5; { 1 - 255 }
NumOfDataWndws = 9; { 1 - 255 }
NumOfHelpWndws = 13; { 1 - 255 }
NumOfMsgLines = 9; { 1 - 255 }
NumOfErrMsgLines = 6; { 1 - 32767 }
MaxErrStrLength = 60; { Error messages are usually shorter }
TotalHelpLines = 68; { 2 - Screen limit }
HelpCharsPerLine = 50; { 1 - Screen limit }
{$I pull15.inc }
{$I pullde15.inc } { or use pullde__.inc to delete data entry package }
{$I pulluser.inc } { for special windows or menus }
{ ***************************** STEP 2 ********************************* }
{ ------------------ Set up your window names here in order: ---------------- }
{ This is optional, but it sure helps you in not only understanding the
program, but also makes it unquestionably easier to rearrange. }
type
MainMenuNames = (NoMainMenu,FilesMenu,ColorMenu,AutoPartsMenu,EnterDataMenu,
OptionsMenu,UtilitiesMenu,IRSmenu,QuitMenu);
SubMenuNames = (NoSubMenu,TiresMenu,RadioMenu,UpdateMenu,DateMenu,
BrandsMenu);
DataWndwNames = (NoDW,BytesDW,IntegersDW,RealsDW,HexDW,CharsDW,StringsDW,
FileNameDW,DateDW,YearDW);
HelpWndwNames = (NoHW,WorkWndwHW,TopMenuHW,FilesMenuHW,BrandsMenuHW,
EnterDataMenuHW,IRSmenuHW,DateMenuHW,UpdateMenuHW,
ExecChoiceHW,SingleChoiceHW,MultipleChoiceHW,
NumericHW,TextHW);
HelpLineNames = (NoHL, { HL - HelpLine; L - Last }
HLw1,HLw2,HLw3,HLw4,HLw5,HLw6, { Work window }
HLw7,HLw8,HLw9,HLw10,HLwL,
HLt1,HLtL, { Top menu }
HLb1,HLb2,HLb3,HLb4,HLb5, { Brands submenu }
HLb6,HLb7,HLbL,
HLf1,HLf2,HLf3,HLf4,HLf5, { Files submenu }
HLf6,HLf7,HLf8,HLf9,HLfL,
HLe1,HLe2,HLe3,HLe4,HLe5, { Enter data submenu }
HLe6,HLe7,HLe8,HLe9,
HLe10,HLe11,HLe12,HLeL,
HLi1,HLi2,HLiL, { IRS menu }
HLd1,HLd2,HLd3,HLdL, { Date submenu }
HLu1,HLu2,HLuL, { Update submenu }
HLx1,HLx2,HLxL, { eXecute choice menu }
HLs1,HLs2,HLsL, { Single choice menu }
HLm1,HLm2,HLmL, { Multiple choice menu }
HLn1,HLn2,HLnL, { Numeric data entry window }
HLtx1,HLtxL); { Text data entry window }
{ Careful! - Always test your last main menu, submenu, data window, and help
window for run-time error! It makes sure you have allotted enough memory
with your constants. The compiler cannot check it with these typed scalars.)
{ ----------------------- User information starts here: --------------------- }
procedure GetUserPullStats;
begin
LocationWarning:=true; { If true and a Submenu won't fit, a message is
displayed. If false, you can override the
location without the message. }
case ActiveDD of { I'll put this in QWIK next time. }
EgaColor..VgaColor: CRTrows:=succ(EgaRows);
else CRTrows:=25;
end;
{ This is all the configuration data. The program first clears all
RECORD values to $00. The values below will set new values. Therefore,
setting RECORD values to "false" or the like is not necessary. }
{ ------------------ Set up your colors and borders here: ---------------- }
TopMenuAttr:= Attr(black,lightgray); TopMenuHattr:= Attr(white,black);
MainMenuBattr:=Attr(lightgray,black);
MainMenuHattr:=Attr(black,lightgray); MainMenuLattr:=Attr(yellow,black);
MainMenuCattr:=Attr(lightgray,black);
SubMenuWattr:= Attr(black,cyan); SubMenuBattr:= Attr(black,cyan);
if Vmode=7 then
begin
TopMenuLattr :=TopMenuAttr;
MainMenuWattr:=Attr(lightgray,black );
SubMenuHattr :=Attr(black ,lightgray);
SubMenuLattr :=Attr(white ,black ); { :=white; }
SubMenuCattr :=Attr(lightgray,black ); { :=lightgray; }
end
else
begin
TopMenuLattr :=Attr(red ,lightgray);
MainMenuWattr:=Attr(white ,black );
SubMenuHattr :=Attr(white ,blue );
SubMenuLattr :=Attr(white ,cyan );
SubMenuCattr :=Attr(blue ,cyan );
end;
DataWndwWattr:=Attr(black,brown); DataWndwBattr:=Attr(black,brown);
HelpWndwWattr:=Attr(black,green); HelpWndwBattr:=Attr(black,lightgray);
MsgLineAttr :=Attr(green,black);
Brdr[UserBrdr]:=Brdr[MixedBrdr]; { Give Main menus a custom border. }
with Brdr[UserBrdr] do
begin
BL:=Brdr[SingleBrdr].BL;
BH:=Brdr[SingleBrdr].BH;
BR:=Brdr[SingleBrdr].BR
end;
MainMenuBrdr:=UserBrdr; SubMenuBrdr :=SingleBrdr;
DataWndwBrdr:=MixedBrdr; HelpWndwBrdr:=MixedBrdr;
HelpZoom:=true; HelpShadow:=Right;
RowsBelowHelp:=4; RowsBelowMsg:=0;
{ ------------------------- Top Menu defaults ----------------------------- }
TopMenuRow:=2; { Top menu to appear on row 2 }
MPulled:=3; { Main menu title to be HiLited when F10 is pressed. }
MoreCmdSeq:='ATB'; { Sequence of command letter(s) as if keyed in. This }
{ will be the default menu(s) pulled. }
Pull:=false; { Set this true if you want the command sequence}
{ to pull down the menus at startup. }
{ ------------------- Set up your MainMenu records here: ------------------ }
MainMenuRow:=3; { First row of Main menus to appear on screen row 3 }
with MainMenu[ord(FilesMenu)] do
begin
MenuMode:=ExecSingleChoice; SingleFlagLine:=5;
Title:='Files';
Line[1]:='Get'; LineMode[1]:=ToDataWndw;
LinkNum [1]:=ord(FileNameDW);
Line[2]:='Save'; LineMode[2]:=ExecOnly;
Line[3]:='save As'; LineMode[3]:=ToDataWndw;
LinkNum [3]:=ord(FileNameDW);
Line[4]:='────────────'; LineMode[4]:=Comment;
Line[5]:='Merge';
Line[6]:='make Backup';
Line[7]:='text Out';
Line[8]:=''; LineMode[8]:=Partition; LinkNum[8]:=11;
Line[9]:='Help comment'; LineMode[9]:=Comment; LinkNum[9]:=11;
MenuLines:=9; DefaultLine:=6;
MsgLineNum:=3; HelpWndwNum:=ord(FilesMenuHW);
end;
with MainMenu[ord(ColorMenu)] do
begin
MenuMode:=SingleChoice; SingleFlagLine:=2;
Title:='Color';
Line[1]:='Blue';
Line[2]:='Green';
Line[3]:='Orange';
Line[4]:='Yellow';
Line[5]:='Red';
Line[6]:='Cyan';
Line[7]:='Ultraviolet';
MenuLines:=7; DefaultLine:=5;
MsgLineNum:=3; HelpWndwNum:=ord(SingleChoiceHW);
end;
with MainMenu[ord(AutoPartsMenu)] do
begin
MenuMode:=MultipleChoice;
Title:='AutoParts';
Line[1]:='Tires'; LineMode[1]:=ToSubMenu;
LinkNum [1]:=ord(TiresMenu);
Line[2]:='Radio'; LineMode[2]:=ToSubMenu;
LinkNum [2]:=ord(RadioMenu);
Line[3]:='Seats'; LineMode[3]:=ToDataWndw;
LinkNum [3]:=ord(BytesDW);
Line[4]:='Mirrors'; Flagged[4]:=true;
Line[5]:='Locks';
Line[6]:='HiBeams'; Flagged[6]:=true;
Line[7]:='Wheels';
MenuLines:=7; DefaultLine:=1;
MsgLineNum:=3; HelpWndwNum:=ord(MultipleChoiceHW);
end;
with MainMenu[ord(EnterDataMenu)] do
begin
MenuMode:=MultipleChoice;
Title:='EnterData';
Line[1]:='Byte'; LineMode[1]:=ToDataWndw;
LinkNum [1]:=ord(BytesDW);
Line[2]:='Integer'; LineMode[2]:=ToDataWndw;
LinkNum [2]:=ord(IntegersDW);
Line[3]:='Real'; LineMode[3]:=ToDataWndw;
LinkNum [3]:=ord(RealsDW);
Line[4]:='Hex'; LineMode[4]:=ToDataWndw;
LinkNum [4]:=ord(HexDW);
Line[5]:='Character'; LineMode[5]:=ToDataWndw;
LinkNum [5]:=ord(CharsDW);
Line[6]:='String'; LineMode[6]:=ToDataWndw;
LinkNum [6]:=ord(StringsDW);
MenuLines:=6; DefaultLine:=2;
MsgLineNum:=3; HelpWndwNum:=ord(EnterDataMenuHW);
end;
with MainMenu[ord(OptionsMenu)] do
begin
MenuMode:=MultipleChoice;
Title:='Options';
Line[1]:='Dual drive';
Line[2]:='Hard disk'; Flagged[2]:=true;
Line[3]:='Extended Mem';
Line[4]:='CGA'; Flagged[4]:=true;
Line[5]:='MDA';
Line[6]:='KeyBoard';
Line[7]:='Price limit'; LineMode[7]:=ToDataWndw;
LinkNum [7]:=ord(IntegersDW);
MenuLines:=7; DefaultLine:=1;
MsgLineNum:=3; HelpWndwNum:=ord(MultipleChoiceHW);
end;
with MainMenu[ord(UtilitiesMenu)] do
begin
{ MenuMode:=ExecChoice; } { This is the default }
Title:='Utilities';
Line[1]:='Copy files';
Line[2]:='Delete files';
Line[3]:='List file';
Line[4]:='Edit file';
Line[5]:='Find file';
Line[6]:='Rename file';
Line[7]:='Sort files';
MenuLines:=7; DefaultLine:=2;
MsgLineNum:=3; HelpWndwNum:=ord(ExecChoiceHW);
end;
with MainMenu[ord(IRSmenu)] do
begin
{ MenuMode:=ExecChoice; } { This is the default }
Title:='IRSaccounting';
Line[1]:='Date'; LineMode[1]:=ToSubMenu;
LinkNum [1]:=ord(DateMenu);
Line[2]:='Cost';
Line[3]:='Revenue';
Line[4]:='Taxes';
Line[5]:='Insurance';
Line[6]:='Update'; LineMode[6]:=ToSubMenu;
LinkNum [6]:=ord(UpdateMenu);
Line[7]:='Years'; LineMode[7]:=ToDataWndw;
LinkNum [7]:=ord(BytesDW);
MenuLines:=7; DefaultLine:=1;
MsgLineNum:=3; HelpWndwNum:=ord(IRSmenuHW);
end;
with MainMenu[ord(QuitMenu)] do
begin
{ MenuMode:=ExecChoice; } { This is the default }
Title:='Quit';
Line[1]:='Stay';
Line[2]:='Quit';
MenuLines:=2; DefaultLine:=1; BackToDefault:=true;
MsgLineNum:=3; HelpWndwNum:=ord(ExecChoiceHW);
end;
{ ----------------------- Set up your SubMenus here: --------------------- }
{ Careful! -- indexes to SubMenus must be numbered in order of level; i.e.,
ALL SubMenus first, ALL SubSubMenus second, ALL SubSubSubMenus, ... etc. }
with SubMenu[ord(TiresMenu)] do
begin
MenuMode:=SingleChoice; SingleFlagLine:=5;
Line[1]:='Brands'; LineMode[1]:=ToSubMenu;
LinkNum[1] :=ord(BrandsMenu);
Line[2]:='Radials';
Line[3]:='Knobbies';
Line[4]:='Track';
Line[5]:='Snow';
Line[6]:='All-Weather';
Line[7]:='4-ply';
MenuLines:=7; DefaultLine:=1;
MsgLineNum:=4; HelpWndwNum:=ord(SingleChoiceHW);
end;
with SubMenu[ord(RadioMenu)] do
begin
MenuMode:=MultipleChoice;
Line[1]:='FM Stereo'; Flagged[1]:=true;
Line[2]:='AM Radio'; Flagged[2]:=true;
Line[3]:='Cassette';
Line[4]:='Compact Disc';
MenuLines:=4; DefaultLine:=4;
MsgLineNum:=4; HelpWndwNum:=ord(MultipleChoiceHW);
end;
with SubMenu[ord(DateMenu)] do
begin
{ MenuMode:=ExecChoice; } { This is the default }
Line[1]:='Month'; LineMode[1]:=ToDataWndw;
LinkNum [1]:=ord(DateDW);
Line[2]:='Day'; LineMode[2]:=ToDataWndw;
LinkNum [2]:=ord(DateDW);
Line[3]:='Year'; LineMode[3]:=ToDataWndw;
LinkNum [3]:=ord(YearDW);
MenuLines:=3; DefaultLine:=1; BackToDefault:=true;
MsgLineNum:=4; HelpWndwNum:=ord(DateMenuHW);
end;
with SubMenu[ord(UpdateMenu)] do
begin
{ MenuMode:=ExecChoice; } { This is the default }
Line[1]:='1 process';
Line[2]:='2 process and pop';
Line[3]:='3 pop and process';
Line[4]:='4 pop, process, pull';
Line[5]:='5 pop, pull to Years';
Line[6]:='6 pop, pull Radio';
MenuLines:=6; DefaultLine:=4;
MsgLineNum:=4; HelpWndwNum:=ord(UpdateMenuHW);
end;
{ Here's a SubSubMenu: }
with SubMenu[ord(BrandsMenu)] do
begin
MenuMode:=SingleChoice; SingleFlagLine:=2;
Line[1]:='Michelin';
Line[2]:='General';
Line[3]:='Firestone';
Line[4]:='Bridgestone';
Line[5]:='WeatherGuard';
MenuLines:=5; DefaultLine:=3;
MsgLineNum:=4; HelpWndwNum:=ord(BrandsMenuHW);
end;
{ ----------------- Set up your Data Windows here: --------------------- }
{ Justification will default with numbers right justified and string to }
{ the left if none is specified. }
AutoNumLock:=true; { Turns NumLock on with numeric window }
NumLockCol:=42; { Column to write 'NUMLOCK' on message line. }
with DataWndw[ord(BytesDW)] do
begin
Line[1]:='Currently:';
Line[2]:='Enter byte:';
{ TypeOfData:=Bytes; } { This is the default }
Field:=3;
{ Justify:=Right; } { This is the default }
MsgLineNum:=5; HelpWndwNum:=ord(NumericHW);
end;
with DataWndw[ord(IntegersDW)] do
begin
Line[1]:='Currently:';
Line[2]:='Enter integer:';
TypeOfData:=Integers;
Field:=6;
MsgLineNum:=5; HelpWndwNum:=ord(NumericHW);
end;
with DataWndw[ord(RealsDW)] do
begin
Line[1]:='Currently:';
Line[2]:='Enter real:';
TypeOfData:=Reals;
Field:=17;
Decimals:=08; { Neg value uses R:F. Pos value - R:F:D. }
MsgLineNum:=5; HelpWndwNum:=ord(NumericHW);
end;
with DataWndw[ord(CharsDW)] do
begin
Line[1]:='Currently:';
Line[2]:='Enter char:';
TypeOfData:=Chars;
Field:=1;
MsgLineNum:=6; HelpWndwNum:=ord(TextHW);
end;
with DataWndw[ord(HexDW)] do
begin
Line[1]:='Currently:';
Line[2]:='Enter hex:';
TypeOfData:=UserNums;
Field:=4;
MsgLineNum:=6; HelpWndwNum:=ord(NumericHW);
end;
with DataWndw[ord(StringsDW)] do
begin
Line[1]:='Currently:';
Line[2]:='Enter string:';
TypeOfData:=Strings;
Field:=25; { If field is too large to fit, program
centers it on screen. You can override. }
MsgLineNum:=6; HelpWndwNum:=ord(TextHW);
end;
with DataWndw[ord(FileNameDW)] do
begin
Line[1]:='Currently:';
Line[2]:='Enter name:';
TypeOfData:=Strings;
Field:=12;
MsgLineNum:=6; HelpWndwNum:=ord(TextHW);
end;
with DataWndw[ord(DateDW)] do
begin
Line[1]:='Now:';
Line[2]:='New:';
{ TypeOfData:=Bytes; } { This is the default. }
Field:=2;
MsgLineNum:=5; HelpWndwNum:=ord(NumericHW);
end;
with DataWndw[ord(YearDW)] do
begin
Line[1]:='Now:';
Line[2]:='New:';
TypeOfData:=Integers;
Field:=4;
MsgLineNum:=5; HelpWndwNum:=ord(NumericHW);
end;
{ ----------------------- Set up your Help Windows here: ------------------ }
{ HelpWndw[1] is reserved for the Work window. }
{ HelpWndw[2] is reserved for the top menu. }
HelpMsgLineNum:=7; { Standard message for a Help window }
{ For 2 assignments to a record, save code by no using WITH }
HelpWndw [ord(WorkWndwHW) ].FirstLine := ord(HLw1);
HelpWndw [ord(WorkWndwHW) ].LastLine := ord(HLwL);
HelpWndw [ord(TopMenuHW) ].FirstLine := ord(HLt1);
HelpWndw [ord(TopMenuHW) ].LastLine := ord(HLtL);
HelpWndw [ord(FilesMenuHW) ].FirstLine := ord(HLf1);
HelpWndw [ord(FilesMenuHW) ].LastLine := ord(HLfL);
HelpWndw [ord(EnterDataMenuHW) ].FirstLine := ord(HLe1);
HelpWndw [ord(EnterDataMenuHW) ].LastLine := ord(HLeL);
HelpWndw [ord(BrandsMenuHW) ].FirstLine := ord(HLb1);
HelpWndw [ord(BrandsMenuHW) ].LastLine := ord(HLbL);
HelpWndw [ord(IRSmenuHW) ].FirstLine := ord(HLi1);
HelpWndw [ord(IRSmenuHW) ].LastLine := ord(HLiL);
HelpWndw [ord(DateMenuHW) ].FirstLine := ord(HLd1);
HelpWndw [ord(DateMenuHW) ].LastLine := ord(HLdL);
HelpWndw [ord(UpdateMenuHW) ].FirstLine := ord(HLu1);
HelpWndw [ord(UpdateMenuHW) ].LastLine := ord(HLuL);
HelpWndw [ord(ExecChoiceHW) ].FirstLine := ord(HLx1);
HelpWndw [ord(ExecChoiceHW) ].LastLine := ord(HLxL);
HelpWndw [ord(SingleChoiceHW) ].FirstLine := ord(HLs1);
HelpWndw [ord(SingleChoiceHW) ].LastLine := ord(HLsL);
HelpWndw [ord(MultipleChoiceHW)].FirstLine := ord(HLm1);
HelpWndw [ord(MultipleChoiceHW)].LastLine := ord(HLmL);
HelpWndw [ord(NumericHW) ].FirstLine := ord(HLn1);
HelpWndw [ord(NumericHW) ].LastLine := ord(HLnL);
HelpWndw [ord(TextHW) ].FirstLine := ord(HLtx1);
HelpWndw [ord(TextHW) ].LastLine := ord(HLtxL);
{ ------------------- Set up your Help Lines here: ------------------------ }
HelpLine[ord(HLw1)]:=' WELCOME TO PULL15.ARC';
HelpLine[ord(HLw2)]:='These files will enable you to do fully developed';
HelpLine[ord(HLw3)]:='pull-down menus along with:';
HelpLine[ord(HLw4)]:=' - Work window(s)';
HelpLine[ord(HLw5)]:=' - Top, Main, and Multiple Submenus';
HelpLine[ord(HLw6)]:=' . Each menu can have 1 of 5 menu modes';
HelpLine[ord(HLw7)]:=' . Each line can have 1 of 7 line modes';
HelpLine[ord(HLw8)]:=' - Data entry windows';
HelpLine[ord(HLw9)]:=' - Help windows for each of the above';
HelpLine[ord(HLw10)]:=' - Pull/Pop remembers last menu';
HelpLine[ord(HLwL)]:=' - Message lines for prompts and processing';
HelpLine[ord(HLt1)]:='Move cursor and press return OR type a command';
HelpLine[ord(HLtL)]:='letter. ESC to return to the Work window.';
HelpLine[ord(HLb1)]:='Notice the number of levels for the menus. This';
HelpLine[ord(HLb2)]:='menu is a "Single Choice" menu, but you can choose';
HelpLine[ord(HLb3)]:='from 1 of 5 menu modes:';
HelpLine[ord(HLb4)]:=' 1. ExecChoice - process';
HelpLine[ord(HLb5)]:=' 2. ExecSingleChoice - process and flag';
HelpLine[ord(HLb6)]:=' 3. ExecMultipleChoice - process and toggle flag';
HelpLine[ord(HLb7)]:=' 4. SingleChoice - flag';
HelpLine[ord(HLbL)]:=' 5. MultipleChoice - toggle flag';
HelpLine[ord(HLf1)]:='This is a "Execute Single Choice" menu, but there';
HelpLine[ord(HLf2)]:='are 5 of the 7 possible line modes used here:';
HelpLine[ord(HLf3)]:='* 1. Choice - interact with other menu choices';
HelpLine[ord(HLf4)]:='* 2. ExecOnly - process but do not flag';
HelpLine[ord(HLf5)]:='* 3. Comment - bypassed by highlight';
HelpLine[ord(HLf6)]:='* 4. Partition - mid-menu border';
HelpLine[ord(HLf7)]:='* 5. ToDataWndw - pulls data entry window';
HelpLine[ord(HLf8)]:=' 6. ToSubMenu - pulls next submenu level';
HelpLine[ord(HLf9)]:=' 7. ToUserWndw - pulls a user defined window';
HelpLine[ord(HLfL)]:='Any combination of the seven works!';
HelpLine[ord(HLe1)]:='Each data entry window can be tailored to any type';
HelpLine[ord(HLe2)]:='of data:';
HelpLine[ord(HLe3)]:=' 1. Byte - 0..255';
HelpLine[ord(HLe4)]:=' 2. Integer - -32767..32767';
HelpLine[ord(HLe5)]:=' 3. Real - any range or format';
HelpLine[ord(HLe6)]:=' 4. UserNums - user defined numbers, like hex';
HelpLine[ord(HLe7)]:=' 5. Char - one character';
HelpLine[ord(HLe8)]:=' 6. String - any length';
HelpLine[ord(HLe9)]:=' 7. UserStrings - strings limited by special sets';
HelpLine[ord(HLe10)]:='Data entry will check validity, range, and user-';
HelpLine[ord(HLe11)]:='defined limits. Sets will limit data entry to';
HelpLine[ord(HLe12)]:='valid characters only. Field length and labels';
HelpLine[ord(HLeL)]:='are also user-defined.';
HelpLine[ord(HLi1)]:='This is an "Execute Choice" menu. But sure to see';
HelpLine[ord(HLi2)]:='the example of sequential data entry on "Date" and';
HelpLine[ord(HLiL)]:='menu control on "Update".';
HelpLine[ord(HLd1)]:='This is an "Execute Choice" menu, but there are no';
HelpLine[ord(HLd2)]:='"choice" lines. Instead, the lines are all data';
HelpLine[ord(HLd3)]:='entry lines that have been made to allow either';
HelpLine[ord(HLdL)]:='random or sequential access. Start with "Month".';
HelpLine[ord(HLu1)]:='This is an "Execute Choice" menu. This one will';
HelpLine[ord(HLu2)]:='show you a few of the possibilities of actually';
HelpLine[ord(HLuL)]:='controlling the menus themselves.';
HelpLine[ord(HLx1)]:=' This is an "Execute Choice" menu.';
HelpLine[ord(HLx2)]:=' Notice that there are no flags.';
HelpLine[ord(HLxL)]:=' "'#240'" means linked SubMenu; "'#250'" - DataWndw.';
HelpLine[ord(HLs1)]:=' This is a "Single Choice" menu.';
HelpLine[ord(HLs2)]:=' Notice there''s only one flag.';
HelpLine[ord(HLsL)]:=' "'#240'" means linked SubMenu; "'#250'" - DataWndw.';
HelpLine[ord(HLm1)]:=' This is a "Multiple Choice" menu.';
HelpLine[ord(HLm2)]:=' Notice several flags.';
HelpLine[ord(HLmL)]:=' "'#240'" means linked SubMenu; "'#250'" - DataWndw.';
HelpLine[ord(HLn1)]:='This is a numeric scratch pad. Enter data between';
HelpLine[ord(HLn2)]:='the symbols. Only certain characters are valid.';
HelpLine[ord(HLnL)]:='BS is active. To clear, ESC+CR. Try to mess up!.';
HelpLine[ord(HLtx1)]:='This is a text scratch pad. Enter data between';
HelpLine[ord(HLtxL)]:='the symbols shown. DEL+CR allows a null entry.';
{ ------------------ Set up your Message Lines here: ---------------------- }
{ Concatonations here allow source to print on 80 col printer. }
{ MsgLine[1] is reserved as the Work window message line. }
{ MsgLine[2] is reserved as the top menu message line. }
MsgLine[1]:=' F1-help F2-pull F10-cmd ESC-pull '+
' ';
MsgLine[2]:=' F1-help F2-pop LTR-cmd ESC-return '+
' '^[^Z' hilight CR-select ';
MsgLine[3]:=' F1-help F2-pop LTR-cmd ESC-return '+
' '^[^Z' menus '^X^Y'-hilight CR-select ';
MsgLine[4]:=' F1-help F2-pop LTR-cmd ESC-return '+
' '^X^Y'-hilight CR-select ';
MsgLine[5]:=' F1-help F2-pop F10-cmd ESC-return '+
' CR-enter ';
MsgLine[6]:=' F1-help F2-pop ESC-return '+
' DEL-null CR-enter ';
MsgLine[7]:=' F1-return ESC-return '+
' ';
MsgLine[8]:=' Processing ... '+
' ';
MsgLine[9]:=' F1-help F2-pull F10-cmd ESC-pull '+
' CR-enter ';
{ ---------------- Set up your Error Message Lines here: -------------------- }
{ ErrMsgLine[1] is reserved for the Invalid numerical entries. }
ErrMsgLine[1]:=' Invalid entry. ESC-acknowledge';
ErrMsgLine[2]:=' $2500 limit. ESC-acknowledge';
ErrMsgLine[3]:=' Range is: -300 >= WorkWndwInteger >= 4000; Press ESC';
ErrMsgLine[4]:=' Enter 1..12 ESC-acknowledge';
ErrMsgLine[5]:=' Enter 1..31 ESC-acknowledge';
ErrMsgLine[6]:=' Range is: 1960 >= Year >= 2010; Press ESC';
end; { procedure GetUserPullStats }
{ ***************************** STEP 3 ********************************* }
{ You can OVERRIDE the automatic Colors, Sizes, and Locations here. }
procedure GetOverrideStats;
begin
{ DataWndw[ord(StringsDW)].RowAlt:=10;
DataWndw[ord(StringsDW)].ColAlt:=3 }
with SubMenu[ord(BrandsMenu)] do
begin
Wattr:= Attr(black,brown);
Battr:= Attr(black,brown);
if Vmode<>7 then
begin
Hattr:=Attr(yellow,black);
Lattr:=Attr(yellow,brown);
end;
end;
SubMenu[ord(DateMenu)].LinkDir:=Left;
{ This following changes the command letters on Main Menu 1 to other than
1st letters. '#00' is for inaccessible lines. }
MainMenu[ord(FilesMenu)].CmdLtrs:='GSA'#00'MBO';
end;
{ ***************************** STEP 4 ********************************* }
{ Your normal variables and procedures now go here: }
{ Here are some sample user variables. }
var
aByte,Seats,Years,Month,Day: byte;
aInteger,PriceLimit: integer;
aReal: real;
aHex: string[4];
aChar: char;
aString: MaxString;
HexSet: set of char;
FileName: string[12];
WorkWndwInteger,Year: integer;
{ ---------------- Set up variables for data windows here: ------------------ }
{ Place your variables names here to interface with the menus.
MPulled is the Main Menu pulled and SPulled is the Submenu pulled. HiLited
is the selection on that menu that called for the DataWndw. I don't like
the method I chose here but it works well. }
{ Careful! -- there's NO type checking here. You MUST be certain case
statement, DataWndw, and TypeOfData all match. }
procedure DataTransfer; { (VAR ErrMsg: integer); }
begin
with DataPad do
begin
if SPulled=0 then { SPulled=0 when a Main Menu only is pulled. }
case MainMenuNames(MPulled) of
FilesMenu:
case HiLited of
1,3: Transfer (FileName);
5:;
end;
AutoPartsMenu:
case HiLited of
1..2:;
3: Transfer (Seats);
end;
EnterDataMenu:
case HiLited of
1: Transfer (aByte);
2: Transfer (aInteger);
3: Transfer (aReal);
4: begin
Transfer (aHex);
if StoreMode then
for j:=1 to ord(aHex[0]) do aHex[j]:=upcase(aHex[j])
else UserCharSet:=HexSet;
end;
5: Transfer (aChar);
6: Transfer (aString);
end;
OptionsMenu:
case HiLited of
{ The following line shows how to place limits on data. }
7: if StoreMode and ((Idata>2500) or (Idata<=0)) then ErrMsg:=2
else Transfer (PriceLimit);
end;
IRSmenu:
case HiLited of
7: Transfer (Years);
end;
end
else
case SubMenuNames(SPulled) of
DateMenu:
case HiLited of
1: if StoreMode and ((Bdata=0) or (Bdata>12)) then ErrMsg:=4
else Transfer (Month);
2: if StoreMode and ((Bdata=0) or (Bdata>31)) then ErrMsg:=5
else Transfer (Day);
3: if StoreMode and ((Idata<1960) or (Idata>2010)) then ErrMsg:=6
else Transfer (Year);
end;
end { case }
end { with }
end;
{ ***************************** STEP 5 ********************************* }
{ Place procedures for Process and WorkWndw here. }
procedure DummyProcess;
begin
ShowMsg (8);
Delay (1000)
end;
{ ***************************** STEP 6 ********************************* }
{ Place your procedure names here to interface with "Exec-" type menus.
MPulled is the Main Menu pulled and SPulled is the SubMenu pulled.
HiLited is the selection on that menu. }
procedure Process; { (MPulled,SPulled,HiLited: integer) LOCAL!}
begin
if SPulled=0 then { SPulled=0 when a Main Menu only is pulled. }
case MainMenuNames(MPulled) of
FilesMenu:
case HiLited of
1..3: DummyProcess;
end;
UtilitiesMenu:
case HiLited of
1..7: DummyProcess;
end;
IRSmenu:
case HiLited of
2..5,7: DummyProcess;
6:;
end;
QuitMenu:
case HiLited of
1:;
2: begin
PopToWorkWndw:=true;
Quit:=true
end;
end;
end
else
case SubMenuNames(SPulled) of
UpdateMenu:
case HiLited of
1: DummyProcess;
2: begin
{ The following line are how you process first and then pop
the menu. }
DummyProcess;
PopToWorkWndw:=true
end;
3: { The following line is how you pop the menus first and
then process. }
if Popped then DummyProcess;
4: begin
{ The following lines are how you pop the menus first,
process, and then pull the same menu(s) again which is good
for updating the work window. }
if Popped then DummyProcess;
Pull:=true
end;
5: begin
{ The following lines are how you pop by a number of levels
so that part of the menus will remain displayed while
going to another submenu. }
PopLevels:=1;
Pull:=true;
MoreCmdSeq:='Y'
end;
6: begin
{ The following lines are how you go to a completely
different menu. }
PopToTop:=true;
Pull:=true;
MoreCmdSeq:='AR'
end;
end;
{ The following is how to enter a sequence of entries. }
DateMenu:
case HiLited of
1: begin
Pull:=true;
MoreCmdSeq:='D'
end;
2: begin
Pull:=true;
MoreCmdSeq:='Y'
end;
3: PopLevels:=1;
end;
end; { case }
if not(PopToWorkWndw or PopToTop or (PopLevels>0) or Pull) then
if SPulled=0 then
ShowMsg (MainMenu[MPulled].MsgLineNum)
else ShowMsg (SubMenu [SPulled].MsgLineNum);
end;
{ ***************************** STEP 7 ********************************* }
{ This procedure will have all the procedures for the Work window(s). }
procedure WorkWndw;
var TestString: MaxString;
j: integer;
begin
ShowMsg (1);
case WorkWndwStep of
0: begin
DataPad.NewData:=true; { Initialize DataPad !! It's only needed once
but you can force the data to be new at each step if you want. }
Qfill (20, 2,1,CRTcols-2,-1,' ');
Str (WorkWndwInteger:4,TestString);
Qwrite (19,24,-1,'Work window integer = '+TestString);
Qwrite (20,27,-1,'Press CR to enter new value:');
GotoRC (20,55);
ReadKB (ExtKey,Key);
if HelpKeyPressed then PullHelpWndw (1,'work window');
if Key=RetKey then
begin
WorkWndwStep:=1;
Qfill (20, 2,1,CRTcols-2,-1,' ');
Qwrite (20,30,-1,'Enter integer:')
end
end;
1: begin
repeat
WorkWndwEntry (20,46,4,WorkWndwInteger,Integers,Right,
ord(NumericHW),'Work window entry');
if (WorkWndwInteger<-300) or (WorkWndwInteger>4000) then
RestoreData (WorkWndwInteger,3); { Sets Key=' '. }
until DataPad.DataStored or not (Key=' ');
if Key=RetKey then
begin
Qfill (20, 2,1,CRTcols-2,-1,' ');
Str (WorkWndwInteger:4,TestString);
Qwrite (19,46,-1,TestString);
Qwrite (20,22,-1,'Press CR for multi-level work windows:');
GotoRC (20,60);
WorkWndwStep:=2
end
end;
2: begin
ReadKB (ExtKey,Key);
if HelpKeyPressed then PullHelpWndw (1,'work window');
if Key=RetKey then
begin
for i:=0 to 1 do
for j:=0 to 4 do
begin
MakeWindow (5+j*2+i*2,23+j*8-i*18,8,21,Attr(black,green),
Attr(lightgreen,black),SingleBrdr);
Str (LI,TestString);
TitleWindow (Center,' Work Window '+TestString+' ');
with WndwStat[LI] do
begin
Qwrite (WSrow+3,WScol+5, -1,'Press CR or');
Qwrite (WSrow+4,WScol+5, -1,'pull menus')
end
end;
WorkWndwStep:=3
end
end;
3: begin
ReadKB (ExtKey,Key);
if HelpKeyPressed then PullHelpWndw (1,'work window');
if Key=RetKey then
begin
for i:=LI downto 2 do RemoveWindow;
WorkWndwStep:=0
end
end;
end { case }
end;
{ ***************************** STEP 8 ********************************* }
{ Set up initial display layout here. }
procedure DisplayScreen;
var ColL,ColR: integer;
begin
Qwrite (1,1,lightgray,'PULLDEMO v1.5 Multi-level Pu'+
'll-down Menus (c) 1987 J H LeMay');
ShowTopMenu;
FixedWindow:=true;
MakeWindow (3,1,CRTrows-3,CRTcols,Attr(white,blue),Attr(lightgray,black),
DoubleBrdr);
with WndwStat[LI] do
begin
ColL:=WScol; ColR:=pred(WScol+WScols);
QwriteC ( 7,ColL,ColR,-1,'PULL15.INC - MULTI-LEVEL PULL-DOWN MENUS');
QwriteC (11,ColL,ColR,-1,'Use F1 everywhere for some descriptions.');
QwriteC (12,ColL,ColR,-1,'Use ''Quit'' to exit demo program.');
QwriteC (13,ColL,ColR,-1,'Be sure to try a CR at "'#240'" marked lines.');
QwriteC (14,ColL,ColR,-1,'Also try all the EnterData lines.');
QwriteC (16,ColL,ColR,Attr(yellow,blue),'This is Work Window 1.');
GotoRC (WSrow+17,WScol+26)
end
end;
{ ***************************** STEP 9 ********************************* }
{ It's all yours from here: }
begin
InitPull (lightgray); { <<-- Be sure you do this!! }
DisplayScreen;
WorkWndwStep:=0; { Step number of where you want to start in the
Work window. }
Seats:=4;
aByte:= 129;
aInteger:=-31456;
aReal:=-24.34565E06;
HexSet:=['0'..'9','A'..'F','a'..'f',BSkey];
aHex:='FF03';
aChar:='Q';
aString:='This is a string';
FileName:='testfile.txt';
Years:=30;
Month:=8; Day:=31; Year:=1987;
PriceLimit:=2000;
WorkWndwInteger:=0;
GotoKeyDispatcher; { <<-- All keyboard entries go through here! }
Qfill (1,1,CRTrows,CRTcols,InitAttr,' ');
GotoRC (CRTrows,1)
end.