home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyWindowsMenu.p < prev    next >
Encoding:
Text File  |  1994-10-10  |  2.3 KB  |  111 lines  |  [TEXT/PJMM]
  1. unit MyWindowsMenu;
  2.  
  3. interface
  4.  
  5.     procedure InitWindowsMenu;
  6.     procedure FinishWindowsMenu;
  7.     procedure UpdateWindowsMenu;
  8.     function DoWindowsMenuItem (themenu, theitem: integer): boolean;
  9.  
  10. implementation
  11.  
  12.     uses
  13.         MyFMenus, MyTypes, MyMenus, MyOOMainLoop, MyStrings;
  14.  
  15.     var
  16.         menu: MenuHandle;
  17.         skip, base: integer;
  18.         wason: boolean;
  19.  
  20.     procedure InitWindowsMenu;
  21.     begin
  22.         menu := GetFMenu(M_Windows);
  23.         InsertMenu(menu, 0);
  24.         skip := CountMItems(menu);
  25.         base := skip + 1 + ord(skip > 0);
  26.         wason := true;
  27.         UpdateWindowsMenu;
  28.     end;
  29.  
  30.     procedure FinishWindowsMenu;
  31.     begin
  32.     end;
  33.  
  34.     function GetNextWindow (var wp: WindowPeek): boolean;
  35.     begin
  36.         if wp = nil then begin
  37.             wp := WindowPeek(FrontWindow);
  38.         end
  39.         else begin
  40.             wp := wp^.nextWindow;
  41.         end;
  42.         while (wp <> nil) & (not wp^.visible | (GetWType(windowPtr(wp)) = WT_NotMine)) do begin
  43.             wp := wp^.nextWindow;
  44.         end;
  45.         GetNextWindow := wp <> nil;
  46.     end;
  47.  
  48.     procedure SetEnableMenu (on: boolean);
  49.     begin
  50.         if (skip > 0) then begin
  51.             SetFMenu(M_Windows);
  52.             if (BAND(menu^^.enableFlags, BSL(1, skip) - 1) <> 0) then begin
  53.                 on := true;
  54.             end;
  55.         end;
  56.         if wason <> on then begin
  57.             wason := on;
  58.             SetItemEnable(menu, 0, on);
  59.             DrawMenuBar;
  60.         end;
  61.     end;
  62.  
  63.     procedure UpdateWindowsMenu;
  64.         var
  65.             wp: WindowPeek;
  66.             title: Str255;
  67.             i: integer;
  68.             first: boolean;
  69.     begin
  70.         for i := CountMItems(menu) downto skip + 1 do begin
  71.             DelMenuItem(menu, i);
  72.         end;
  73.         wp := nil;
  74.         first := true;
  75.         while GetNextWindow(wp) do begin
  76.             if first and (skip > 0) then begin
  77.                 AppendMenu(menu, '(-');
  78.             end;
  79.             AppendMenu(menu, 'fred');
  80.             GetWTitle(windowPtr(wp), title);
  81.             LimitStringLength(title, 40, '…');
  82.             SetItem(menu, CountMItems(menu), title);
  83.             if first & (WindowPtr(wp) = FrontWindow) then begin
  84.                 SetItemMark(menu, base, chr(checkMark));
  85.             end;
  86.             first := false;
  87.         end;
  88.         SetEnableMenu(not first);
  89.     end;
  90.  
  91.     function DoWindowsMenuItem (themenu, theitem: integer): boolean;
  92.         var
  93.             wp: WindowPeek;
  94.     begin
  95.         DoWindowsMenuItem := false;
  96.         if (themenu = M_Windows) and (theitem >= base) then begin
  97.             DoWindowsMenuItem := true;
  98.             wp := nil;
  99.             while (theitem >= base) do begin
  100.                 if not GetNextWindow(wp) then
  101.                     leave;
  102.                 theitem := theitem - 1;
  103.             end;
  104.             if wp <> nil then begin
  105.                 SelectWindow(windowPtr(wp));
  106.             end;
  107.             HiliteMenu(0);
  108.         end;
  109.     end;
  110.  
  111. end.