Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/MacCocoa/NSStatusItem/Classic Control Menu
Required plugins for this example: MBS MacBase Plugin, MBS MacCF Plugin, MBS MacClassic Plugin, MBS MacCocoa Plugin, MBS MacOSX Plugin, MBS Main Plugin, MBS Picture Plugin, MBS Util Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /MacCocoa/NSStatusItem/Classic Control Menu
This example is the version from Sun, 17th Mar 2012.
Project "Classic Control Menu.rbp"
MenuBar Menu
MenuItem UntitledMenu3 = ""
MenuItem UntitledMenu2 = "File"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu0 = "Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
MenuItem AppleAboutthisapplication = "About this application..."
End MenuBar
Class App Inherits Application
EventHandler Sub Close() if s<>nil then s.Close DelayMBS 0.2 // wait for events to flush end if Exception End EventHandler
EventHandler Sub Open() dim f as FolderItem dim i as MyCocoamenuitem // Watch application launches: c=new CarbonEvents c.Listen // Load Menu bundle s=new NSStatusItemMBS if not s.Available then beep quit end if MakeImages PictureOn=new nsimageMBS(Classicon,ClassicMask) PictureOff=new nsimageMBS(Classicoff,ClassicMask) // Create statusitem call s.CreateMenu(24) s.HighlightMode=true // create a menu to attach to the statusitem m=new NSMenuMBS // Create menu items i=new MyCocoamenuitem i.CreateMenuItem BundleLocalizedString("Start") i.ID=1 m.AddItem i items.Append i i=new MyCocoamenuitem i.CreateMenuItem BundleLocalizedString("Stop") i.ID=2 m.AddItem i items.Append i i=new MyCocoamenuitem i.CreateMenuItem BundleLocalizedString("OpenSysPrefs") i.ID=3 m.AddItem i items.Append i // I'd like to kill, but we can't kill it as it doesn't show up on the ProcessMBS class // BTW, it's a root process so we may not even be able to kill it in case we get the ProcessID 'i=new MyCocoamenuitem 'i.CreateMenuItem BundleLocalizedString("ForceQuit") 'i.ID=4 'm.AddItem i 'items.Append i i=new MyCocoamenuitem i.CreateSeparator m.AddItem i items.Append i i=new MyCocoamenuitem i.CreateMenuItem BundleLocalizedString("Quit") i.ID=5 m.AddItem i items.Append i // attach menu s.Menu=m updateStatus Exception End EventHandler
Function BundleLocalizedString(s as string) As string dim t as String t=app.BundleLocalizedStringMBS(s) if t="" then Return s else Return t end if Exception End Function
Sub MakeImages() dim i as IconMBS dim f as IconFamilyMBS dim x,y as integer dim r as RGBSurface dim c as color dim n as integer dim b as Boolean // find the icon i=new IconMBS("APPL","bxls") // extract parts f=i.IconFamily // Copy the nice small icon ClassicOn=f.Small32BitData.CloneMBS ClassicMask=f.Small8BitMask.CloneMBS ClassicMask=ClassicMask // now make a grayscale copy ClassicOff=Classicon.CloneMBS r=ClassicOff.RGBSurface for x=0 to 15 for y=0 to 15 c=r.Pixel(x,y) n=(c.red+c.blue+c.green)\3 c=rgb(n,n,n) r.Pixel(x,y)=c next next Exception End Sub
Sub SetClassicActive() s.image=PictureOn items(1).Enabled=false items(2).Enabled=true Exception End Sub
Sub SetClassicNotActive() s.image= PictureOff items(1).Enabled=true items(2).Enabled=false Exception End Sub
Sub updateStatus() dim p as ProcessMBS p=new ProcessMBS p.GetFirstProcess do 'DebugMessageMBS """"+p.Name+"""" if p.MacCreator="bbox" then 'DebugMessageMBS "Classic running." SetClassicActive Return end if loop until not p.GetNextProcess 'DebugMessageMBS "Classic not running." SetClassicNotActive Exception End Sub
Property Protected ClassicMask As Picture
Property Protected ClassicOff As picture
Property Protected ClassicOn As Picture
Property Protected PictureOff As nsimagembs
Property Protected PictureOn As nsimagembs
Property Protected c As carbonevents
Property Protected items(0) As myCocoamenuitem
Property last As string
Property Protected m As NSMenuMBS
Property Protected s As NSStatusItemMBS
Property timemenuitem As nsmenuitemMBS
End Class
Class MyCocoamenuitem Inherits NSMenuItemMBS
EventHandler Sub Action() Select case id case 1 StartClassic case 2 StopClassic case 3 launchPref case 4 ForceQuit case 5 quit end Select Exception End EventHandler
Sub ForceQuit() // Doesn't work. Kills Classic Support, but not the TrueBlueEnvironment dim p as ProcessMBS p=new ProcessMBS p.GetFirstProcess do if p.MacCreator="bbox" then System.DebugLog "Kill Classic: "+str(p.KillProcess) Return end if loop until not p.GetNextProcess System.DebugLog "Classic process not found!" Exception End Sub
Sub StartClassic() dim f as FolderItem f=LaunchServicesFindApplicationForInfoMBS("","com.apple.Classic","Classic Startup.app") if f=nil then System.DebugLog "Failed to find Classic Startup.app" else f.Launch end if Exception End Sub
Sub StopClassic() dim s as String dim a as AppleScriptMBS s="tell application ""Classic Support"" to quit" a=new AppleScriptMBS a.Compile s if a.Lasterror=0 then a.Execute end if if a.Lasterror<>0 then System.DebugLog "AppleScript error with StopClassic: "+str(a.Lasterror) end if Exception End Sub
Sub launchPref() dim s as Shell s=new Shell s.Execute "/usr/bin/open /System/Library/PreferencePanes/Classic.prefPane" Exception End Sub
Property ID As integer
End Class
Class CarbonEvents Inherits CarbonApplicationEventsMBS
EventHandler Sub ApplicationLaunched(ProcessSerial as memoryblock) app.updateStatus End EventHandler
EventHandler Sub ApplicationTerminated(ProcessSerial as memoryblock) app.updateStatus End EventHandler
End Class
End Project

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS MacCocoa Plugin.

MBS FileMaker Plugins