home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PULL55.ZIP / PULLSHEL.ZIP / PULLSTAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-24  |  11.8 KB  |  344 lines
  1. { =========================================================================== }
  2. { PullStat.pas - User Statistics for pull-down menus.       ver 5.5, 08-24-89 }
  3. {                                                                             }
  4. { This file contains all the data for GetUserPullStats, GetOverrideStats and  }
  5. { CheckGlobalKeys to configure the menus.                                     }
  6. {   Copyright (c) 1987-1989 James H. LeMay, All rights reserved.              }
  7. { =========================================================================== }
  8.  
  9. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }         { TP4 directives }
  10. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}    { TP5 directives }
  11.  
  12. {$define UseSubMenuCode }
  13. {$define UseHelpWndwCode }
  14. {$define UseDataEntryCode }
  15. {$define UseMsgLineCode }
  16.  
  17. UNIT PullStat;
  18.  
  19. INTERFACE
  20.  
  21. uses
  22.   Crt,Qwik,Wutil,Wndw,Pull;
  23.  
  24. { ------------------ Set up your window names here in order: ---------------- }
  25. { This is optional, but it sure helps you in not only understanding the
  26.   program, but also makes it unquestionably easier to rearrange.              }
  27.  
  28. type
  29.   MainMenuNames = (NoMainMenu,FirstMenu,QuitMenu);
  30.   SubMenuNames  = (NoSubMenu,MySubMenu);
  31.   { These names are reserved up to HelpML and must match those in PULL.PAS. }
  32.   MsgLineNames = (NoML,WorkML,TopML,AltML,MainML,SubML,DW_ML,DE_ML,
  33.                   SeqML,HelpML,ProcML);
  34.   HelpWndwNames = (NoHW,WorkWndwHW,TopLineHW,MainMenuHW,SubMenuHW,DataWndwHW);
  35.   HelpLineNames = (
  36.     NoHL,      { HL - HelpLine;  L - Last }
  37.     HLw1,HLwL, { Work window }
  38.     HLt1,HLtL, { Top Line menu }
  39.     HLm1,HLmL, { Main menu }
  40.     HLs1,HLsL, { Submenu }
  41.     HLd1,HLd2,HLd3,HLd4,HLd5,HLd6,HLdL); { Data window }
  42.   DataWndwNames = (NoDW,aByteDW);
  43.  
  44. { Careful! - Always test your last main menu, submenu, data window, and help
  45.   window for run-time error!  It makes sure you have allotted enough memory
  46.   with your constants.  The compiler cannot check it with these typed scalars.}
  47.  
  48. procedure GetUserPullStats;
  49. procedure GetOverrideStats;
  50. procedure CheckGlobalKeys;
  51.  
  52.  
  53. IMPLEMENTATION
  54.  
  55. { -- Trivial utilities to get and save a menu record fro the heap -- }
  56. procedure GetMainMenu (Name: MainMenuNames);
  57. begin
  58.   MRI := ord (Name);
  59.   TopMenu := MainMenu^[MRI];
  60. end;
  61.  
  62. procedure SaveMainMenu;
  63. begin
  64.   MainMenu^[MRI] := TopMenu;
  65. end;
  66.  
  67. {$ifdef UseSubMenuCode }
  68. procedure GetSubMenu (Name: SubMenuNames);
  69. begin
  70.   MRI := ord (Name);
  71.   TopMenu := SubMenu^ [MRI];
  72. end;
  73.  
  74. procedure SaveSubMenu;
  75. begin
  76.   SubMenu^[MRI] := TopMenu;
  77. end;
  78. {$endif }
  79.  
  80. {$ifdef UseHelpWndwCode }
  81. procedure SetHelpLines (Name: HelpWndwNames; First,Last: HelpLineNames);
  82. begin
  83.   HelpWndw[ord(Name)].FirstLine := ord(First);
  84.   HelpWndw[ord(Name)].LastLine  := ord(Last);
  85. end;
  86. {$endif }
  87.  
  88. { ============================ EXEC PROCEDURES ============================== }
  89. { Place procedures for execution by menu pointers, ProcPtr, here.             }
  90. { They MUST be set to FAR calls.                                              }
  91. { --------------------------------------------------------------------------- }
  92.  
  93. {$F+}
  94. procedure DummyProc;
  95. begin
  96.   {$ifdef UseMsgLineCode }
  97.   ShowMsg (ord(ProcML));
  98.   {$endif UseMsgLineCode }
  99.   Delay (1000)
  100. end;
  101.  
  102. procedure SetQuit;
  103. begin
  104.   PopToWorkWndw := true;
  105.   Quit := true;
  106. end;
  107.  
  108. {$F-}
  109.  
  110. { ======================== GetUserPullStats ================================= }
  111. { The major configurations for all menus go here.  The program first clears   }
  112. { all RECORD values to $00.  The values below will set new values. Therefore, }
  113. { setting RECORD values to "false" or the like is not necessary.              }
  114. { --------------------------------------------------------------------------- }
  115.  
  116. procedure GetUserPullStats;
  117. begin
  118.   LocationWarning:=true;   { If true and a Submenu won't fit, a message is
  119.                              displayed. If false, you can override the
  120.                              location without the message. }
  121.  
  122.   { ------------------ Set up your colors and borders here: ---------------- }
  123.   TopLineAttr   := Black+LightGrayBG;
  124.   TopLineHattr  := White+BlackBG;
  125.  
  126.   MainMenuBattr := LightGray+BlackBG;
  127.   MainMenuHattr := Black+LightGrayBG;
  128.   MainMenuLattr := Yellow+BlackBG;
  129.   MainMenuCattr := LightGray+BlackBG;
  130.   Brdr[UserBrdr1].BrdrArray := '╒═╕││└─┘╞═╡╤│┴╪';
  131.   MainMenuBrdr  := UserBrdr1;
  132.  
  133.   {$ifdef UseSubMenuCode }
  134.   SubMenuWattr  := Black+CyanBG;
  135.   SubMenuBattr  := Black+CyanBG;
  136.   SubMenuBrdr   := SingleBrdr;
  137.   {$endif UseSubMenuCode }
  138.  
  139.   if VideoMode=7 then
  140.     begin
  141.       TopLineLattr := TopLineAttr;
  142.       MainMenuWattr:= LightGray+BlackBG;
  143.       {$ifdef UseSubMenuCode }
  144.       SubMenuHattr := Black    +LightGrayBG;
  145.       SubMenuLattr := White    +BlackBG;
  146.       SubMenuCattr := LightGray+BlackBG;
  147.       {$endif UseSubMenuCode }
  148.     end
  149.   else
  150.     begin
  151.       TopLineLattr := Red  +LightGrayBG;
  152.       MainMenuWattr:= White+BlackBG;
  153.       {$ifdef UseSubMenuCode }
  154.       SubMenuHattr := White+BlueBG;
  155.       SubMenuLattr := White+CyanBG;
  156.       SubMenuCattr := Blue +CyanBG;
  157.       {$endif UseSubMenuCode }
  158.     end;
  159.  
  160.   {$ifdef UseHelpWndwCode }
  161.   HelpWndwWattr := Black+GreenBG;
  162.   HelpWndwBattr := Black+LightGrayBG;
  163.   HelpWndwBrdr  := HdoubleBrdr;
  164.   HelpWndwModes := ZoomMode+ShadowRight+CursorOffMode;
  165.   HelpBottomRow := CRTrows-4;
  166.   {$endif UseHelpWndwCode }
  167.  
  168.   {$ifdef UseMsgLineCode }
  169.   MsgLineAttr   := Green+BlackBG;
  170.   KeyStatusAttr := Black+GreenBG;
  171.   ErrMsgAttr    := Yellow+RedBG;
  172.   MsgLineRow    := CRTrows;
  173.   {$endif UseMsgLineCode }
  174.  
  175.  
  176.   { ------------------------- Top Menu defaults ----------------------------- }
  177.   TopLineRow := 2;      { Top line menu to appear on row 2 }
  178.   MPulled    := ord(FirstMenu);  { Main menu title to be HiLited by F10. }
  179.   MoreCmdSeq := 'F';    { Sequence of command letter(s) as if keyed in.  This }
  180.                         { will be the default menu(s) pulled. }
  181.   PullDown   := false;  { Set this true if you want the command sequence}
  182.                         {  to pull down the menus at startup. }
  183.  
  184.   { ------------------- Set up your MainMenu records here: ------------------ }
  185.   MainMenuRow := 3;       { First row of Main menus to appear on screen row 3 }
  186.  
  187.   with TopMenu do
  188.   begin
  189.  
  190.     GetMainMenu (FirstMenu);
  191.     MenuMode := SingleChoice;
  192.     SingleFlagLine := 3;
  193.     Title   := 'First';
  194.     Line[1] := 'A line';
  195.     Line[2] := 'B line';
  196.     Line[3] := 'C line';
  197.     Line[4] := 'D line';
  198.     DefaultLine := 2;
  199.     MsgLineNum  := ord(MainML);
  200.     HelpWndwNum := ord(MainMenuHW);
  201.     SaveMainMenu;
  202.  
  203.     GetMainMenu (QuitMenu);
  204.   { MenuMode := ExecChoice; }   { This is the default }
  205.     Title   := 'Quit';
  206.     Line[1] := 'Stay';
  207.     Line[2] := 'Quit';          ProcPtr[2] := @SetQuit;
  208.     BackToDefault := true;
  209.     MsgLineNum  := ord(MainML);
  210.     HelpWndwNum := ord(MainMenuHW);
  211.     SaveMainMenu;
  212.  
  213.   { ----------------------- Set up your SubMenus here: --------------------- }
  214.   { Careful! -- indexes to SubMenus must be numbered in order of level; i.e.,}
  215.   { ALL SubMenus first, ALL SubSubMenus second, ALL SubSubSubMenus, ... etc. }
  216.  
  217.     {$ifdef UseSubMenuCode }
  218.  
  219.     GetSubMenu (MySubMenu);
  220.     MenuMode := SingleChoice;
  221.     SingleFlagLine := 5;
  222.     Line[1] := '1 line';
  223.     Line[2] := '2 line';
  224.     Line[3] := '3 line';
  225.     Line[4] := '4 line';
  226.     MsgLineNum  := ord(SubML);
  227.     HelpWndwNum := ord(SubMenuHW);
  228.     SaveSubMenu;
  229.  
  230.     {$endif UseSubMenuCode }
  231.  
  232.   end;  { with TopMenu }
  233.  
  234.   { ------------------ Set up your Message Lines here: ---------------------- }
  235.   { Concatenations here allow source to print on 80 col printer.              }
  236.   { All messages up to HelpML are reserved.                                   }
  237.  
  238.   {$ifdef UseMsgLineCode }
  239.   MsgLine[ord(WorkML)] :=' F1-help  F2-pull  F10-top';
  240.   MsgLine[ord(TopML)] :=' F1-help  F2-pop   LTR-cmd  ESC-return  '+
  241.                         '        '^[^Z' hilight            CR-select';
  242.   MsgLine[ord(AltML)] :=' Alt: F-First                           '+
  243.                         '                                 X-Exit';
  244.   MsgLine[ord(MainML)]:=' F1-help  F2-pop   LTR-cmd  ESC-return  '+
  245.                         '        '^[^Z' menus  '^X^Y'-hilight  CR-select';
  246.   MsgLine[ord(SubML)] :=' F1-help  F2-pop   LTR-cmd  ESC-return  '+
  247.                         '                  '^X^Y'-hilight  CR-select';
  248.   MsgLine[ord(DW_ML)] :=' F1-help  F2-pop   F10-top  ESC-restore '+
  249.                         '                              CR-enter';
  250.   MsgLine[ord(DE_ML)] :=' F1-help  F2-pull  F10-top  ESC-restore '+
  251.                         '                              CR-enter';
  252.   MsgLine[ord(SeqML)] :=' F1-help  F2-pull  F10-top              '+
  253.                         '                              CR-edit';
  254.   MsgLine[ord(HelpML)]:=' F1-return         LTR-cmd  ESC-return';
  255.   MsgLine[ord(ProcML)] :=' Processing ...';
  256.   {$endif UseMsgLineCode }
  257.  
  258.   { ------------------- Set up your Help Lines here: ------------------------ }
  259.   {$ifdef UseHelpWndwCode }
  260.  
  261.   HelpLine[ord(HLw1)]:='Work window help message';
  262.   HelpLine[ord(HLwL)]:='';
  263.  
  264.   HelpLine[ord(HLt1)]:='Move cursor and press return OR type a command';
  265.   HelpLine[ord(HLtL)]:='letter.  ESC to return to the Work window.';
  266.  
  267.   HelpLine[ord(HLm1)]:='Main menu help message';
  268.   HelpLine[ord(HLmL)]:='';
  269.  
  270.   HelpLine[ord(HLs1)]:='Submenu help message';
  271.   HelpLine[ord(HLsL)]:='';
  272.  
  273.   HelpLine[ord(HLd1)]:='This is a data entry field.  Only valid alpha-';
  274.   HelpLine[ord(HLd2)]:='numeric characters can be typed.  Full editing';
  275.   HelpLine[ord(HLd3)]:='capability:';
  276.   HelpLine[ord(HLd4)]:='  1. WordStar keys: ^A,^S,^D,^F,^G,^H,^R,^Y,^U';
  277.   HelpLine[ord(HLd5)]:='  2. Cursor keys:   Home/End, Left/Right Arrow,';
  278.   HelpLine[ord(HLd6)]:='     Ctrl-Left/Right Arrow, and Ins/Del.';
  279.   HelpLine[ord(HLdL)]:='  3. Use ^R or ^U to restore original data.';
  280.  
  281.   { ----------------------- Set up your Help Windows here: ------------------ }
  282.   { HelpWndw[ord(WorkWndwHW)] is reserved for the Work window. }
  283.   { HelpWndw[ord(TopLineHW) ] is reserved for the top line menu. }
  284.  
  285.   HelpMsgLineNum := ord(HelpML);     { Standard message for a Help window }
  286.   SetHelpLines (WorkWndwHW,HLw1,HLwL);
  287.   SetHelpLines (TopLineHW ,HLt1,HLtL);
  288.   SetHelpLines (MainMenuHW,HLm1,HLmL);
  289.   SetHelpLines (SubMenuHW ,HLs1,HLsL);
  290.   SetHelpLines (DataWndwHW,HLd1,HLdL);
  291.  
  292.   {$endif UseHelpWndwCode }
  293.  
  294. end;  { procedure GetUserPullStats }
  295.  
  296. { =========================== GetOverrideStats ============================== }
  297. { You can OVERRIDE the automatic Colors, Sizes, and Locations here.           }
  298. { --------------------------------------------------------------------------- }
  299.  
  300. procedure GetOverrideStats;
  301. begin
  302.   { No overrides included. }
  303. end;
  304.  
  305. { ========================= CHECK GLOBAL KEYS =============================== }
  306. { This procedure gives you the option to add global keys similar to TP4 such  }
  307. { as Alt-R or Alt-F3.  This is for extended keys only.                        }
  308. { --------------------------------------------------------------------------- }
  309.  
  310. const
  311.   { See the extended key code table in your manual for these values: }
  312.   AltF    = #33;    { First menu }
  313.   AltQ    = #16;    { Quit menu }
  314.   AltX    = #45;    { Immediately exit program }
  315.  
  316. procedure SetWorkWndw (WN: WindowNames);
  317. begin
  318.   PullDown        := false;
  319.   PopToWorkWndw   := true;
  320.   TopWorkWndwName := WN;
  321. end;
  322.  
  323. { -- Any of the keys can be modified.  PopKey and TopKey1 are defined in }
  324. { -- PullVars.inc. }
  325. procedure CheckGlobalKeys;
  326. begin
  327.   PullDown := true;
  328.   case Key of
  329.     PopKey:  begin PullDown:=false; PopToWorkWndw:=true; end; { F2 }
  330.     TopKey1: PopToTop:=true;                                  { F10 }
  331.     AltF:    SetCmdSeq ('F');
  332.     AltQ:    SetCmdSeq ('Q');
  333.     AltX:    SetQuit;
  334.   else
  335.     PullDown := false;
  336.   end
  337. end;
  338.  
  339. BEGIN
  340.   AddrGetUserPullStats := @GetUserPullStats;
  341.   AddrGetOverrideStats := @GetOverrideStats;
  342.   AddrCheckGlobalKeys  := @CheckGlobalKeys;
  343. END.
  344.