home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ENHMEN.ZIP / DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-29  |  8.7 KB  |  253 lines
  1. {$A+,B+,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X+}
  2. {$M 16384,0,655360}
  3. Program enhMenusDemonstration;
  4. Uses App, Objects, Drivers, Views, enhMenus;
  5.  
  6. Type
  7.    PHelpWindow               =   ^enhHelpWindow;
  8.    enhHelpWindow             =   Object (TWindow)
  9.                                     Constructor  Init(InView:PView; aTitle:String; Modal:Boolean);
  10.                                     Procedure    HandleEvent(var Event:TEvent); virtual;
  11.                                  End;
  12.  
  13.    PStatusLine               =   ^enhStatusLine;
  14.    enhStatusLine             =   Object (TStatusLine)
  15.                                     Function     Hint(aHelpCtx:Word):String; virtual;
  16.                                  End;
  17.    enhMenusDemo              =   Object (TApplication)
  18.                                     Procedure    InitMenuBar; virtual;
  19.                                     Procedure    InitStatusLine; virtual;
  20.                                     Procedure    HandleEvent(var Event:TEvent); virtual;
  21.                                     Procedure    GetEvent(var Event:TEvent); virtual;
  22.                                  End;
  23.  
  24. Const
  25.    hcFile                    =   5000;
  26.    hcOpen                    =   5001;
  27.    hcSave                    =   5002;
  28.    hcChangeDir               =   5003;
  29.    hcExit                    =   5004;
  30.    hcMenu                    =   5005;
  31.  
  32.    hcSubMenu                 =   5100;
  33.    hcValid                   =   5101;
  34.    hcCancel                  =   5102;
  35.  
  36.    hcHelpContents            =   1000;
  37.    hcHelpIndex               =   1001;
  38.    hcHelpTopic               =   1002;
  39.    hcHelpPrevious            =   1003;
  40.    hcHelpHelp                =   1004;
  41.    hcHelp                    =   1005;
  42.  
  43.    hcHelpWindow              =   1100;
  44.  
  45.    cmSave                    =   100;
  46.    cmOpen                    =   101;
  47.    cmChangeDir               =   102;
  48.  
  49.    cmHelpContents            =   300;
  50.    cmHelpIndex               =   301;
  51.    cmHelpTopic               =   302;
  52.    cmHelpPrevious            =   303;
  53.    cmHelpHelp                =   304;
  54.  
  55.  
  56. Constructor enhHelpWindow.Init(InView:PView; aTitle:String; Modal:Boolean);
  57. Var
  58.    Bounds                    :   TRect;
  59.  
  60. Begin
  61.    InView^.GetBounds(Bounds);
  62.    Bounds.A.X:=(Bounds.B.X-30) div 2;
  63.    Bounds.A.Y:=(Bounds.B.Y-10) div 2;
  64.    Bounds.B.X:=Bounds.A.X+30;
  65.    Bounds.B.Y:=Bounds.A.Y+10;
  66.    TWindow.Init(Bounds, aTitle, 0);
  67.    If Modal Then
  68.       Flags:=Flags and not (wfGrow+wfZoom);
  69.    HelpCtx:=hcHelpWindow;
  70. End;
  71.  
  72. Procedure enhHelpWindow.HandleEvent(var Event:TEvent);
  73. Begin
  74.    If (((Event.What=evKeyboard) and (Event.KeyCode=kbEsc))
  75.       or ((Event.What=evCommand) and (Event.Command=cmClose)))
  76.       and (State and sfModal=sfModal)
  77.    Then Begin
  78.       EndModal(cmClose);
  79.       ClearEvent(Event);
  80.    End
  81.    Else
  82.       TWindow.HandleEvent(Event);
  83. End;
  84.  
  85. Function enhStatusLine.Hint(aHelpCtx:Word):String;
  86. Var
  87.    St                        :   String;
  88.  
  89. Begin
  90.    Case aHelpCtx of
  91.       hcFile:
  92.          St:='File operations (open, save, change dir, etc...)';
  93.       hcOpen:
  94.          St:='Open a file';
  95.       hcSave:
  96.          St:='Save current file';
  97.       hcChangeDir:
  98.          St:='Change default directory';
  99.       hcExit:
  100.          St:='Exit to DOS';
  101.       hcHelp:
  102.          St:='Online help menu';
  103.       hcHelpContents:
  104.          St:='Show the help table of contents';
  105.       hcHelpIndex:
  106.          St:='Show the help index';
  107.       hcHelpTopic:
  108.          St:='Show help for the current topic';
  109.       hcHelpPrevious:
  110.          St:='Show previous help topic';
  111.       hcHelpHelp:
  112.          St:='Help overview';
  113.       hcSubMenu:
  114.          St:='Results of cmValid and cmCancel commands';
  115.       hcValid:
  116.          St:='Does NOT abort the menu';
  117.       hcCancel:
  118.          St:='Does abort the menu';
  119.       Else
  120.          St:='';
  121.    End;
  122.    Hint:=St;
  123. End;
  124.  
  125. Procedure enhMenusDemo.InitMenuBar;
  126. Var
  127.    R                         :   TRect;
  128.  
  129. Begin
  130.    GetExtent(R);
  131.    R.B.Y:=R.A.Y+1;
  132.  
  133.    MenuBar := New(PMenuBar, Init(R, NewMenu(
  134.                  NewSubMenu('~F~ile', hcFile, NewMenu(
  135.                     NewItem('~O~pen','F3',kbF3,0,hcOpen,
  136.                     NewItem('~S~ave','Alt-F3',kbAltF3,cmSave,hcSave,
  137.                     NewLine(
  138.                     NewItem('~C~hange dir...','',kbNoKey,cmChangeDir,hcChangeDir,
  139.                     NewItem('E~x~it','Alt-X',kbAltX,cmQuit,hcExit,
  140.                     nil)))))),
  141.                  NewSubMenu('~M~enu', hcMenu, NewMenu(
  142.                     NewSubMenu('~S~ubmenu', hcSubMenu, NewMenu(
  143.                        NewItem('~V~alid command','',kbNoKey,cmValid,hcValid,
  144.                        NewItem('~C~ancel command','',kbNoKey,cmCancel,hcCancel,
  145.                        nil))),
  146.                     nil)),
  147.                  NewSubMenu('~H~elp',hcHelp,NewMenu(
  148.                     NewItem('~C~ontents','',kbNoKey,cmHelpContents,hcHelpContents,
  149.                     NewItem('~I~ndex','Shift-F1',kbShiftF1,cmHelpIndex,hcHelpIndex,
  150.                     NewItem('~T~opic search','Ctrl-F1',kbCtrlF1,cmHelpTopic,hcHelpTopic,
  151.                     NewItem('~P~revious help','Alt-F1',kbAltF1,cmHelpPrevious,hcHelpPrevious,
  152.                     NewItem('~H~elp on help','F1',kbF1,cmHelpHelp,hcHelpHelp,
  153.                     nil)))))),
  154.                  NewItem('E~x~it','',kbNoKey,cmQuit,hcExit,
  155.                  nil)))))));
  156. End;
  157.  
  158. Procedure enhMenusDemo.InitStatusLine;
  159. Var
  160.    R                         :   TRect;
  161.  
  162. Begin
  163.    GetExtent(R);
  164.    R.A.Y:=R.B.Y-1;;
  165.  
  166.    StatusLine := New(PStatusLine, Init(R,
  167.                     NewStatusDef(1,1,
  168.                        NewStatusKey('~Arrows~ Move',kbNoKey,cmCancel,
  169.                        NewStatusKey('~Shift-Arrow~ Size',kbNoKey,cmCancel,
  170.                        NewStatusKey('~Return~ Done',kbNoKey,cmCancel,
  171.                        NewStatusKey('~Esc~ Done',kbNokey,cmCancel,
  172.                        nil)))),
  173.                     NewStatusDef(0,1099,
  174.                        NewStatusMenu('~F1~ Help',hcHelp,kbF1,NewMenu(
  175.                           NewItem('~C~ontents','',kbNoKey,cmHelpContents,hcHelpContents,
  176.                           NewItem('~I~ndex','Shift-F1',kbShiftF1,cmHelpIndex,hcHelpIndex,
  177.                           NewItem('~T~opic search','Ctrl-F1',kbCtrlF1,cmHelpTopic,hcHelpTopic,
  178.                           NewItem('~P~revious help','Alt-F1',kbAltF1,cmHelpPrevious,hcHelpPrevious,
  179.                           NewItem('~H~elp on help','F1',kbF1,cmHelpHelp,hcHelpHelp,
  180.                           nil)))))),
  181.                        NewStatusKey('~Alt-F3~',kbAltF3,cmClose,
  182.                        NewStatusKey('~F5~ Zoom',kbF5,cmZoom,
  183.                        nil))),
  184.                     NewStatusDef(1100,4999,
  185.                        NewStatusKey('~F1~ Help on Help',kbF1,cmHelpHelp,
  186.                        NewStatusKey('~Shift-F1~ Help Index',kbShiftF1,cmHelpIndex,
  187.                        NewStatusKey('~Alt-F1~ Previous topic',kbAltF1,cmHelpPrevious,
  188.                        nil))),
  189.                     NewStatusDef(5000,$FFFF,
  190.                        NewStatusKey('~F1~ Help',kbF1,cmHelpTopic,
  191.                        nil),
  192.                     nil))))));
  193. End;
  194.  
  195. Procedure enhMenusDemo.GetEvent(var Event:TEvent);
  196. Var
  197.    W                         :   PWindow;
  198.    Title                     :   String;
  199.  
  200. Begin
  201.    TApplication.GetEvent(Event);
  202.    Case Event.What of
  203.       evCommand:
  204.          Begin
  205.             Case Event.Command of
  206.                cmHelpContents:
  207.                   Title:='Help Contents';
  208.                cmHelpIndex:
  209.                   Title:='Help Index';
  210.                cmHelpTopic:
  211.                   Title:='Help Topic';
  212.                cmHelpPrevious:
  213.                   Title:='Help Previous';
  214.                cmHelpHelp:
  215.                   Title:='Help on Help';
  216.             End;
  217.             Case Event.Command of
  218.                cmHelpHelp,
  219.                cmHelpContents,
  220.                cmHelpIndex,
  221.                cmHelpTopic,
  222.                cmHelpPrevious:
  223.                   Begin
  224.                      If PView(Desktop)=Current Then Begin
  225.                         W:=New(PHelpWindow, Init(Desktop, Title, False));
  226.                         Desktop^.Insert(W);
  227.                      End
  228.                      Else Begin
  229.                         W:=New(PHelpWindow, Init(@Self, Title, True));
  230.                         ExecView(W);
  231.                         Dispose(W, Done);
  232.                      End;
  233.                      ClearEvent(Event);
  234.                   End;
  235.             End;
  236.          End;
  237.    End;
  238. End;
  239.  
  240. Procedure enhMenusDemo.HandleEvent(var Event:TEvent);
  241. Begin
  242.    TApplication.HandleEvent(Event);
  243. End;
  244.  
  245. Var
  246.    Demo                      :   enhMenusDemo;
  247.  
  248. Begin
  249.    Demo.Init;
  250.    Demo.Run;
  251.    Demo.Done;
  252. End.
  253.