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





Links
MBS Realbasic PDF Plugins