Follow Mouse 2.1 source code
Class App
Inherits Application
// Properties
Dim col As color
Dim mode As integer
Dim segments As integer
Dim frequency As integer
Dim disappear As boolean
Dim moveingonly As boolean
// Event implementations
Sub EnableMenuItems()
appleAboutthisapplication.enable
EditPreferences.Enable
End Sub
Sub Open()
registerPlugins
// remove line or define your own MBSPluginRegistration module with this method
startdialog.show
End Sub
End Class
Class StartDialog
Inherits Window
// Controls
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
Sub Action(index as Integer) Handles Event
mode=index
End Sub
End ControlInstance
ControlInstance
Sub Action() Handles Event
dim i,freq as integer
dim c as CFMutableDictionaryMBS
dim cp as CFPreferencesMBS
dim b as Boolean
dim count as integer
dim m as MainWindow
app.col=col.c
app.mode=mode
app.disappear=CheckAuto.Value
app.moveingonly=CheckMove.Value
i=val(UpdateFrequency.text)
i=min(i,200) // not to big
i=max(i,5) // not to small
freq=i
app.frequency=1000.0/i
i=val(SegmentCount.text)
// do never trust the user!
i=min(i,1000) // not to big
i=max(i,5) // not to small
app.segments=i
// save preferences:
c=NewCFMutableDictionaryMBS
c.Add NewCFStringMBS("frequency"),NewCFNumberMBSInteger(freq)
c.add NewCFStringMBS("disappear"),NewCFBooleanMBS(app.disappear)
c.add NewCFStringMBS("moveingonly"),NewCFBooleanMBS(app.moveingonly)
c.add NewCFStringMBS("col-red"),NewCFNumberMBSInteger(app.col.red)
c.add NewCFStringMBS("col-green"),NewCFNumberMBSInteger(app.col.green)
c.add NewCFStringMBS("col-blue"),NewCFNumberMBSInteger(app.col.blue)
c.Add NewCFStringMBS("segments"),NewCFNumberMBSInteger(app.segments)
c.Add NewCFStringMBS("mode"),NewCFNumberMBSInteger(app.mode)
cp=new CFPreferencesMBS
cp.SetValue NewCFStringMBS("preferences"),c,cp.kCFPreferencesCurrentApplication,cp.kCFPreferencesCurrentUser,cp.kCFPreferencesCurrentHost
b=cp.Synchronize(cp.kCFPreferencesCurrentApplication,cp.kCFPreferencesCurrentUser,cp.kCFPreferencesCurrentHost)
// run
count=ScreenCount-1
for i=0 to count
m=new MainWindow
m.ScreenIndex=i
m.Init
m.Show
next
close
End Sub
End ControlInstance
ControlInstance
Sub Action() Handles Event
quit
End Sub
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
// Properties
Protected Dim mode As integer
// Event implementations
Sub Open()
dim cp as CFPreferencesMBS
dim r,g,b as CFNumberMBS
dim i as CFNumberMBS
dim n as integer
dim c as CFDictionaryMBS
dim o as CFObjectMBS
dim bo as CFBooleanMBS
// default value:
col.c=rgb(255,100,100)
// load preferences:
cp=new CFPreferencesMBS
o=cp.CopyValue(NewCFStringMBS("preferences"),cp.kCFPreferencesCurrentApplication,cp.kCFPreferencesCurrentUser,cp.kCFPreferencesCurrentHost)
if o<>Nil then
if o isa CFDictionaryMBS then
c=CFDictionaryMBS(o)
if c<>nil then
o=c.Value(NewCFStringMBS("frequency"))
if o isa CFNumberMBS then
i=CFNumberMBS(o)
if i<>Nil then
n=i.integerValue
UpdateFrequency.text=str(n)
end if
end if
end if
end if
o=c.Value(NewCFStringMBS("segments"))
if o isa CFNumberMBS then
i=CFNumberMBS(o)
if i<>Nil then
n=i.integerValue
if n>0 then
SegmentCount.text=str(n)
end if
end if
end if
o=c.Value(NewCFStringMBS("mode"))
if o isa CFNumberMBS then
i=CFNumberMBS(o)
if i<>Nil then
n=i.integerValue
if n>=0 and n<=4 then
Radio(n).Value=true
end if
end if
end if
o=c.Value(NewCFStringMBS("disappear"))
if o isa CFBooleanMBS then
bo=CFBooleanMBS(o)
if bo<>Nil then
CheckAuto.Value=bo.Value
end if
end if
o=c.Value(NewCFStringMBS("moveingonly"))
if o isa CFBooleanMBS then
bo=CFBooleanMBS(o)
if bo<>Nil then
CheckMove.Value=bo.Value
end if
end if
o=c.Value(NewCFStringMBS("col-red"))
if o isa CFNumberMBS then
r=CFNumberMBS(o)
end if
o=c.Value(NewCFStringMBS("col-green"))
if o isa CFNumberMBS then
g=CFNumberMBS(o)
end if
o=c.Value(NewCFStringMBS("col-blue"))
if o isa CFNumberMBS then
b=CFNumberMBS(o)
end if
if r<>Nil and g<>nil and b<>Nil then
col.c=rgb(r.integerValue,g.integerValue,b.integerValue)
end if
end if
End Sub
End Class
Class ColorPicker
Inherits Canvas
// Properties
Dim c As color
// Event implementations
Function MouseDown(X As Integer, Y As Integer) As Boolean
dim cc as color
cc=c
if selectcolor(cc,"Select color:") then
c=cc
refresh
end if
End Function
Sub Paint(g As Graphics)
g.foreColor=c
g.fillrect 1,1,g.width-2,g.height-2
g.foreColor=rgb(255-c.red,255-c.green,255-c.blue)
g.drawrect 0,0,g.width-1,g.height-1
End Sub
End Class
Class AboutDialog
Inherits Window
// Controls
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
Sub Paint(g As Graphics) Handles Event
dim f as FolderItem
f=app.ApplicationFileMBS
if f<>Nil then
f.DrawIconMBS g,me.left,me.top
end if
End Sub
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
End ControlInstance
ControlInstance
Sub Open() Handles Event
me.text="Realbasic "+rbVersionString
End Sub
End ControlInstance
ControlInstance
Sub Open() Handles Event
me.text=mbspluginversion
End Sub
End ControlInstance
ControlInstance
Sub Action() Handles Event
close
End Sub
End ControlInstance
// Event implementations
Sub Open()
#if TargetWin32
title="Follow Mouse"
#else
title=app.longVersion
#endif
StaticText1.text=Title
End Sub
End Class
Class MainWindow
Inherits OverlayWindowMBS
// Properties
Protected Dim ax(0) As integer
Protected Dim ay(0) As integer
Protected Dim cx As integer
Protected Dim cy As integer
Dim MoveCounter As integer
Dim ScreenIndex As integer
Dim SomethingVisible As boolean
Dim t As MyTimer
// Event implementations
Sub WindowClosed()
if t<>Nil then
t.c=nil
t=nil
end if
End Sub
// Methods
Sub ClearArea()
dim co,i,j as integer
dim c as cgcontextMBS
dim x1,y1,x2,y2 as Single
// get core graphics context for the window
c=self.Context
c.ClearRect CGMakeRectMBS(0,0,width,height)
c.flush
SomethingVisible=false
End Sub
Sub DoUpdate(x as integer, y as integer)
dim co,i,j as integer
dim c as cgcontextMBS
dim x1,y1,x2,y2 as Single
// get core graphics context for the window
c=self.Context
c.ClearRect CGMakeRectMBS(0,0,width,height)
c.SetLineWidth 3
co=UBound(ax)
for i=2 to co
c.beginPath
x1=ax(i-1)
y1=ay(i-1)
c.moveToPoint x1,y1
c.setrGBStrokeColor app.col.red/255.0,app.col.green/255.0,app.col.blue/255.0,i/co
x2=ax(i)
y2=ay(i)
c.AddLineToPoint x2,y2
c.strokePath
next
// clear around cursor, so we don't get mouse events
c.clearrect CGMakeRectMBS(x-1,height-y-1,3,3)
c.flush
SomethingVisible=true
End Sub
Sub DoUpdateMath(x as integer, y as integer)
cx=x
cy=y
ax.append x
ay.append height-y
if ubound(ax)>app.segments then // if too much, cut
ax.remove 0
ay.remove 0
end if
End Sub
Sub Init()
'extern WindowGroupRef GetWindowGroupOfClass(WindowClass windowClass) AVAILABLE_MAC_OS_X_VERSION_10_0_AND_LATER;
'extern OSStatus SetWindowGroupLevel(WindowGroupRef inGroup,SInt32 inLevel) AVAILABLE_MAC_OS_X_VERSION_10_0_AND_LATER;
'CGWindowLevel CGWindowLevelForKey( CGWindowLevelKey key )
'extern OSStatus SetWindowGroup(WindowRef inWindow,WindowGroupRef inNewGroup) AVAILABLE_MAC_OS_X_VERSION_10_0_AND_LATER;
'extern OSStatus CreateWindowGroup(WindowGroupAttributes inAttributes,WindowGroupRef * outGroup) AVAILABLE_MAC_OS_X_VERSION_10_0_AND_LATER;
const kCGBaseWindowLevelKey = 0
const kCGMinimumWindowLevelKey = 1
const kCGDesktopWindowLevelKey = 2
const kCGBackstopMenuLevelKey = 3
const kCGNormalWindowLevelKey = 4
const kCGFloatingWindowLevelKey = 5
const kCGTornOffMenuWindowLevelKey = 6
const kCGDockWindowLevelKey = 7
const kCGMainMenuWindowLevelKey = 8
const kCGStatusWindowLevelKey = 9
const kCGModalPanelWindowLevelKey = 10
const kCGPopUpMenuWindowLevelKey = 11
const kCGDraggingWindowLevelKey = 12
const kCGScreenSaverWindowLevelKey = 13
const kCGMaximumWindowLevelKey = 14
const kCGOverlayWindowLevelKey = 15
const kCGHelpWindowLevelKey = 16
const kCGUtilityWindowLevelKey = 17
const kCGDesktopIconWindowLevelKey = 18
const kCGCursorWindowLevelKey = 19
const kCGAssistiveTechHighWindowLevelKey = 20
dim m,n as memoryBlock
dim e as integer
dim mode as integer
dim x as integer=screen(ScreenIndex).left
dim y as integer=screen(ScreenIndex).top
dim w as integer=screen(ScreenIndex).width
dim h as integer=screen(ScreenIndex).height
if me.Create(x,y,w,h)=0 then
me.HasNoShadow=true // remove shadow from the window.
'me.HasBorder=false
select case app.mode
case 0
mode=kCGDesktopWindowLevelKey
case 1
mode=kCGDesktopIconWindowLevelKey
case 2
mode=kCGDockWindowLevelKey
case 3
mode=kCGMainMenuWindowLevelKey
case 4
mode=kCGPopUpMenuWindowLevelKey
end select
'MsgBox str(app.mode)+" "+str(mode)
t=new MyTimer
t.c=self
t.Period=app.frequency
t.mode=2
me.IgnoreClicks=true
me.Level=me.WindowLevelForKey(mode)
end if
End Sub
Sub update()
dim x,y as integer
dim f as Double
// get mouse position
x=System.MouseX-me.Left
y=System.MouseY-me.top
if app.moveingonly then
if x=cx and y=cy then
if MoveCounter=0 or (SomethingVisible and app.disappear) then
DoUpdateMath x,y
end if
MoveCounter=MoveCounter+1
f=MoveCounter*app.frequency/1000.0
if f>=3.0 then
DoUpdate x,y
end if
else
if SomethingVisible then
ClearArea
end if
DoUpdateMath x,y
MoveCounter=0
end if
elseif (x<>cx or y<>cy) or app.disappear then
DoUpdateMath x,y
DoUpdate x,y
end if
End Sub
End Class
Class MyTimer
Inherits Timer
// Properties
Dim c As MainWindow
// Event implementations
Sub Action()
if c<>Nil then
c.update
end if
End Sub
End Class
Loading
Links
MBS Real Studio Plugins - Nachhilfe in Kruft