home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0050_Dynamic Menus.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  4.2 KB  |  144 lines
  1. Program MenuAdd;
  2. {
  3.  provided as is, no guarantees, no support
  4.  
  5.  Question 1: My_ByPosition locates items by position from
  6.              the top of the menu, mf_ByCommand finds an
  7.              idem uses the items id.
  8.  
  9.  Question 2: These commands start a new column, the one
  10.              separated by a bar the other not separated
  11.              by a bar. If you are not in a PopUpMenu then
  12.              it places the item on a new line.
  13.  
  14.  
  15. }
  16.  
  17. Uses
  18.   WinProcs,
  19.   WinTypes,
  20.   OWindows;
  21.  
  22. Const
  23.   cmEnable     = 101;
  24.   cmColor      = 102;
  25.   cmBlackWhite = 103;
  26.   cmAddCommand = 104;
  27.  
  28. Type
  29.   PMyWindow = ^TMyWindow;
  30.   TMyWindow = Object(TWindow)
  31.       mh: HMenu;
  32.     constructor Init(AParent: PWindowsObject; AName: PChar);
  33.     procedure Enable(var Msg: TMessage);
  34.       virtual cm_First + cmEnable;
  35.     procedure Color(var Msg: TMessage);
  36.       virtual cm_First + cmColor;
  37.     procedure BlackWhite(var Msg: TMessage);
  38.       virtual cm_First + cmBlackWhite;
  39.     procedure AddCommand(var Msg: TMessage);
  40.       virtual cm_First + cmAddCommand;
  41.     procedure SetUpWindow; virtual;
  42.     procedure WMLButtonDown(var Msg: TMessage);
  43.       virtual wm_First + wm_LButtonDown;
  44.   end;
  45.  
  46.   TMyApp = Object(TApplication)
  47.     procedure InitMainWindow; virtual;
  48.   end;
  49.  
  50. constructor TMyWindow.Init(AParent: PWindowsObject; AName: PChar);
  51. begin
  52.   TWindow.Init(AParent, AName);
  53.   Attr.Menu := CreateMenu;
  54. end;
  55.  
  56.  
  57. procedure TMyWindow.SetUpWindow;
  58. begin
  59.   TWindow.SetUpWindow;
  60.   mh := CreatePopUpMenu;
  61.   AppendMenu(Attr.Menu, mf_PopUp, Mh, '&Commands');
  62.   AppendMenu(Mh, mf_String, cmEnable, '&Enable Options');
  63.   AppendMenu(Mh, mf_Separator, 0, Nil);
  64.   AppendMenu(Mh, mf_String, cmColor, '&Color');
  65.   AppendMenu(Mh, mf_String, cmBlackWhite, '&Black/White');
  66.   AppendMenu(Mh, mf_Separator, 0, Nil);
  67.   AppendMenu(Mh, mf_String, cmAddCommand, 'Add Command');
  68.   EnableMenuItem(Mh, 2, mf_ByPosition or mf_Grayed);
  69.   EnableMenuItem(Mh, 3, mf_ByPosition or mf_Grayed);
  70.   EnableMenuItem(Mh, 5, mf_ByPosition or mf_Grayed);
  71.   DrawMenuBar(HWindow);
  72. end;
  73.  
  74. procedure TMyWindow.WMLButtonDown(var Msg: TMessage);
  75. begin
  76.   MessageBeep(0);
  77.   HiLiteMenuItem(HWindow, Attr.Menu, 0, mf_ByPosition or mf_HiLite);
  78.  
  79.   SetFocus(Attr.Menu);
  80. end;
  81.  
  82. procedure TMyWindow.Enable(var Msg: TMessage);
  83. begin
  84.   EnableMenuItem(Mh, 2, mf_ByPosition or mf_Enabled);
  85.   EnableMenuItem(Mh, 3, mf_ByPosition or mf_Enabled);
  86.   EnableMenuItem(Mh, 5, mf_ByPosition or mf_Enabled);
  87.   DeleteMenu(Mh, 0, mf_ByPosition);
  88.   DeleteMenu(Mh, 0, mf_ByPosition);
  89.   CheckMenuItem(Mh, cmColor, mf_ByCommand or mf_Checked);
  90. end;
  91.  
  92. procedure TMyWindow.Color(var Msg: TMessage);
  93. var
  94.   State: Word;
  95. begin
  96.   State := GetMenuState(Mh, cmColor, mf_ByCommand);
  97.   if (State and mf_Checked) = mf_Checked then
  98.     CheckMenuItem(Mh, cmColor, mf_ByCommand or mf_UnChecked)
  99.   else
  100.     CheckMenuItem(Mh, cmColor, mf_ByCommand or mf_Checked);
  101.  
  102.   State := GetMenuState(Mh, cmBlackWhite, mf_ByCommand);
  103.   if (State and mf_Checked) = mf_Checked then
  104.     CheckMenuItem(Mh, cmBlackWhite, mf_ByCommand or mf_UnChecked)
  105. end;
  106.  
  107. procedure TMyWindow.BlackWhite(var Msg: TMessage);
  108. var
  109.   State: Word;
  110. begin
  111.   State := GetMenuState(Mh, cmBlackWhite, mf_ByCommand);
  112.   if (State and mf_Checked) = mf_Checked then
  113.     CheckMenuItem(Mh, cmBlackWhite, mf_ByCommand or mf_UnChecked)
  114.   else
  115.     CheckMenuItem(Mh, cmBlackWhite, mf_ByCommand or mf_Checked);
  116.  
  117.   State := GetMenuState(Mh, cmColor, mf_ByCommand);
  118.   if (State and mf_Checked) = mf_Checked then
  119.     CheckMenuItem(Mh, cmColor, mf_ByCommand or mf_UnChecked)
  120. end;
  121.  
  122. procedure TMyWindow.AddCommand(var Msg: TMessage);
  123. begin
  124.   InsertMenu(Mh, cmColor, mf_String, cmEnable, '&Enable Options');
  125.   InsertMenu(Mh, cmColor, mf_Separator, 0, Nil);
  126.   EnableMenuItem(Mh, 2, mf_ByPosition or mf_Grayed);
  127.   EnableMenuItem(Mh, 3, mf_ByPosition or mf_Grayed);
  128.   EnableMenuItem(Mh, 5, mf_ByPosition or mf_Grayed);
  129.   CheckMenuItem(Mh, cmColor, mf_ByCommand or mf_UnChecked);
  130.   CheckMenuItem(Mh, cmBlackWhite, mf_ByCommand or mf_UnChecked);
  131. end;
  132.  
  133. procedure TMyApp.InitMainWindow;
  134. begin
  135.   MainWindow := New(PMyWindow, Init(nil, 'MenuAdd'));
  136. end;
  137.  
  138. var
  139.   A: TMyApp;
  140. begin
  141.   A.Init('Ph2SecA');
  142.   A.Run;
  143.   A.Done;
  144. end.