home *** CD-ROM | disk | FTP | other *** search
- { PullShel.pas - a skeleton shell for your application. ver 1.5, 08-31-87 }
- { Use this shell to start your application program. As is, this program will }
- { compile and run. }
-
- { ***************************** STEP 1 ********************************* }
- { C-} { Set to $C- when your program is debugged }
-
- {$I qwik30.inc }
-
- const
- MaxWndw = 20; { Max Number of Windows on display at one time. }
- {$I window34.inc }
-
- const
- MaxMenuLines = 20; { For Main and Sub menus }
- MaxCharsPerLine = 40; { For Main and Sub menus and Data Windows }
- MaxStringLength = 80; { Screen limit }
- LastMainMenu = 2; { 1 - 255; use exact number here! }
- NumOfMainMenus = 2; { 1 - 255 }
- NumOfSubMenus = 3; { 1 - 255 }
- NumOfDataWndws = 10; { 1 - 255 }
- NumOfHelpWndws = 10; { 1 - 255 }
- NumOfMsgLines = 10; { 1 - 255 }
- NumOfErrMsgLines = 10; { 1 - 32767 }
- MaxErrStrLength = 80; { Error messages are usually shorter }
- TotalHelpLines = 50; { 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,FirstMenu,QuitMenu);
- SubMenuNames = (NoSubMenu,S1Menu,S2Menu,S3Menu,S4Menu);
- DataWndwNames = (NoDW,BytesDW,IntegersDW,RealsDW,CharsDW,StringsDW,
- FileNameDW);
- HelpWndwNames = (NoHW,WorkWndwHW,TopMenuHW,MainMenuHW,SubMenuHW,
- NumericHW,TextHW);
- HelpLineNames = (NoHL, { HL - HelpLine; L - Last }
- HLw1,HLw2,HLw3,HLw4,HLw5,HLwL, { for WorkWndwHW }
- HLt1,HLt2,HLt3,HLt4,HLt5,HLtL, { for TopMenuHW }
- HLm1,HLm2,HLm3,HLm4,HLm5,HLmL, { for MainMenuHW }
- HLs1,HLs2,HLs3,HLs4,HLs5,HLsL, { for SubMenuHW }
- HLn1,HLn2,HLn3,HLn4,HLn5,HLnL, { for NumericHW }
- HLtx1,HLtx2,HLtx3,HLtx4,HLtx5,HLtxL); { for TextHW }
-
- { 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
- 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:=1; { Main menu title to be HiLited when F10 is pressed. }
- MoreCmdSeq:='F'; { 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(FirstMenu)] do
- begin
- MenuMode:=ExecSingleChoice; SingleFlagLine:=5;
- Title:='FirstMenu';
- 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(MainMenuHW);
- 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(MainMenuHW);
- 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(S1Menu)] do
- begin
- MenuMode:=SingleChoice; SingleFlagLine:=5;
- Line[1]:='Brands'; LineMode[1]:=ToSubMenu;
- LinkNum [1]:=ord(S2Menu);
- 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(SubMenuHW);
- 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(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;
-
- { ----------------------- 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 not 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(MainMenuHW)].FirstLine := ord(HLm1);
- HelpWndw [ord(MainMenuHW)].LastLine := ord(HLmL);
-
- HelpWndw [ord(SubMenuHW) ].FirstLine := ord(HLs1);
- HelpWndw [ord(SubMenuHW) ].LastLine := ord(HLsL);
-
- 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 MY PROGRAM';
- HelpLine[ord(HLw2)]:='This is one of the easiest human interfaces around';
- HelpLine[ord(HLw3)]:='with pull-down menus and context-sensitive help';
- HelpLine[ord(HLw4)]:='window.';
- HelpLine[ord(HLw5)]:='';
- HelpLine[ord(HLwL)]:='';
-
- HelpLine[ord(HLt1)]:='Move cursor and press return OR type a command';
- HelpLine[ord(HLt2)]:='letter. ESC to return to the Work window.';
- HelpLine[ord(HLt3)]:='';
- HelpLine[ord(HLt4)]:='';
- HelpLine[ord(HLt5)]:='';
- HelpLine[ord(HLtL)]:='';
-
- HelpLine[ord(HLm1)]:='This help window can be used for Main Menus.';
- HelpLine[ord(HLm2)]:='';
- HelpLine[ord(HLm3)]:='';
- HelpLine[ord(HLm4)]:='';
- HelpLine[ord(HLm5)]:='';
- HelpLine[ord(HLmL)]:='';
-
- HelpLine[ord(HLs1)]:='This help window can be used for SubMenus.';
- HelpLine[ord(HLs2)]:='';
- HelpLine[ord(HLs3)]:='';
- HelpLine[ord(HLs4)]:='';
- HelpLine[ord(HLs5)]:='';
- HelpLine[ord(HLsL)]:='';
-
- HelpLine[ord(HLn1)]:='This is a numeric scratch pad. Enter data between';
- HelpLine[ord(HLn2)]:='the symbols. Only certain characters are valid.';
- HelpLine[ord(HLn3)]:='BS is active. To clear, ESC+CR.';
- HelpLine[ord(HLn4)]:='';
- HelpLine[ord(HLn5)]:='';
- HelpLine[ord(HLnL)]:='';
-
- HelpLine[ord(HLtx1)]:='This is a text scratch pad. Enter data between';
- HelpLine[ord(HLtx2)]:='the symbols shown. DEL+CR allows a null entry.';
- HelpLine[ord(HLtx3)]:='BS is active.';
- HelpLine[ord(HLtx4)]:='';
- HelpLine[ord(HLtx5)]:='';
- HelpLine[ord(HLtxL)]:='';
-
- { ------------------ 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]:=' Enter 1..12 ESC-acknowledge';
-
- end; { procedure GetUserPullStats }
-
- { ***************************** STEP 3 ********************************* }
- { You can OVERRIDE the automatic Colors, Sizes, and Locations here. }
-
- procedure GetOverrideStats;
- begin
- { This following changes the command letters on Main Menu 1 to other than
- 1st letters. '#00' is for inaccessible lines. }
- MainMenu[ord(FirstMenu)].CmdLtrs:='GSA'#00'MBO';
- end;
-
- { ***************************** STEP 4 ********************************* }
- { Your normal variables and procedures now go here: }
- { Here are some sample user variables. }
- var
- aByte: byte;
- aInteger: integer;
- aReal: real;
- aChar: char;
- aString: MaxString;
- FileName: string[12];
- WorkWndwInteger: 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
- FirstMenu:
- case HiLited of
- 1,3: Transfer (FileName);
- 5:;
- end;
- end
- else
- case SubMenuNames(SPulled) of
- S1Menu:
- case HiLited of
- 1:;
- 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
- FirstMenu:
- case HiLited of
- 1..3: DummyProcess;
- end;
- QuitMenu:
- case HiLited of
- 1:;
- 2: begin
- PopToWorkWndw:=true;
- Quit:=true
- end;
- end;
- end
- else
- case SubMenuNames(SPulled) of
- S1Menu:
- case HiLited of
- 1: ;
- 2: ;
- 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,27,-1,'Press CR for work window 2:');
- GotoRC (20,54);
- WorkWndwStep:=2
- end
- end;
- 2: begin
- ReadKB (ExtKey,Key);
- if HelpKeyPressed then PullHelpWndw (1,'work window');
- if Key=RetKey then
- begin
- MakeWindow ( 8,30, 8,21,Attr(black,green),
- Attr(lightgreen,black),SingleBrdr);
- TitleWindow (Center,' Work Window 2 ');
- with WndwStat[LI] do
- begin
- Qwrite (WSrow+3,WScol+5, -1,'Press CR or');
- Qwrite (WSrow+4,WScol+5, -1,'pull menus')
- end;
- WorkWndwStep:=3
- end
- end;
- 3: begin
- ReadKB (ExtKey,Key);
- if HelpKeyPressed then PullHelpWndw (1,'work window');
- if Key=RetKey then
- begin
- 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,'PULLSHEL 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 ( 6,ColL,ColR,-1,'MULTI-LEVEL PULL-DOWN MENUS');
- QwriteC (17,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. }
- aByte:= 129;
- aInteger:=-31456;
- aReal:=-24.34565E06;
- aChar:='Q';
- aString:='This is a string';
- FileName:='testfile.txt';
- WorkWndwInteger:=0;
-
- GotoKeyDispatcher; { <<-- All keyboard entries go through here! }
- Qfill (1,1,CRTrows,CRTcols,InitAttr,' ');
- GotoRC (CRTrows,1)
- end.