home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TEGL6B.ZIP / INTROPAK.EXE / MENUDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-26  |  15.3 KB  |  394 lines
  1. {-----------------------------------------------------------------------------}
  2. {               TEGL Windows ToolKit II                  }
  3. {          Copyright (C) 1990, TEGL Systems Corporation              }
  4. {                All Rights Reserved.                  }
  5. {-----------------------------------------------------------------------------}
  6. {$M 16384, 64000, 655000 }
  7.  
  8. {$I switches.inc}
  9.  
  10. USES
  11.     Dos,
  12.     crt,
  13.     errorlog,
  14.     TGraph,
  15.     {$IFNDEF TEGLDEMO}
  16.     teglfnt2,
  17.     {$ENDIF}
  18.     TeglFont,
  19.     FastGrph,
  20.     TEGLIntr,
  21.     TEGLMenu,
  22.     TEGLUnit,
  23.     virtmem,
  24.     teglmain;
  25.  
  26.  
  27. const
  28.     BeepTimes  : word = 3;
  29.     DropClick  : word = 0;
  30.     DropClick1 : boolean = TRUE;
  31.     DropClick2 : boolean = FALSE;
  32.     DropClick3 : boolean = FALSE;
  33.  
  34.  
  35. { This event provides the standard exit. }
  36. {$F+}
  37. Function ExitOption(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  38. {$F-}
  39.    BEGIN
  40.       AbortExit('Menu keys test');
  41.    END;
  42.  
  43. { This event is only added by the AddEntry event. When clicked on, this
  44.   event drops its own option menu entry from the menu.}
  45. {$F+}
  46. Function DeleteEntry(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  47. {$F-}
  48.    var OM : optionmptr;
  49.    begin
  50.       {returns the related Option Menu chain}
  51.       OM := GetFSOM(fs);
  52.  
  53.       {Drops the current option entry, using the
  54.        ms^.clicknumber as the entry number}
  55.       DropOptionEntry(OM,ms^.clicknumber);
  56.  
  57.       deleteEntry := 1;
  58.    end;
  59.  
  60. { AddEntries demonstrates how you can retrieve the current Option Menu and
  61.   its related Option entry and insert another option entry into the current
  62.   option menu.}
  63. {$F+}
  64. Function AddEntries(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  65. {$F-}
  66.    var OM : optionmptr;
  67.    begin
  68.       {returns the related Option Menu chain}
  69.       OM := GetFSOM(fs);
  70.  
  71.       {sets the Option entry position in preparation of inserting another
  72.        entry. If the option entry number is 0, DefineOptions will create
  73.        an entry at the beginning of the chain. }
  74.       SetCurrentOEPos(OM,ms^.clicknumber-1);
  75.  
  76.       {use the standard DefineOptions()
  77.             DefineOptionsRadio()
  78.             DefineOptionsCheck()
  79.              or DefineOptionsSub()
  80.        to create a new entry}
  81.  
  82.       DefineOptions(OM,'~D~elete Entry ',TRUE,deleteentry);
  83.       AddEntries := 1;
  84.    end;
  85.  
  86.  
  87. { You can change the action of the menu bar to drop down menus in which the
  88.   menu drops with a passing of the mouse. "dropclick" is an automatic variable
  89.   which is by the menu routines before calling this event. The value in the
  90.   "dropclick" is either 0 or 1 as passed by the DefineOptionsRadio() below. }
  91.  
  92. {$F+}
  93. Function DropClickToggle(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  94. {$F-}
  95.    begin
  96.       {resets the complete mouseclick chain stored in a FS to MSClick or
  97.        MSSense. MSClick is a boolean value of 0, and MSSense is 1.}
  98.       ResetMSClickSense(fs^.relatedstack,boolean(dropclick));
  99.  
  100.       DropClickToggle := 1;
  101.    end;
  102.  
  103.  
  104. { Acknowledge is a simple event that aknowledges that it has been called
  105.   by beeping. The number of beeps is controlled by the variable Beeptimes;
  106.   which is an automatic variable updated by the menu routines. For more
  107.   info on automatic variables, look at the menu defines for DefineOptionsRadio(). }
  108.  
  109. {$F+}
  110. Function Acknowledge(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  111. {$F-}
  112.    var i : word;
  113.    BEGIN
  114.       {Use WaitforUserRelease to wait for the user to release either the key
  115.        or mouse button before proceeding. Waiting for the user to release the
  116.        mouse button is not necessary in a menu since the menu waits for you
  117.        to release before calling the event. However if you use the same event
  118.        for icons or other defined mouse click areas, this event may be
  119.        called several times before the button is release.}
  120.  
  121.       WaitForUserRelease;
  122.  
  123.       for i:=1 to BeepTimes do
  124.      begin
  125.         Beep(1000,1,150);
  126.         Beep(500,1,50);
  127.      end;
  128.       Acknowledge := 1;
  129.    END;
  130.  
  131.  
  132. { Defining the option menus may be defined within a procedure or at the
  133.   MAIN part of the program. }
  134.  
  135. procedure CreateMenuBarEvents;
  136.    VAR    om1,om2,om3,om4,om5,om6 : optionmptr;
  137.    begin
  138.       {StandardFont is set with the initialization of TEGL in Fastgrph.
  139.        When creating Option menus, the proportional flag is saved with
  140.        each option menu, therefore if you wish to have non-proportional
  141.        menus, you must set the proportional flag off before creating
  142.        the option menu.}
  143.  
  144.       setproportional(True);
  145.  
  146.       {OM1 is a standard menu with each entry attached to the Acknowledge event.
  147.        The dashed line is used to indicate a line separator between topics.}
  148.       {$IFNDEF TEGLDEMO}
  149.       standardfont := @ROMAN25;
  150.       {$ELSE}
  151.       standardfont := @font14;
  152.       {$ENDIF}
  153.  
  154.       OM1 := CreateOptionMenu(standardfont);
  155.       DefineOptions(OM1,'DeskTop Info...',TRUE,Acknowledge);
  156.       DefineOptions(OM1,'--',FALSE,nilunitproc);
  157.       DefineOptions(OM1,'Calculator',TRUE,Acknowledge);
  158.       DefineOptions(OM1,'Clock',TRUE,Acknowledge);
  159.       DefineOptions(OM1,'Snapshot',TRUE,Acknowledge);
  160.  
  161.  
  162.       {OM2 uses a combination of several features offered in TEGLMENU.
  163.        The first is the ">" symbol in Open. This symbol tells the option
  164.        menu (when listing) to right justify the remaining portion of the
  165.        text.
  166.  
  167.        The curly brackets around F1^ will display F1^ in tiny font.
  168.  
  169.        The tilde ~ character indicates the underscoring of the enclosed
  170.        characters, of which the first character becomes the default keyboard
  171.        activator.
  172.  
  173.        Global key clicks like Alt-x and ctrl-F1 must be defined using the
  174.        definelocal and defineglobal key clicks. The menu routine only
  175.        recognizes alphabets and numeric characters when attaching
  176.        local key clicks. }
  177.  
  178.       SetMenuMargin(0);
  179.       OM2 := CreateOptionMenu(standardfont);
  180.       DefineOptions(OM2,'Open >{ctrl-F1}',TRUE,Acknowledge);
  181.       DefineOptions(OM2,'Show ~I~nfo...',FALSE,Acknowledge);
  182.       DefineOptions(OM2,'--',FALSE,nilunitproc);
  183.       DefineOptions(OM2,'~N~ew Folder...',FALSE,Acknowledge);
  184.       DefineOptions(OM2,'~C~lose',FALSE,Acknowledge);
  185.       DefineOptions(OM2,'Close ~W~indow',FALSE,Acknowledge);
  186.       DefineOptions(OM2,'--',FALSE,nilunitproc);
  187.       DefineOptions(OM2,'~F~ormat...',TRUE,Acknowledge);
  188.       DefineOptions(OM2,'To ~O~utput',TRUE,Acknowledge);
  189.       DefineOptions(OM2,'{ALT-X}~Q~uit',TRUE,exitoption);
  190.       DefineGlobalKeyClickArea(NIL,NIL,$082d,false,exitoption);
  191.       DefineGlobalKeyClickArea(NIL,NIL,$003b,false,Acknowledge);
  192. {     setommaxwidth(om2,50); }
  193.  
  194.       { DefineOptionsRadio provides a method of toggling between options or
  195.     group of options. The controlling variable is updated automatically
  196.     by the menu handler before the your event is called. You can use
  197.     "Nilunitproc" if you don't need any other activity after the user
  198.     has toggle the appropriate menu choices.
  199.  
  200.     The parameters 1,2,3,4 in DefineOptionsRadio is the value that is used
  201.     to compare against the variable BeepTimes in determing whether or not
  202.     the entry is prefixed with a check mark. When defining radio
  203.     entries, be sure to set the menu margins to 10 or more pixels to
  204.     allow room for the check mark symbol.}
  205.  
  206.       SetMenuMargin(10);
  207.       OM3 := CreateOptionMenu(standardfont);
  208.       DefineOptionsRadio(OM3,'~C~lick Menus',TRUE,DropClickToggle,0,DropClick);
  209.       DefineOptionsRadio(OM3,'~D~rop Menus',TRUE,DropClickToggle,1,DropClick);
  210.  
  211.       DefineOptions(OM3,'-',FALSE,nilunitproc);
  212.       DefineOptionsCheck(OM3,'~A~-Toggle',TRUE,nilunitproc,DropClick1);
  213.       DefineOptionsCheck(OM3,'~B~-Toggle',TRUE,nilunitproc,DropClick2);
  214.       DefineOptionsCheck(OM3,'~C~-Toggle',TRUE,nilunitproc,DropClick3);
  215.  
  216.       DefineOptions(OM3,'-',FALSE,nilunitproc);
  217.       DefineOptionsCheck(OM3,'~S~ound On',TRUE,Acknowledge,BeepStatus);
  218.       DefineOptions(OM3,'-',FALSE,nilunitproc);
  219.       DefineOptionsRadio(OM3,'Beep ~1~ time ',TRUE,Acknowledge,1,BeepTimes);
  220.       DefineOptionsRadio(OM3,'Beep ~2~ times',TRUE,Acknowledge,2,BeepTimes);
  221.       DefineOptionsRadio(OM3,'Beep ~3~ times',FALSE,Acknowledge,3,BeepTimes);
  222.       DefineOptionsRadio(OM3,'Beep ~4~ times',TRUE,Acknowledge,4,BeepTimes);
  223.  
  224.  
  225.       {Two other unique features of TEGLMENU is used in this option menu. The
  226.       Addentries event is added as a menu entry, which when activated, inserts
  227.       another option entry above the current entry. The inserted entry is a
  228.       delete option entry, which when activated, will delete itself from the
  229.       option menu. Refer to the events above to see how this is done...
  230.       The Delete entry at the bottom of the menu demonstrates that even the
  231.       last entry can be deleted.
  232.  
  233.       The defineoptionsSub() is introduced here, allowing the linking of
  234.       several option menus including itself for a recursive chaining of menus.
  235.       Again watch for the menumargins. A margin must be provided on the right
  236.       side for displaying the submenu symbol (). In the example below, the
  237.       largest entry is longer than the defineoptionsSub entry, thereby
  238.       allowing us to use a menu margin of 5 without the submenu symbol
  239.       overlapping with our option entry text.}
  240.  
  241.       SetMenuMargin(5);
  242.       OM4 := CreateOptionMenu(standardfont);
  243.       DefineOptions(OM4,'~A~dd More Entries ',TRUE,Addentries);
  244.       DefineOptions(OM4,'Chance ~I~nfo...',TRUE,Acknowledge);
  245.       DefineOptions(OM4,'~F~rame Test Write...',TRUE,Acknowledge);
  246.       DefineOptions(OM4,'~C~redit Option.',TRUE,Acknowledge);
  247.       DefineOptions(OM4,'~D~os Shell...',TRUE,Acknowledge);
  248.       DefineOptionsSub(OM4,'~S~ort Options',TRUE,OM3);
  249.       DefineOptionsSub(OM4,'More ~O~ptions',TRUE,OM2);
  250.       DefineOptionsSub(OM4,'~R~ecursive',TRUE,OM4);
  251.       DefineOptions(OM4,'--',FALSE,nilunitproc);
  252.       DefineOptions(OM4,'Select Nothing...',TRUE,Acknowledge);
  253.       DefineOptions(OM4,'Show Memory...',TRUE,Acknowledge);
  254.       DefineOptions(OM4,'Show ~B~utton Status',TRUE,Acknowledge);
  255.       DefineOptions(OM4,'Set ~M~ouse Sensivity',TRUE,Acknowledge);
  256.       DefineOptions(OM4,'--',FALSE,nilunitproc);
  257.       DefineOptions(OM4,'~A~dd More Entries ',TRUE,Addentries);
  258.       DefineOptions(OM4,'Delete ~E~ntry ',TRUE,deleteentry);
  259.  
  260.       {TEGL automatically converts menus to menus with sliders when the
  261.        number of entries displayed is greater than the screen size. You
  262.        can adjust the display number to a smaller size}
  263.  
  264.       SetOMDisplaynum(om4,15);
  265.  
  266.       {The last option menu demonstrates the ability to create long menu
  267.       entries. The current maximum is set to 40 characters per menu entry.
  268.       You can change this by changing the constant MaxTextStringSize which is
  269.       defined at the top of the TEGLMENU module.
  270.  
  271.       Notice the use of the | character in |Types |Variables |Attributes and
  272.       |Objects.  This is the tab expansion character allowing simple formating
  273.       on the menu.  }
  274.  
  275.  
  276.       OM5 := CreateOptionMenu(standardfont);
  277.       DefineOptions(OM5,'~S~tandard Unit Dependencies',TRUE,Acknowledge);
  278.       DefineOptions(OM5,'The System Unit',TRUE,Acknowledge);
  279.       DefineOptions(OM5,'The Printer Unit',TRUE,Acknowledge);
  280.       DefineOptions(OM5,'--',FALSE,nilunitproc);
  281.       DefineOptions(OM5,'The Dos Unit',TRUE,Acknowledge);
  282.       DefineOptions(OM5,'Constants |Types |Variables',TRUE,Acknowledge);
  283.       DefineOptions(OM5,'Methods |Attributes |Objects',TRUE,Acknowledge);
  284.       DefineOptions(OM5,'File |Streams |TEGL',TRUE,Acknowledge);
  285.       DefineOptions(OM5,'~A~dd More Entries ',TRUE,Addentries);
  286.       DefineOptions(OM5,'--',FALSE,nilunitproc);
  287.       DefineOptions(OM5,'Interrupt Support Procedures',TRUE,Acknowledge);
  288.       DefineOptions(OM5,'Disk Status Functions',TRUE,Acknowledge);
  289.       DefineOptions(OM5,'File-Handling Procedures and functions',TRUE,Acknowledge);
  290.  
  291.       SetTEGLFont(standardfont);
  292.     CreateBarMenu(0,0,getmaxx);
  293.     SetBarMenuMargin(24);
  294.     OutBarOption(' ~D~esk  ',OM1);
  295.     setmousebutton(stackptr^.msptr,2);
  296.     OutBarOption(' ~F~ile  ',OM2);
  297.     OutBarOption(' ~V~iew  ',OM3);
  298.     OutBarOption(' A ~S~econd Chance ',OM4);
  299.     OutBarOption(' Standard ~U~nits ',OM5);
  300.     OutBarEvent(' ~B~eep ',Acknowledge);
  301.       ResetMSClickSense(stackptr,boolean(dropclick));
  302.  
  303.  
  304.       {Define the ESC key to simulate a function key for escaping from menus}
  305.       DefineglobalKeyClickArea(stackptr,NIL,$0001,FALSE,nilunitproc);
  306.  
  307.       {If you don't need it later, you can use the following to drop the ESC}
  308.       {DropKeyClick(NIL,$0001,nilunitproc);                    }
  309.    end;
  310.  
  311.  
  312. BEGIN
  313.    easytegl;
  314.  
  315.    {There are a number of variables that are used to control the visual
  316.     aspects of the menus. The MC table stores the setup values for the
  317.     menu in which you can create a similar table with your default values
  318.     and simply assign the whole table to MC.
  319.  
  320.     As an example, a HERC_MC table has been created for your in TEGLMENU.  If
  321.     you are using a Hercules monitor you can use the following statement
  322.     to set your menu defaults immediately.
  323.  
  324.     IF Getmaxcolor < 2 then  (* set B/W parms *)
  325.        MC := HERC_MC;
  326.  
  327.     If you only need to set a few default parameters, here is a quick summary
  328.     of the functions that are available that you may use to control your menu
  329.     displays....
  330.  
  331.     SetOptionMenuColors(activecolor,inactivecolor:Word);
  332.     ... Sets the active and inactive text entry colors within the menu.
  333.     The default colors is set to Black and lightgray respectively.
  334.  
  335.     SetOptionMenuBorderColor(Color:Word);
  336.     ... Sets the Border color around the menu.
  337.     The default border color is black.
  338.  
  339.     SetBarTextColor(Color:Word);
  340.     ... Sets the text color on the bar menu. Default is Black.
  341.  
  342.     SetBarMenuMargin(margin:Word);
  343.     ... Sets the left margin on the Bar menu. Useful if you wish to display an
  344.     icon at the upper left corner of the bar menu. The default is an
  345.     indentation of 16 pixels from the left part of the bar menu.
  346.  
  347.     SetBarMenuColor(Color:Word);
  348.     ... Sets the Bar menu Color. Default is white.
  349.  
  350.     SetBarBorderOff;
  351.     ... Sets the Border off. Default is on.
  352.  
  353.     SetBarBorderColor(Color:Word);
  354.     ... Sets the Bar Border color and turns the border on. Default is black.
  355.  
  356.     SetHideSubMenu(on_off:Boolean);
  357.     ... You can choose whether to hide the option menu after the user makes a
  358.     selection. The default is the menu remains shown until the event
  359.     completes its task and returns.
  360.  
  361.     SetMenuMargin(pixsize:word);
  362.     ... Sets the option menu margin. The default is 10 pixels before the
  363.     option entry text. A minimum of 10 pixels is needed for check mark
  364.     option entries.
  365.  
  366.     SetMenuTabsize(charnum:word);
  367.     ... Sets the number of characters for tab expansion. A tab is represented
  368.     by the | character. The default is 8 characters.
  369.  
  370.     SetSeparatorLine(mask:word);
  371.     ... Sets the mask for the line separator. A dotted line is $EE and a
  372.     solidline is $FF. The default is a solidline.
  373.  
  374.     SetInactiveJaggies(on_off:Boolean);
  375.     ... Inactive option entries may be displayed with jagged characters. The
  376.     default is off.
  377.  
  378.     SetOMSliderSize(width,height:word);
  379.     ... Sets the width and height of the slider buttons. Minimum button size
  380.     is 9x9}
  381.  
  382.  
  383.    SetOMSliderSize(15,12);
  384.    SetHideSubMenu(FALSE);
  385.    SetMenuTabsize(12);
  386. {  SetSeparatorLine($EE);} {creates dashed separator lines}
  387.    CreateMenuBarEvents;
  388.  
  389.    {Sets the ctrlbreak key to the exit event}
  390.    SetCtrlBreakFS(ExitOption);
  391.  
  392.    TEGLSupervisor;
  393. END.
  394.