home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyHandleQuitBoth.p < prev    next >
Encoding:
Text File  |  1995-10-25  |  1.5 KB  |  76 lines  |  [TEXT/CWIE]

  1. unit MyHandleQuitBoth;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     procedure StartupHandleQuitBoth;
  9.     procedure ConfigureHandleQuitBoth (creator: OSType; both_index, justus_index: integer);
  10.  
  11. implementation
  12.  
  13.     uses
  14.         TextUtils, Menus, 
  15.         MyTypes, MyProcesses, MyFMenus, MyStartup, MyOOMenus, 
  16.         BaseGlobals;
  17.  
  18.     var
  19.         quitBoth: boolean;
  20.         creatorType: OSType;
  21.         both, justus: integer;
  22.  
  23.     procedure DoQuit;
  24.     begin
  25.         quitNow := true;
  26.         if quitBoth then begin
  27.             QuitApplication(creatorType, application);
  28.         end;
  29.     end;
  30.  
  31.     procedure SetQuit (themenu, theitem: integer);
  32.         var
  33.             dummyb: boolean;
  34.             er: eventRecord;
  35.             nqb: boolean;
  36.             process: processSerialNumber;
  37.             s: str255;
  38.             fs: FSSpec;
  39.     begin
  40.         dummyb := GetOSEvent(0, er);
  41.         nqb := (BAND(er.modifiers, optionKey) <> 0) & FindProcess(creatorType, application, process, fs);
  42.         if nqb <> quitBoth then begin
  43.             quitBoth := nqb;
  44.             if quitBoth then begin
  45.                 GetIndString(s, global_strh_id, both);
  46.             end
  47.             else begin
  48.                 GetIndString(s, global_strh_id, justus);
  49.             end;
  50.             SetMenuItemText(GetMenuHandle(themenu), theitem, s);
  51.         end;
  52.     end;
  53.  
  54.     function InitHandleQuitBoth(var msg: integer): OSStatus;
  55.     begin
  56.         msg := msg; { Unused }
  57.         quitBoth := false;
  58.         SetFBoth(CQuit, DoQuit, SetQuit);
  59.         InitHandleQuitBoth:= noErr;
  60.     end;
  61.  
  62.     procedure ConfigureHandleQuitBoth (creator: OSType; both_index, justus_index: integer);
  63.     begin
  64.         creatorType := creator;
  65.         both := both_index;
  66.         justus := justus_index;
  67.     end;
  68.     
  69.     procedure StartupHandleQuitBoth;
  70.     begin
  71.         StartupFMenus;
  72.         StartupOOMenus;
  73.         SetStartup(InitHandleQuitBoth, nil, 0,nil);
  74.     end;
  75.     
  76. end.