Platforms to show: All Mac Windows Linux Cross-Platform
/MacCocoa/NSStatusItem/Classic Control Menu
Function:
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.
Function:
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
The items on this page are in the following plugins: MBS MacCocoa Plugin.
Links
MBS Xojo Chart Plugins