home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TURBOGEN.ZIP / PIBMENUS.INC < prev    next >
Encoding:
Text File  |  1987-09-24  |  47.1 KB  |  1,026 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           PIBMENUS.PAS   --- Menu Routines for Turbo Pascal          *)
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Author:  Philip R. Burns                                            *)
  6. (*                                                                      *)
  7. (*  Date:    Version 1.0: January, 1985                                 *)
  8. (*           Version 1.1: March, 1985                                   *)
  9. (*           Version 1.2: May, 1985                                     *)
  10. (*           Version 2.0: June, 1985                                    *)
  11. (*           Version 2.1: July, 1985                                    *)
  12. (*           Version 3.0: October, 1985                                 *)
  13. (*           Version 3.2: November, 1985                                *)
  14. (*                                                                      *)
  15. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
  16. (*           Note:  I have checked these on Zenith 151s under           *)
  17. (*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
  18. (*                                                                      *)
  19. (*  History: These routines represent my substantial upgrading of the   *)
  20. (*           simple menu routines written by Barry Abrahamsen which     *)
  21. (*           I believe appeared originally in the TUG newsletter.       *)
  22. (*           The windowing facility provides windows similar to those   *)
  23. (*           implemented in QMODEM by John Friel III.                   *)
  24. (*                                                                      *)
  25. (*           Version 2.0 of these adds the exploding windows feature    *)
  26. (*           as well the use-selectable box-drawing characters.         *)
  27. (*           The exploding box algorithm is derived from one by         *)
  28. (*           Jim Everingham.                                            *)
  29. (*                                                                      *)
  30. (*           Note that the routines present in PIBSCREN.PAS were        *)
  31. (*           originally part of the PIBMENUS.PAS file.  With version    *)
  32. (*           2.0 of PibMenus, PIBMENUS.PAS is split into the screen-    *)
  33. (*           handling routines in PIBSCREN.PAS and the actual menu      *)
  34. (*           routines in PIBMENUS.PAS.                                  *)
  35. (*                                                                      *)
  36. (*           Suggestions for improvements or corrections are welcome.   *)
  37. (*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
  38. (*           or Ron Fox's BBS (312) 940 6496.                           *)
  39. (*                                                                      *)
  40. (*           If you use this code in your own programs, please be nice  *)
  41. (*           and give all of us credit.                                 *)
  42. (*                                                                      *)
  43. (*----------------------------------------------------------------------*)
  44. (*                                                                      *)
  45. (*  Needs:  These routines need the include files MINMAX.PAS,           *)
  46. (*          GLOBTYPE.PAS, ASCII.PAS, and PIBSCREN.PAS. These files      *)
  47. (*          are not included here, since Turbo Pascal regrettably does  *)
  48. (*          not allow nested includes.                                  *)
  49. (*                                                                      *)
  50. (*----------------------------------------------------------------------*)
  51. (*                                                                      *)
  52. (*  What these routines do:                                             *)
  53. (*                                                                      *)
  54. (*    These routines provide a straight-forward menu-selection          *)
  55. (*    facility, similar to that used in programs like Lotus.  A pop-up  *)
  56. (*    window holds the menu.  The menu is contained in a frame.  The    *)
  57. (*    items are displayed within the frame.  The currently selected     *)
  58. (*    item is highlighted in reverse video.  You move up and down in    *)
  59. (*    the list of menu items by using the up and down arrow keys, or    *)
  60. (*    the space bar.  To make a selection, hit the Enter (Return) key.  *)
  61. (*                                                                      *)
  62. (*    Alternatively, you may hit the first character of a menu item.    *)
  63. (*    The first menu item found with that initial letter is selected.   *)
  64. (*                                                                      *)
  65. (*    The characters comprising the menu box are user-selectable.       *)
  66. (*    In addition, menus may just "pop up" onto the screen, or may      *)
  67. (*    "explode" onto the screen.                                        *)
  68. (*                                                                      *)
  69. (*----------------------------------------------------------------------*)
  70. (*                                                                      *)
  71. (*  Use:                                                                *)
  72. (*                                                                      *)
  73. (*     (1)  Define a variable of type Menu_Type, say, MYMENU.           *)
  74. (*                                                                      *)
  75. (*     (2)  Define the following entries in MYMENU:                     *)
  76. (*                                                                      *)
  77. (*             Menu_Size    --- Number of entries in this menu          *)
  78. (*             Menu_Title   --- Title for the menu                      *)
  79. (*             Menu_Row     --- Row where menu should appear (upper LHC *)
  80. (*             Menu_Column  --- Column where menu should appear         *)
  81. (*             Menu_Width   --- Width of menu                           *)
  82. (*             Menu_Height  --- Height of menu                          *)
  83. (*             Menu_Default --- Ordinal of the default menu entry       *)
  84. (*             Menu_Tcolor  --- Color to display menu text              *)
  85. (*             Menu_Bcolor  --- Color for menu background               *)
  86. (*             Menu_Fcolor  --- Color for menu frame box                *)
  87. (*                                                                      *)
  88. (*     (3)  Now for each of Menu_Size Menu_Entries, define:             *)
  89. (*             Menu_Text   --- Text of menu item                        *)
  90. (*                                                                      *)
  91. (*     (4)  Optionally call  Menu_Set_Box_Chars  to define the          *)
  92. (*          characters used to form the menu box.                       *)
  93. (*                                                                      *)
  94. (*     (5)  Optionally call Menu_Set_Explode to set the menus as either *)
  95. (*          exploding or pop-up.                                        *)
  96. (*                                                                      *)
  97. (*     (6)  Optionally call Menu_Set_Beep to turn beeping on/off.       *)
  98. (*                                                                      *)
  99. (*     (7)  Call  Menu_Display_Choices  to display menu.  The default   *)
  100. (*          menu choice will be highlighted.                            *)
  101. (*                                                                      *)
  102. (*     (8)  Call  Menu_Get_Choice  to retrieve menu choice.  The up and *)
  103. (*          down arrows, and the space bar, can be used to move         *)
  104. (*          through the menu items.  Each item is highlighted in turn.  *)
  105. (*          Whichever item is highlighted when a carriage return is     *)
  106. (*          entered is returned as the chosen item.                     *)
  107. (*                                                                      *)
  108. (*----------------------------------------------------------------------*)
  109. (*  Modified 07/87 Bob Logan to use read_keyboard (get_menu_selection)  *)
  110. (*----------------------------------------------------------------------*)
  111. (*                   Menu constants, types, and variables               *)
  112. (*----------------------------------------------------------------------*)
  113.  
  114. CONST
  115.  
  116.    Up_arrow         = ^E;    (* move up in menu code   *)
  117.    Down_arrow       = ^X;    (* move down in menu code *)
  118.    Space_bar        = #32;   (* space bar              *)
  119.    Ch_cr            = #13;   (* Carriage return *)
  120.    Ch_esc           = #27;   (* Escape *)
  121.    Ch_bell          = #07;   (* Bell *)
  122.  
  123.    Max_Menu_Items   = 30;    (* Maximum number of menu choices *)
  124.  
  125.    Dont_Erase_Menu  = FALSE;
  126.    Erase_Menu       = TRUE;
  127.  
  128. TYPE
  129.  
  130.    String40   = STRING[40]         (* Menu entry string type               *);
  131.    String80   = STRING[80]         (* Menu title string type               *);
  132.  
  133.    Menu_Entry = RECORD
  134.       Menu_Item_Text   : String40; (* Text of entry                        *)
  135.       Menu_Item_Row    : BYTE;     (* Row position of menu item            *)
  136.       Menu_Item_Column : BYTE;     (* Column position of menu item         *)
  137.    END;
  138.  
  139.    Menu_Type = RECORD
  140.       Menu_Size     : 1 .. Max_Menu_Items;    (* No. of items in menu      *)
  141.       Menu_Title    : String80;               (* Menu title                *)
  142.       Menu_Row      : BYTE;                   (* Row position of menu      *)
  143.       Menu_Column   : BYTE;                   (* Column position of menu   *)
  144.       Menu_Width    : BYTE;                   (* Width of menu             *)
  145.       Menu_Height   : BYTE;                   (* Height of menu            *)
  146.       Menu_Default  : 1 .. Max_Menu_Items;    (* Default value position    *)
  147.       Menu_TColor   : BYTE;                   (* Foreground text color     *)
  148.       Menu_BColor   : BYTE;                   (* BackGround color          *)
  149.       Menu_FColor   : BYTE;                   (* Frame color               *)
  150.  
  151.                                               (* Menu items themselves     *)
  152.       Menu_Entries  : ARRAY[ 1 .. Max_Menu_Items ] Of Menu_Entry;
  153.    END;
  154.  
  155. (* STRUCTURED *) CONST
  156.    Menu_Explode_Mode : BOOLEAN     (* TRUE to use exploding menus *)
  157.                        = FALSE;
  158.  
  159.    Menu_Beep_Mode    : BOOLEAN     (* TRUE to beep on errors      *)
  160.                        = TRUE;
  161.  
  162. (* STRUCTURED *) CONST
  163.                                    (* Box-drawing characters for menus *)
  164.    Menu_Box_Chars : RECORD
  165.                        Top_Left_Corner     : CHAR;
  166.                        Top_Line            : CHAR;
  167.                        Top_Right_Corner    : CHAR;
  168.                        Right_Line          : CHAR;
  169.                        Bottom_Right_Corner : CHAR;
  170.                        Bottom_Line         : CHAR;
  171.                        Bottom_Left_Corner  : CHAR;
  172.                        Left_Line           : CHAR;
  173.                     END
  174.                     =
  175.                     (  Top_Left_Corner     : '╒';
  176.                        Top_Line            : '═';
  177.                        Top_Right_Corner    : '╕';
  178.                        Right_Line          : '│';
  179.                        Bottom_Right_Corner : '╛';
  180.                        Bottom_Line         : '═';
  181.                        Bottom_Left_Corner  : '╘';
  182.                        Left_Line           : '│'  );
  183.  
  184. (*----------------------------------------------------------------------*)
  185. (*               Clear_Window --- Clear out lines in window             *)
  186. (*----------------------------------------------------------------------*)
  187.  
  188. PROCEDURE Clear_Window;
  189.  
  190. (*----------------------------------------------------------------------*)
  191. (*                                                                      *)
  192. (*     Procedure:  Clear_Window                                         *)
  193. (*                                                                      *)
  194. (*     Purpose:    Clears screen for current window                     *)
  195. (*                                                                      *)
  196. (*     Calling Sequence:                                                *)
  197. (*                                                                      *)
  198. (*        Clear_Window                                                  *)
  199. (*                                                                      *)
  200. (*     Calls:   Upper_Left                                              *)
  201. (*              GoToXY                                                  *)
  202. (*              ClrEol                                                  *)
  203. (*                                                                      *)
  204. (*     Remarks:                                                         *)
  205. (*                                                                      *)
  206. (*       This routine exists because of a bug in the ClrScr routine     *)
  207. (*       when used with windows on a mono monitor with overlays:  the   *)
  208. (*       entire screen, not just the current window, is (incorrectly)   *)
  209. (*       cleared.  There may be other circumstances in which ClrScr     *)
  210. (*       will fail.                                                     *)
  211. (*                                                                      *)
  212. (*----------------------------------------------------------------------*)
  213.  
  214. VAR
  215.    Ytop: INTEGER;
  216.    Xtop: INTEGER;
  217.    Ybot: INTEGER;
  218.    I   : INTEGER;
  219.  
  220. BEGIN (* Clear_Window *)
  221.  
  222.                    (*---------------------------------------*)
  223.                    (*   If you have a color monitor, try    *)
  224.                    (*   replacing the remaining code with   *)
  225.                    (*   just ClrScr.  If it works, use it!  *)
  226.                    (*---------------------------------------*)
  227.  
  228.    Upper_Left( Xtop, Ytop );
  229.    Ybot := Lower_Right_Row;
  230.  
  231.    FOR I := 1 TO ( Ybot - Ytop + 1 ) DO
  232.       BEGIN
  233.          GoToXY( 1 , I );
  234.          ClrEol;
  235.       END;
  236.  
  237.    GoToXY( 1 , 1 );
  238.  
  239. END   (* Clear_Window *);
  240.  
  241.  
  242. (*----------------------------------------------------------------------*)
  243. (*            Menu_Set_Explode --- Set explode mode on or off           *)
  244. (*----------------------------------------------------------------------*)
  245.  
  246. PROCEDURE Menu_Set_Explode( Explode_ON : BOOLEAN );
  247.  
  248. (*----------------------------------------------------------------------*)
  249. (*                                                                      *)
  250. (*     Procedure:  Menu_Set_Explode                                     *)
  251. (*                                                                      *)
  252. (*     Purpose:    Turn exploding menus on or off                       *)
  253. (*                                                                      *)
  254. (*     Calling Sequence:                                                *)
  255. (*                                                                      *)
  256. (*        Menu_Set_Explode( Explode_ON : BOOLEAN );                     *)
  257. (*                                                                      *)
  258. (*           Explode_ON --- TRUE to use exploding menus,                *)
  259. (*                          FALSE to use pop-up menus                   *)
  260. (*                                                                      *)
  261. (*     Calls:   None                                                    *)
  262. (*                                                                      *)
  263. (*----------------------------------------------------------------------*)
  264.  
  265. BEGIN (* Menu_Set_Explode *)
  266.  
  267.    Menu_Explode_Mode := Explode_ON;
  268.  
  269. END   (* Menu_Set_Explode *);
  270.  
  271. (*----------------------------------------------------------------------*)
  272. (*               Menu_Set_Beep --- Set beep mode on or off              *)
  273. (*----------------------------------------------------------------------*)
  274.  
  275. PROCEDURE Menu_Set_Beep( Beep_ON : BOOLEAN );
  276.  
  277. (*----------------------------------------------------------------------*)
  278. (*                                                                      *)
  279. (*     Procedure:  Menu_Set_Beep                                        *)
  280. (*                                                                      *)
  281. (*     Purpose:    Turn beeping (errors, etc.) on or off                *)
  282. (*                                                                      *)
  283. (*     Calling Sequence:                                                *)
  284. (*                                                                      *)
  285. (*        Menu_Set_Beep( Beep_ON : BOOLEAN );                           *)
  286. (*                                                                      *)
  287. (*           Beep_ON --- TRUE to allow beeps,                           *)
  288. (*                       FALSE to disallow beeps.                       *)
  289. (*                                                                      *)
  290. (*     Calls:   None                                                    *)
  291. (*                                                                      *)
  292. (*----------------------------------------------------------------------*)
  293.  
  294. BEGIN (* Menu_Set_Beep *)
  295.  
  296.    Menu_Beep_Mode := Beep_ON;
  297.  
  298. END   (* Menu_Set_Beep *);
  299.  
  300. (*----------------------------------------------------------------------*)
  301. (*     Menu_Set_Box_Chars --- Set box drawing characters for menus      *)
  302. (*----------------------------------------------------------------------*)
  303.  
  304. PROCEDURE Menu_Set_Box_Chars( Top_Left_Corner     : CHAR;
  305.                               Top_Line            : CHAR;
  306.                               Top_Right_Corner    : CHAR;
  307.                               Right_Line          : CHAR;
  308.                               Bottom_Right_Corner : CHAR;
  309.                               Bottom_Line         : CHAR;
  310.                               Bottom_Left_Corner  : CHAR;
  311.                               Left_Line           : CHAR  );
  312.  
  313. (*----------------------------------------------------------------------*)
  314. (*                                                                      *)
  315. (*     Procedure:  Menu_Set_Box_Chars                                   *)
  316. (*                                                                      *)
  317. (*     Purpose:    Set box characters for drawing menu boxes            *)
  318. (*                                                                      *)
  319. (*     Calling Sequence:                                                *)
  320. (*                                                                      *)
  321. (*        Menu_Set_Box_Chars( Top_Left_Corner     : CHAR;               *)
  322. (*                            Top_Line            : CHAR;               *)
  323. (*                            Top_Right_Corner    : CHAR;               *)
  324. (*                            Right_Line          : CHAR;               *)
  325. (*                            Bottom_Right_Corner : CHAR;               *)
  326. (*                            Bottom_Line         : CHAR;               *)
  327. (*                            Bottom_Left_Corner  : CHAR;               *)
  328. (*                            Left_Line           : CHAR  );            *)
  329. (*                                                                      *)
  330. (*           --- arguments are what their names suggest.                *)
  331. (*                                                                      *)
  332. (*                                                                      *)
  333. (*     Calls:   None                                                    *)
  334. (*                                                                      *)
  335. (*----------------------------------------------------------------------*)
  336.  
  337. BEGIN (* Menu_Set_Box_Chars *)
  338.  
  339.    Menu_Box_Chars.Top_Left_Corner     := Top_Left_Corner;
  340.    Menu_Box_Chars.Top_Line            := Top_Line;
  341.    Menu_Box_Chars.Top_Right_Corner    := Top_Right_Corner;
  342.    Menu_Box_Chars.Right_Line          := Right_Line;
  343.    Menu_Box_Chars.Bottom_Right_Corner := Bottom_Right_Corner;
  344.    Menu_Box_Chars.Bottom_Line         := Bottom_Line;
  345.    Menu_Box_Chars.Bottom_Left_Corner  := Bottom_Left_Corner;
  346.    Menu_Box_Chars.Left_Line           := Left_Line;
  347.  
  348. END   (* Menu_Set_Box_Chars *);
  349.  
  350. (*----------------------------------------------------------------------*)
  351. (*                Draw_Menu_Frame --- Draw a Frame                      *)
  352. (*----------------------------------------------------------------------*)
  353.  
  354. PROCEDURE Draw_Menu_Frame( UpperLeftX,  UpperLeftY,
  355.                            LowerRightX, LowerRightY : INTEGER;
  356.                            Frame_Color, Title_Color : INTEGER;
  357.                            Menu_Title: AnyStr );
  358.  
  359. (*----------------------------------------------------------------------*)
  360. (*                                                                      *)
  361. (*     Procedure:  Draw_Menu_Frame                                      *)
  362. (*                                                                      *)
  363. (*     Purpose:    Draws a titled frame using PC graphics characters    *)
  364. (*                                                                      *)
  365. (*     Calling Sequence:                                                *)
  366. (*                                                                      *)
  367. (*        Draw_Menu_Frame( UpperLeftX,  UpperLeftY,                     *)
  368. (*                         LowerRightX, LowerRightY,                    *)
  369. (*                         Frame_Color, Title_Color : INTEGER;          *)
  370. (*                         Menu_Title: AnyStr );                        *)
  371. (*                                                                      *)
  372. (*           UpperLeftX,  UpperLeftY  --- Upper left coordinates        *)
  373. (*           LowerRightX, LowerRightY --- Lower right coordinates       *)
  374. (*           Frame_Color              --- Color for frame               *)
  375. (*           Title_Color              --- Color for title text          *)
  376. (*           Menu_Title               --- Menu Title                    *)
  377. (*                                                                      *)
  378. (*     Calls:   GoToXY                                                  *)
  379. (*              Window                                                  *)
  380. (*              ClrScr                                                  *)
  381. (*              StringOf                                                *)
  382. (*              Draw_Box (internal)                                     *)
  383. (*              Do_Explosion (internal)                                 *)
  384. (*                                                                      *)
  385. (*     Remarks:                                                         *)
  386. (*                                                                      *)
  387. (*        The area inside the frame is cleared after the frame is       *)
  388. (*        drawn.  If a box without a title is desired, enter a null     *)
  389. (*        string for a title.                                           *)
  390. (*                                                                      *)
  391. (*----------------------------------------------------------------------*)
  392.  
  393. VAR
  394.    I  : INTEGER;
  395.    L  : INTEGER;
  396.    LT : INTEGER;
  397.    XM : INTEGER;
  398.    YM : INTEGER;
  399.    XS : INTEGER;
  400.    YS : INTEGER;
  401.    R  : REAL;
  402.    X1 : INTEGER;
  403.    X2 : INTEGER;
  404.    Y1 : INTEGER;
  405.    Y2 : INTEGER;
  406.    XM1: INTEGER;
  407.    YM1: INTEGER;
  408.    Knt: INTEGER;
  409.  
  410. (*----------------------------------------------------------------------*)
  411.  
  412. PROCEDURE Draw_Box( X1, Y1, X2, Y2 : INTEGER;
  413.                     Frame_Color    : INTEGER;
  414.                     Title_Color    : INTEGER;
  415.                     Title          : AnyStr   );
  416.  
  417. VAR
  418.    I  : INTEGER;
  419.    LT : INTEGER;
  420.  
  421. BEGIN (* Draw_Box *)
  422.  
  423.    Window( 1, 1, 80, 25 );
  424.  
  425.    LT := LENGTH( Title );
  426.  
  427.    IF LT > 0 THEN
  428.       BEGIN
  429.          WriteSXY( Menu_Box_Chars.Top_Left_Corner + '[ ',
  430.                    X1, Y1, Frame_Color );
  431.          WriteSXY( Title, X1 + 3, Y1, Title_Color );
  432.          WriteSXY( ' ]', X1 + LT + 3, Y1, Frame_Color );
  433.       END
  434.    ELSE
  435.       WriteSXY( Menu_Box_Chars.Top_Left_Corner +
  436.                 StringOf( Ord(Menu_Box_Chars.Top_Line) , 4 ), X1, Y1, Frame_Color );
  437.  
  438.                                    (* Draw remainder of top of frame *)
  439.  
  440.    FOR I := ( X1 + LT + 5 ) TO ( X2 - 1 ) DO
  441.       WriteCXY( Menu_Box_Chars.Top_Line, I, Y1, Frame_Color );
  442.  
  443.    WriteCXY( Menu_Box_Chars.Top_Right_Corner, X2, Y1, Frame_Color );
  444.  
  445.                                   (* Draw sides of frame *)
  446.  
  447.    FOR I := ( Y1 + 1 ) TO ( Y2 - 1 ) DO
  448.       BEGIN
  449.          WriteCXY( Menu_Box_Chars.Left_Line,  X1, I, Frame_Color );
  450.          WriteCXY( Menu_Box_Chars.Right_Line, X2, I, Frame_Color );
  451.       END;
  452.                                   (* Draw bottom of frame     *)
  453.  
  454.    WriteCXY( Menu_Box_Chars.Bottom_Left_Corner, X1, Y2, Frame_Color );
  455.  
  456.    FOR I := ( X1 + 1 ) TO ( X2 - 1 ) DO
  457.       WriteCXY( Menu_Box_Chars.Bottom_Line, I, Y2, Frame_Color );
  458.  
  459.    WriteCXY( Menu_Box_Chars.Bottom_Right_Corner, X2, Y2, Frame_Color );
  460.  
  461. END   (* Draw_Box *);
  462.  
  463. (*----------------------------------------------------------------------*)
  464.  
  465. PROCEDURE Do_Explosion;
  466.  
  467. (*----------------------------------------------------------------------*)
  468. (*               --- Basic algorithm by Jim Everingham ---              *)
  469. (*----------------------------------------------------------------------*)
  470.  
  471. BEGIN (* Do_Explosion *)
  472.  
  473.    XM     := UpperLeftX + L DIV 2;
  474.    YM     := UpperLeftY + ( LowerRightY - UpperLeftY ) DIV 2;
  475.    X1     := UpperLeftX;
  476.    X2     := LowerRightX;
  477.    Y1     := UpperLeftY;
  478.    Y2     := LowerRightY;
  479.  
  480.    XM1    := XM;
  481.    YM1    := YM;
  482.                                     (* Figure out increments for *)
  483.                                     (* increasing boz dimensions *)
  484.                                     (* to produce explosion.     *)
  485.    IF ( XM > YM ) THEN
  486.        Knt    := TRUNC( L / 2 )
  487.    ELSE
  488.        Knt    := TRUNC( ( Y2 - Y1 ) / 2 );
  489.  
  490.    Y1     := Y1 - 1;
  491.    Y2     := Y2 - 1;
  492.  
  493.    X1     := X1 + 1;
  494.    X2     := X2 - 1;
  495.                                    (* Draw series of increasing     *)
  496.                                    (* size boxes, giving appearance *)
  497.                                    (* that box "explodes" from its  *)
  498.                                    (* center.                       *)
  499.  
  500.    FOR I := 1 TO ROUND( Knt / 3 ) DO
  501.       BEGIN
  502.                                    (* Adjust sides *)
  503.  
  504.          IF ( XM > ( X1 - 2 ) ) THEN
  505.             XM := XM - 3
  506.          ELSE IF ( XM > ( X1 - 1 ) ) THEN
  507.             XM := XM - 2
  508.          ELSE IF ( XM > X1 ) THEN
  509.             XM := XM - 1;
  510.  
  511.          IF ( XM1 < ( X2 + 2 ) ) THEN
  512.             XM1 := XM1 + 3
  513.          ELSE IF ( XM1 < ( X2 + 1 ) ) THEN
  514.             XM1 := XM1 + 2
  515.          ELSE IF ( XM1 < X2 ) THEN
  516.             XM1 := XM1 + 1;
  517.  
  518.                                    (* Adjust top and bottom *)
  519.  
  520.          IF ( YM > ( Y1 + 2 ) ) THEN
  521.             YM := YM - 3
  522.          ELSE IF ( YM > ( Y1 + 1 ) ) THEN
  523.             YM := YM - 2
  524.          ELSE IF ( YM > Y1 ) THEN
  525.             YM := YM - 1;
  526.  
  527.          IF ( YM1 < ( Y2 - 2 ) ) THEN
  528.             YM1 := YM1 + 3
  529.          ELSE IF ( YM1 < ( Y2 - 1 ) ) THEN
  530.             YM1 := YM1 + 2
  531.          ELSE IF ( YM1 < Y2 ) THEN
  532.             YM1 := YM1 + 1;
  533.  
  534.                                    (* Define new window *)
  535.  
  536.          WINDOW( XM + 1, YM + 1, XM1, YM1 );
  537.  
  538.                                    (* Clear it out      *)
  539.          Clear_Window;
  540.  
  541.                                    (* Draw box          *)
  542.  
  543.          Draw_Box( XM+1, YM+1, XM1, YM1, Frame_Color, Title_Color, '' );
  544.  
  545.       END (* For *);
  546.  
  547. END   (* Do_Explosion *);
  548.  
  549. (*----------------------------------------------------------------------*)
  550.  
  551. BEGIN (* Draw_Menu_Frame *)
  552.  
  553.    L  := LowerRightX - UpperLeftX;
  554.    LT := LENGTH( Menu_Title );
  555.                                    (* Adjust title length if necessary *)
  556.  
  557.    IF LT > ( L - 5 ) THEN Menu_Title[0] := CHR( L - 5 );
  558.  
  559.                                    (* Get explosion if requested *)
  560.  
  561.    IF Menu_Explode_Mode THEN Do_Explosion;
  562.  
  563.                                    (* Display actual menu frame       *)
  564.  
  565.    Draw_Box( UpperLeftX, UpperLeftY, LowerRightX, LowerRightY,
  566.              Frame_Color, Title_Color, Menu_Title );
  567.  
  568.                                    (* Establish scrolling window area *)
  569.  
  570.    Window( UpperLeftX+1, UpperLeftY+1, LowerRightX-1, LowerRightY-1 );
  571.  
  572.    Clear_Window;
  573.  
  574.    GoToXY( 1 , 1 );
  575.                                    (* Ensure proper color for text    *)
  576.    TextColor( Title_Color );
  577.  
  578. END   (* Draw_Menu_Frame *);
  579.  
  580. (*----------------------------------------------------------------------*)
  581. (*                Menu_Click --- Make short click noise                 *)
  582. (*----------------------------------------------------------------------*)
  583.  
  584. PROCEDURE Menu_Click;
  585.  
  586. (*----------------------------------------------------------------------*)
  587. (*                                                                      *)
  588. (*     Procedure:  Menu_Click                                           *)
  589. (*                                                                      *)
  590. (*     Purpose:    Clicks Terminal Bell                                 *)
  591. (*                                                                      *)
  592. (*     Calling Sequence:                                                *)
  593. (*                                                                      *)
  594. (*        Menu_Click;                                                   *)
  595. (*                                                                      *)
  596. (*     Calls:    Sound                                                  *)
  597. (*               Delay                                                  *)
  598. (*               NoSound                                                *)
  599. (*                                                                      *)
  600. (*----------------------------------------------------------------------*)
  601.  
  602. BEGIN (* Menu_Click *)
  603.  
  604.    IF Menu_Beep_Mode THEN
  605.       BEGIN
  606.          Sound( 2000 );
  607.          DELAY( 10 );
  608.          NoSound;
  609.       END;
  610.  
  611. END   (* Menu_Click *);
  612.  
  613. (*----------------------------------------------------------------------*)
  614. (*                Menu_Beep --- Ring Terminal Bell                      *)
  615. (*----------------------------------------------------------------------*)
  616.  
  617. PROCEDURE Menu_Beep;
  618.  
  619. (*----------------------------------------------------------------------*)
  620. (*                                                                      *)
  621. (*     Procedure:  Menu_Beep                                            *)
  622. (*                                                                      *)
  623. (*     Purpose:    Rings Terminal Bell                                  *)
  624. (*                                                                      *)
  625. (*     Calling Sequence:                                                *)
  626. (*                                                                      *)
  627. (*        Menu_Beep;                                                    *)
  628. (*                                                                      *)
  629. (*     Calls:    None                                                   *)
  630. (*                                                                      *)
  631. (*     Remarks:                                                         *)
  632. (*                                                                      *)
  633. (*        If Menu_Beep_Mode is FALSE, then '<ALERT>' is displayed in    *)
  634. (*        blinking characters on line 25 for 1 second.                  *)
  635. (*                                                                      *)
  636. (*----------------------------------------------------------------------*)
  637.  
  638. VAR
  639.    I        : BYTE;
  640.    J        : BYTE;
  641.    Save_C25 : PACKED ARRAY[1..7] OF CHAR;
  642.    Save_A25 : PACKED ARRAY[1..7] OF INTEGER;
  643.  
  644. BEGIN (* Menu_Beep *)
  645.                                    (* Generate beep if beep mode on *)
  646.    IF Menu_Beep_Mode THEN
  647.       WRITE( Ch_Bell )
  648.    ELSE                            (* Else generate blinking error  *)
  649.       BEGIN
  650.                                    (* Line 25, Column 36 *)
  651.          J     := 3913;
  652.                                    (* Save character, attribute *)
  653.          FOR I := 1 TO 7 DO
  654.             WITH Actual_Screen^ DO
  655.                BEGIN
  656.                   Save_C25[I] := CHR( Screen_Image[ J ] );
  657.                   Save_A25[I] := Screen_Image[ J + 1 ];
  658.                   J           := J + 2;
  659.                END;
  660.                                    (* Display blinking error indicator *)
  661.  
  662.          WriteSXY( '<ALERT>', 36, 25, WHITE + BLINK );
  663.  
  664.          DELAY( 1000 );
  665.                                    (* Restore previous text *)
  666.          FOR I := 1 TO 7 DO
  667.             WriteCXY( Save_C25[I], 35 + I, 25, Save_A25[I] );
  668.  
  669.       END;
  670.  
  671. END   (* Menu_Beep *);
  672.  
  673. (*----------------------------------------------------------------------*)
  674. (*                Menu_Turn_On --- Highlight Menu Choice                *)
  675. (*----------------------------------------------------------------------*)
  676.  
  677. PROCEDURE Menu_Turn_On( Menu: Menu_Type; Menu_Item : INTEGER );
  678.  
  679. (*----------------------------------------------------------------------*)
  680. (*                                                                      *)
  681. (*     Procedure:  Menu_Turn_On                                         *)
  682. (*                                                                      *)
  683. (*     Purpose:    Highlight a menu item using reverse video            *)
  684. (*                                                                      *)
  685. (*     Calling Sequence:                                                *)
  686. (*                                                                      *)
  687. (*        Menu_Turn_On( Menu: Menu_Type; Menu_Item : INTEGER );         *)
  688. (*                                                                      *)
  689. (*           Menu      : Menu containing item to highlight              *)
  690. (*           Menu_Item : Menu entry to highlight                        *)
  691. (*                                                                      *)
  692. (*     Calls:    GoToXY                                                 *)
  693. (*               RvsVideoOn                                             *)
  694. (*               RvsVideoOff                                            *)
  695. (*                                                                      *)
  696. (*----------------------------------------------------------------------*)
  697.  
  698. BEGIN (* Menu_Turn_On *)
  699.  
  700.    WITH Menu.Menu_Entries[ Menu_Item ] DO
  701.       BEGIN
  702.  
  703.          GoToXY( Menu_Item_Column, Menu_Item_Row );
  704.  
  705.          RvsVideoOn( Menu.Menu_Tcolor, Menu.Menu_Bcolor );
  706.  
  707.          WRITE( Menu_Item_Text );
  708.  
  709.          RvsVideoOff( Menu.Menu_Tcolor, Menu.Menu_Bcolor );
  710.  
  711.       END;
  712.  
  713. END   (* Menu_Turn_On *);
  714.  
  715. (*----------------------------------------------------------------------*)
  716. (*                Menu_Turn_Off --- UnHighlight Menu Choice             *)
  717. (*----------------------------------------------------------------------*)
  718.  
  719. PROCEDURE Menu_Turn_Off( Menu: Menu_Type; Menu_Item : INTEGER );
  720.  
  721. (*----------------------------------------------------------------------*)
  722. (*                                                                      *)
  723. (*     Procedure:  Menu_Turn_Off                                        *)
  724. (*                                                                      *)
  725. (*     Purpose:    Removes highlighting from menu item                  *)
  726. (*                                                                      *)
  727. (*     Calling Sequence:                                                *)
  728. (*                                                                      *)
  729. (*        Menu_Turn_Off( Menu : Menu_Type; Menu_Item : INTEGER );       *)
  730. (*                                                                      *)
  731. (*           Menu        : Menu containing item to unhighlight          *)
  732. (*           RvsVideoOff : Menu entry to un-highlight                   *)
  733. (*                                                                      *)
  734. (*     Calls:    GoToXY                                                 *)
  735. (*                                                                      *)
  736. (*----------------------------------------------------------------------*)
  737.  
  738. BEGIN (* Menu_Turn_Off *)
  739.  
  740.    WITH Menu.Menu_Entries[ Menu_Item ] DO
  741.       BEGIN
  742.  
  743.          GoToXY( Menu_Item_Column , Menu_Item_Row );
  744.  
  745.          RvsVideoOff( Menu.Menu_Tcolor, Menu.Menu_Bcolor );
  746.  
  747.          WRITE( Menu_Item_Text );
  748.  
  749.       END;
  750.  
  751. END   (* Menu_Turn_Off *);
  752.  
  753. (*----------------------------------------------------------------------*)
  754. (*                Menu_Display_Choices --- Display Menu Choices         *)
  755. (*----------------------------------------------------------------------*)
  756.  
  757. PROCEDURE Menu_Display_Choices( Menu : Menu_Type );
  758.  
  759. (*----------------------------------------------------------------------*)
  760. (*                                                                      *)
  761. (*     Procedure:  Menu_Display_Choices                                 *)
  762. (*                                                                      *)
  763. (*     Purpose:    Displays Menu Choices                                *)
  764. (*                                                                      *)
  765. (*     Calling Sequence:                                                *)
  766. (*                                                                      *)
  767. (*        Menu_Display_Choices( Menu : Menu_Type );                     *)
  768. (*                                                                      *)
  769. (*           Menu --- Menu record to be displayed.                      *)
  770. (*                                                                      *)
  771. (*     Calls:   ClsScr                                                  *)
  772. (*              GoToXY                                                  *)
  773. (*              Draw_Menu_Frame                                         *)
  774. (*              Save_Screen                                             *)
  775. (*                                                                      *)
  776. (*----------------------------------------------------------------------*)
  777.  
  778. VAR
  779.    I    : INTEGER;
  780.    J    : INTEGER;
  781.    XL   : INTEGER;
  782.    YL   : INTEGER;
  783.    XR   : INTEGER;
  784.    YR   : INTEGER;
  785.    MaxX : INTEGER;
  786.    MaxY : INTEGER;
  787.  
  788. BEGIN (* Menu_Display_Choices *)
  789.  
  790.                                    (* Establish menu size *)
  791.  
  792.    XL := Menu.Menu_Column;
  793.    YL := Menu.Menu_Row;
  794.  
  795.    XR := LENGTH( Menu.Menu_Title ) + XL - 1;
  796.    YR := YL;
  797.  
  798.    MaxX := Menu.Menu_Width;
  799.    MaxY := Menu.Menu_Height;
  800.  
  801.    FOR I := 1 TO Menu.Menu_Size DO
  802.       WITH Menu.Menu_Entries[I] DO
  803.       BEGIN
  804.          IF Menu_Item_Row > MaxY THEN MaxY := Menu_Item_Row;
  805.          J := LENGTH( Menu_Item_Text ) + Menu_Item_Column - 1;
  806.          IF J > MaxX THEN MaxX := J;
  807.       END;
  808.  
  809.    J := XL + MaxX - 1;
  810.    IF J > XR THEN XR := J;
  811.  
  812.    J := YL + MaxY - 1;
  813.    IF J > YR THEN YR := J;
  814.  
  815.    XL := XL - 4;
  816.    IF XL < 0 THEN XL := 0;
  817.  
  818.    YL := YL - 1;
  819.    IF YL < 0 THEN YL := 0;
  820.  
  821.    YR := YR + 1;
  822.    IF YR > 25 THEN YR := 25;
  823.  
  824.    IF XR > 80 THEN XR := 80;
  825.  
  826. {   Problem with tandy 2000 - mono card not at correct address I think
  827.     so this has been taken out for now.......
  828.     If running on a true PC put this back in and have at it...
  829.     in the meantime I just stack the windows on the screen...
  830.     use clear_window... or function F8 (redraw) if things get cluttered.
  831.  
  832.  
  833.                                  (* Save current screen image *)
  834.                                    (* if not already saved      *)
  835.  
  836.    IF Current_Saved_Screen > 0 THEN
  837.       BEGIN
  838.          IF Saved_Screen_List[ Current_Saved_Screen ] <> Saved_Screen THEN
  839.             Save_Screen( Saved_Screen )
  840.       END
  841.    ELSE
  842.       Save_Screen( Saved_Screen );
  843.  }
  844.                                    (* Draw the menu frame       *)
  845.  
  846.    Draw_Menu_Frame( XL, YL, XR, YR, Menu.Menu_FColor, Menu.Menu_TColor,
  847.                     Menu.Menu_Title );
  848.  
  849.                                    (* Display Menu Entries *)
  850.  
  851.    FOR I := 1 TO Menu.Menu_Size DO
  852.       WITH Menu.Menu_Entries[I] DO
  853.          BEGIN
  854.             GoToXY( Menu_Item_Column , Menu_Item_Row );
  855.             WRITE( Menu_Item_Text );
  856.          END;
  857.                                    (* Highlight Default Choice *)
  858.  
  859.    Menu_Turn_On( Menu, Menu.Menu_Default );
  860.  
  861. END   (* Menu_Display_Choices *);
  862.  
  863. (*----------------------------------------------------------------------*)
  864. (*                Menu_Get_Choice --- Get Menu Choice                   *)
  865. (*----------------------------------------------------------------------*)
  866.  
  867. FUNCTION Menu_Get_Choice( Menu: Menu_Type; Erase_After: BOOLEAN ) : INTEGER;
  868.  
  869. (*----------------------------------------------------------------------*)
  870. (*                                                                      *)
  871. (*     Function:  Menu_Get_Choice                                       *)
  872. (*                                                                      *)
  873. (*     Purpose:   Retrieves Menu Choice from current menu               *)
  874. (*                                                                      *)
  875. (*     Calling Sequence:                                                *)
  876. (*                                                                      *)
  877. (*        Ichoice := Menu_Get_Choice( Menu       : Menu_Type;           *)
  878. (*                                    Erase_After: BOOLEAN ) : INTEGER; *)
  879. (*                                                                      *)
  880. (*           Menu        --- Currently displayed menu                   *)
  881. (*           Erase_After --- TRUE to erase menu after choice found      *)
  882. (*           Ichoice     --- Returned menu item chosen                  *)
  883. (*                                                                      *)
  884. (*      Calls:   Menu_Click                                             *)
  885. (*               Read_KeyBoard                                          *)
  886. (*               Menu_Turn_Off                                          *)
  887. (*               Menu_Turn_On                                           *)
  888. (*                                                                      *)
  889. (*      Remarks:                                                        *)
  890. (*                                                                      *)
  891. (*         The current menu item is highlighted in reverse video.       *)
  892. (*         It may be chosen by hitting the return key.  Movement        *)
  893. (*         to other menu items is done using the up-arrow and           *)
  894. (*         down-arrow.                                                  *)
  895. (*                                                                      *)
  896. (*         An item may also be chosen by hitting the first character    *)
  897. (*         of that item.                                                *)
  898. (*                                                                      *)
  899. (*----------------------------------------------------------------------*)
  900.  
  901. VAR
  902.    C       : CHAR;
  903.    Current : INTEGER;
  904.    Last    : INTEGER;
  905.    I       : INTEGER;
  906.    Found   : BOOLEAN;
  907.  
  908. BEGIN  (* Menu_Get_Choice *)
  909.    Found := True;
  910.    Current := Menu.Menu_Default;
  911.    Last    := Current - 1;
  912.    IF Last < 1 THEN Last := Menu.Menu_Size;
  913.  
  914.    REPEAT  (* Loop until return key hit *)
  915.  
  916.                                    (* Read a character *)
  917.       Result := Read_keyboard('W');
  918.       if length(result) = 1 then C := UpCase( result[1] );
  919.                                    (* Convert character to menu code *)
  920.       If (Result = 'Down') or (Result = ' ') or (Result = 'Right') then
  921.          BEGIN (* Move down menu *)
  922.            Last    := Current;
  923.            Current := Current + 1;
  924.            IF Current > Menu.Menu_Size THEN
  925.            Current := 1;
  926.            Menu_Turn_Off( Menu, Last    );
  927.            Menu_Turn_On ( Menu, Current );
  928.  
  929.          END ELSE
  930.          if (Result = 'Up') or (Result = 'Left') or (Result = 'BackSpace') then
  931.             begin {move up in menu}
  932.                Last    := Current;
  933.                Current := Current - 1;
  934.                IF Current < 1 THEN
  935.                Current := Menu.Menu_Size;
  936.                Menu_Turn_Off( Menu, Last    );
  937.                Menu_Turn_On ( Menu, Current );
  938.  
  939.             END  else
  940.           If (Result = 'Return') or (Result = 'End') then
  941.             begin
  942.               Found := True;
  943.               Result := 'Return';
  944.             end else
  945.              begin
  946.               Found := FALSE;
  947.  
  948.               FOR I := 1 TO Menu.Menu_Size DO
  949.                IF C = UpCase( Menu.Menu_Entries[I].Menu_Item_Text[1] ) THEN
  950.                   BEGIN
  951.                      Found   := TRUE;
  952.                      Result  := 'Return';
  953.                      Last    := Current;
  954.                      Current := I;
  955.                   END;
  956.  
  957.               END (*  *);
  958.  
  959.    UNTIL Result = 'Return';
  960.    If not found then menu_beep;
  961.                                    (* Return index of chosen value *)
  962.    Menu_Get_Choice := Current;
  963.  
  964.                                    (* Erase menu from display      *)
  965.    IF Erase_After THEN
  966.       BEGIN                        (* Restore previous screen      *)
  967.          Restore_Screen( Saved_Screen );
  968.                                    (* Restore global colors        *)
  969.          Reset_Global_Colors;
  970.       END;
  971.  
  972. END   (* Menu_Get_Choice *);
  973.  
  974. Procedure HELP_function;
  975.  
  976. Begin
  977.   Clear_window;
  978.   Textcolor(Yellow);
  979.   GotoXY(26, 1);
  980.   Write('Function Key Help Screen');
  981.   GotoXY(10, 2);
  982.   Write('║                                                     ║');
  983.   GotoXY(10, 3);
  984.   Write('║         F1  - Next record in file.                  ║');
  985.   GotoXY(10, 4);
  986.   Write('║         F2  - Previous record in file.              ║');
  987.   GotoXY(10, 5);
  988.   Write('║         F3  - First Record in file.                 ║');
  989.   GotoXY(10, 6);
  990.   Write('║         F4  - Last Record in file.                  ║');
  991.   GotoXY(10, 7);
  992.   Write('║         F5  - Find a record from partial key.       ║');
  993.   GotoXY(10, 8);
  994.   Write('║         F6  - List file to printer.                 ║');
  995.   GotoXY(10, 9);
  996.   Write('║         F7  - Reports.                              ║');
  997.   GotoXY(10,10);
  998.   Write('║         F8  - Redraw screen with current data.      ║');
  999.   GotoXY(10,11);
  1000.   Write('║         F9  - This help screen.                     ║');
  1001.   GotoXY(10,12);
  1002.   Write('║        F10  - Quit.                                 ║');
  1003.   GotoXY(10,13);
  1004.   Write('╠═════════════════════════════════════════════════════╣');
  1005.   GotoXY(10,14);
  1006.   Write('║                                                     ║');
  1007.   GotoXY(10,15);
  1008.   Write('║     Arrows  - Move cusror in pointed direction.     ║');
  1009.   GotoXY(10,16);
  1010.   Write('║        Tab  - Move to next field.                   ║');
  1011.   GotoXY(10,17);
  1012.   Write('║     Return  - Save contents of screen to file.      ║');
  1013.   GotoXY(10,18);
  1014.   Write('║       Home  - Move to First field.                  ║');
  1015.   GotoXY(10,19);
  1016.   Write('║        Esc  - Quit.                                 ║');
  1017.   GotoXY(10,20);
  1018.   Write('║   Ctrl-End  - Delete from cursor to End Of Field.   ║');
  1019.   GotoXY(10,21);
  1020.   Write('║  Ctrl-Home  - Clear screen fields goto first field. ║');
  1021.   GotoXY(10,22);
  1022.   Write('║ Ctrl-PrtSc  - Print Screen to current print device. ║');
  1023.   GotoXY(10,23);
  1024.   Write('║                                                     ║');
  1025. End;
  1026.