GFMouseGuide/GFMouseGuidefrm.frm
VERSION 5.00
Begin VB.Form GFMouseGuidefrm
Caption = "Form1"
ClientHeight = 6075
ClientLeft = 60
ClientTop = 345
ClientWidth = 7695
LinkTopic = "Form1"
ScaleHeight = 6075
ScaleWidth = 7695
StartUpPosition = 3 'Windows‑Standard
Begin VB.CommandButton Command1
Caption = "Guide me by the mouse !"
Height = 375
Left = 4920
TabIndex = 0
Top = 5640
Width = 2715
End
Begin VB.PictureBox Picture1
Height = 6060
Left = 0
MousePointer = 14 'Pfeil und Fragezeichen
Picture = "GFMouseGuidefrm.frx":0000
ScaleHeight = 6000
ScaleWidth = 4755
TabIndex = 1
Top = 0
Width = 4815
End
Begin VB.Label Label1
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2835
Left = 4860
TabIndex = 2
Top = 60
Width = 2835
End
End
Attribute VB_Name = "GFMouseGuidefrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001, 2004 by Louis. Use to show the user the screen position of any object.
'
'Downloaded from www.louis‑coder.com.
'Funny functions to attract the user's attention.
'Good in combination with help systems.
'Sample implementation: Toricxs (www.toricxs.com).
'
'GFMouseGuide
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'GFMouseGuide
Private Type POINTAPI
x As Long
y As Long
End Type
Private Sub Command1_Click()
'on error resume next
Call GFMouseGuide_PlayAnimation(Me.Left / Screen.TwipsPerPixelX + 50, Me.Top / Screen.TwipsPerPixelY + 50, 0, 0)
End Sub
'*************************************GFMOUSEGUIDE**************************************
'NOTE: use GFMouseGuide to show the user the screen position of any object.
Private Sub GFMouseGuide_PlayAnimation(ByVal AnimationTargetPosX As Long, ByVal AnimationTargetPosY As Long, ByVal AnimationIndexOrZero As Integer, ByVal AnimationNumberOrZero As Integer)
'on error resume next 'format: pixels
Dim POINTAPIVar As POINTAPI
Dim AnimationLoop As Integer
Dim ScreenMousePointerUnchanged As Integer
'preset
Call GetCursorPos(POINTAPIVar) 'save to allow restoring original cursor pos
ScreenMousePointerUnchanged = Screen.MousePointer
Screen.MousePointer = vbArrow 'important (if located over text boxes)
'begin
If AnimationIndexOrZero = 0 Then
AnimationIndexOrZero = Int((5 ‑ 1 + 1) * Rnd(1) + 1) 'randomly select one of three available animations
Select Case AnimationIndexOrZero 'adjust possibility
Case 1, 2, 3
AnimationIndexOrZero = 1
Case 4
AnimationIndexOrZero = 2
Case 5
AnimationIndexOrZero = 3
End Select
End If
Select Case AnimationIndexOrZero
Case 1 'looks serious
If AnimationNumberOrZero = 0 Then AnimationNumberOrZero = 3
For AnimationLoop = 1 To AnimationNumberOrZero
Call GFMouseGuide_PerformAnimation1(AnimationTargetPosX, AnimationTargetPosY)
Next AnimationLoop
Case 2
If AnimationNumberOrZero = 0 Then AnimationNumberOrZero = 2
For AnimationLoop = 1 To AnimationNumberOrZero
Call GFMouseGuide_PerformAnimation2(AnimationTargetPosX, AnimationTargetPosY)
Next AnimationLoop
Case 3 'looks funny
If AnimationNumberOrZero = 0 Then AnimationNumberOrZero = 1
For AnimationLoop = 1 To AnimationNumberOrZero
Call GFMouseGuide_PerformAnimation3(AnimationTargetPosX, AnimationTargetPosY)
Next AnimationLoop
End Select
Screen.MousePointer = ScreenMousePointerUnchanged 'reset
Call SetCursorPos(POINTAPIVar.x, POINTAPIVar.y) 'reset
End Sub
Private Sub GFMouseGuide_PerformAnimation1(ByVal AnimationTargetPosX As Long, ByVal AnimationTargetPosY As Long)
'on error resume next 'mouse pointer draws a circle around target
Dim AnimationDirection As Single
Dim Temp As Long
'preset
If Rnd(1) < 0.05! Then
AnimationDirection = ‑1 'clockwise
Else
AnimationDirection = 1 'counter‑clockwise
End If
'begin
For Temp = 1 To 360 Step 5
Call SetCursorPos( _
AnimationTargetPosX ‑ Sin(CSng(Temp) / 360! * 2! * 3.14! * AnimationDirection) * 10, _
AnimationTargetPosY ‑ Cos(CSng(Temp) / 360! * 2! * 3.14! * AnimationDirection) * 10)
Call Sleep(3)
Next Temp
End Sub
Private Sub GFMouseGuide_PerformAnimation2(ByVal AnimationTargetPosX As Long, ByVal AnimationTargetPosY As Long)
'on error resume next 'pointer shoots towards target and bounces back
Dim Temp As Long
For Temp = 31 To 0 Step (‑1)
Call SetCursorPos(AnimationTargetPosX + Temp, AnimationTargetPosY + Temp)
Call Sleep(3 + CLng(CSng(Temp) / 5!)) 'never use Sleep(0)
Next Temp
For Temp = 0 To 9
Call SetCursorPos(AnimationTargetPosX + Temp, AnimationTargetPosY + Temp)
Call Sleep(2 + Temp) 'never use Sleep(0)
Next Temp
For Temp = 9 To 0 Step (‑1)
Call SetCursorPos(AnimationTargetPosX + Temp, AnimationTargetPosY + Temp)
Call Sleep(2 + CLng(CSng(Temp) / 2!)) 'never use Sleep(0)
Next Temp
If Rnd(1) < 0.25! Then
For Temp = 0 To 9 'bounce again
Call SetCursorPos(AnimationTargetPosX + Temp, AnimationTargetPosY + Temp)
Call Sleep(2 + Temp) 'never use Sleep(0)
Next Temp
For Temp = 9 To 0 Step (‑1)
Call SetCursorPos(AnimationTargetPosX + Temp, AnimationTargetPosY + Temp)
Call Sleep(2 + CLng(CSng(Temp) / 2!)) 'never use Sleep(0)
Next Temp
End If
For Temp = 1 To 50
Call SetCursorPos(AnimationTargetPosX, AnimationTargetPosY)
Call Sleep(2)
Next Temp
For Temp = 0 To 31
Call SetCursorPos(AnimationTargetPosX + Temp, AnimationTargetPosY + Temp)
Call Sleep(3 + CLng(CSng(Temp) / 6!)) 'never use Sleep(0)
Next Temp
End Sub
Private Sub GFMouseGuide_PerformAnimation3(ByVal AnimationTargetPosX As Long, ByVal AnimationTargetPosY As Long)
'on error resume next 'mouse pointer is shaking over target
Dim Temp As Long
For Temp = 1 To 100
Call SetCursorPos( _
AnimationTargetPosX + Int((15 ‑ 1 + 1) * Rnd(1) + 1) ‑ 7, _
AnimationTargetPosY + Int((15 ‑ 1 + 1) * Rnd(1) + 1) ‑ 7)
Call Sleep(3)
Next Temp
For Temp = 1 To 50
Call SetCursorPos(AnimationTargetPosX, AnimationTargetPosY)
Call Sleep(3)
Next Temp
End Sub
'**********************************END OF GFMOUSEGUIDE**********************************
[END OF FILE]