home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 11.ddi / OWLDEMOS.ZIP / MENU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  4.5 KB  |  181 lines
  1. {************************************************}
  2. {                                                }
  3. {   Demo program                                 }
  4. {   Copyright (c) 1991 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Menu;
  9.  
  10. {$R MENU}
  11.  
  12. uses WinProcs, WinTypes, OWindows, ODialogs, Strings;
  13.  
  14. const
  15.  
  16. { Command IDs }
  17.  
  18.   cm_Modify  = 100;
  19.   cm_About   = 101;
  20.   cm_Static  = 200;
  21.   cm_Dynamic = 300;
  22.  
  23. { Modify dialog item IDs }
  24.  
  25.   id_InputBox = 100;
  26.   id_Checked  = 101;
  27.   id_Grayed   = 102;
  28.   id_Add      = 103;
  29.   id_Delete   = 104;
  30.  
  31. type
  32.  
  33. { Modify dialog object }
  34.  
  35.   PModifyDialog = ^TModifyDialog;
  36.   TModifyDialog = object(TDialog)
  37.     procedure AddItem(var Msg: TMessage);
  38.       virtual id_First + id_Add;
  39.     procedure DeleteItem(var Msg: TMessage);
  40.       virtual id_First + id_Delete;
  41.   end;
  42.  
  43. { Menu name string }
  44.  
  45.   TMenuName = array[0..31] of Char;
  46.  
  47. { Main window object }
  48.  
  49.   PMenuWindow = ^TMenuWindow;
  50.   TMenuWindow = object(TWindow)
  51.     MenuCount: Word;
  52.     MenuName: TMenuName;
  53.     constructor Init;
  54.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  55.     procedure DefCommandProc(var Msg: TMessage); virtual;
  56.     procedure CMModify(var Msg: TMessage);
  57.       virtual cm_First + cm_Modify;
  58.     procedure CMAbout(var Msg: TMessage);
  59.       virtual cm_First + cm_About;
  60.   end;
  61.  
  62. { Application object }
  63.  
  64.   TMenuApp = object(TApplication)
  65.     procedure InitMainWindow; virtual;
  66.   end;
  67.  
  68. { Handle the Add button by appending a new item to the Dynamic menu. }
  69.  
  70. procedure TModifyDialog.AddItem(var Msg: TMessage);
  71. var
  72.   Style: Word;
  73.   Name: TMenuName;
  74. begin
  75.   GetWindowText(GetDlgItem(HWindow, id_InputBox), Name, SizeOf(Name));
  76.   if Name[0] <> #0 then
  77.   begin
  78.     if SendMessage(GetDlgItem(HWindow, id_Checked),
  79.       bm_GetCheck, 0, 0) = 0 then
  80.       Style := mf_Unchecked
  81.     else
  82.       Style := mf_Checked;
  83.     if SendMessage(GetDlgItem(HWindow, id_Grayed),
  84.       bm_GetCheck, 0, 0) = 0 then
  85.       Style := Style or mf_Enabled
  86.     else
  87.       Style := Style or mf_Grayed;
  88.     with PMenuWindow(Parent)^ do
  89.     begin
  90.       AppendMenu(GetSubMenu(GetMenu(HWindow), 2),
  91.         Style or mf_String, cm_Dynamic + MenuCount, @Name);
  92.       Inc(MenuCount);
  93.     end;
  94.   end;
  95.   EndDlg(id_Cancel);
  96. end;
  97.  
  98. { Handle the Delete button.  Loop through all menu items on the
  99.   Dynamic menu until a matching item is found, and then delete that
  100.   item.  If no match is found, bring up an error box. }
  101.  
  102. procedure TModifyDialog.DeleteItem(var Msg: TMessage);
  103. var
  104.   I: Integer;
  105.   DynamicMenu: HMenu;
  106.   Name, S: TMenuName;
  107. begin
  108.   GetWindowText(GetDlgItem(HWindow, id_InputBox), Name, SizeOf(Name));
  109.   DynamicMenu := GetSubMenu(GetMenu(Parent^.HWindow), 2);
  110.   for I := 0 to GetMenuItemCount(DynamicMenu) - 1 do
  111.   begin
  112.     GetMenuString(DynamicMenu, I, S, SizeOf(S), mf_ByPosition);
  113.     if StrIComp(Name, S) = 0 then
  114.     begin
  115.       DeleteMenu(DynamicMenu, I, mf_ByPosition);
  116.       EndDlg(id_Cancel);
  117.       Exit;
  118.     end;
  119.   end;
  120.   MessageBox(HWindow, 'Menu item not found', 'Error', mb_Ok);
  121. end;
  122.  
  123. { Constructor for main window object. }
  124.  
  125. constructor TMenuWindow.Init;
  126. begin
  127.   TWindow.Init(nil, 'Menu Demo');
  128.   Attr.Menu := LoadMenu(HInstance, 'Menu');
  129.   MenuCount := 1;
  130.   MenuName[0] := #0;
  131. end;
  132.  
  133. { Bring up the About box. }
  134.  
  135. procedure TMenuWindow.CMAbout(var Msg: TMessage);
  136. begin
  137.   Application^.ExecDialog(New(PDialog, Init(@Self, 'About')));
  138. end;
  139.  
  140. { Bring up the Modify dialog. }
  141.  
  142. procedure TMenuWindow.CMModify(var Msg: TMessage);
  143. begin
  144.   Application^.ExecDialog(New(PModifyDialog, Init(@Self, 'Modify')));
  145. end;
  146.  
  147. { Paint window by displaying the name of the last menu selection. }
  148.  
  149. procedure TMenuWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  150. begin
  151.   TextOut(PaintDC, 10, 10, MenuName, StrLen(MenuName));
  152. end;
  153.  
  154. { All unrecognized commands are sent to DefCommandProc.  Get the name
  155.   of the menu selection that generated the command, and invalidate
  156.   the window's client area so the new menu name gets displayed. }
  157.  
  158. procedure TMenuWindow.DefCommandProc(var Msg: TMessage);
  159. begin
  160.   GetMenuString(GetMenu(HWindow), Msg.WParam, MenuName,
  161.     SizeOf(MenuName), mf_ByCommand);
  162.   InvalidateRect(HWindow, nil, True);
  163.   TWindow.DefCommandProc(Msg);
  164. end;
  165.  
  166. { Create the application's main window. }
  167.  
  168. procedure TMenuApp.InitMainWindow;
  169. begin
  170.   MainWindow := New(PMenuWindow, Init);
  171. end;
  172.  
  173. var
  174.   MenuApp: TMenuApp;
  175.  
  176. begin
  177.   MenuApp.Init('Menu');
  178.   MenuApp.Run;
  179.   MenuApp.Done;
  180. end.
  181.