Article ID: 186428
Article Last Modified on 7/1/2004
Option Explicit
Private Declare Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, phkResult _
As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _
As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, _
lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Private Const HKEY_C_U = &H80000001 ' HKEY_CURRENT_USER
Private Const subkey = "Control Panel\Microsoft Input Devices\Mouse"
Private buttonHandle As Long
Public Sub setDefaultButton(colControls As Object)
Dim iIterate As Integer
For iIterate = 0 To colControls.Count - 1
If TypeOf colControls(iIterate) Is CommandButton Then
If colControls(iIterate).Default = True Then
buttonHandle = colControls(iIterate).hwnd
Exit For
End If
End If
Next iIterate
End Sub
Public Function snapTo()
Dim buttonRect As RECT
Dim RetVal As Long
Dim x As Long
Dim y As Long
If buttonHandle And _
RegGetString$(HKEY_C_U, subkey, "SnapTo") = "ON" Then
RetVal = GetWindowRect(buttonHandle, buttonRect)
With buttonRect
x = .left + ((.right - .left) / 2)
y = .top + ((.bottom - .top) / 2)
End With
DoEvents
RetVal = SetCursorPos(x, y)
snapTo = True
Else
snapTo = False
End If
End Function
Function RegGetString$(hInKey As Long, ByVal subkey$, ByVal valname$)
Dim RetVal$, hSubKey As Long, dwType As Long, vSZ As Long
Dim R As Long, v$
RetVal$ = ""
Const ERROR_SUCCESS& = 0
Const REG_SZ& = 1
Const KEY_READ = &H20019
R = RegOpenKeyEx(hInKey, subkey$, 0, KEY_READ, hSubKey)
If R <> ERROR_SUCCESS Then GoTo Quit_Now
vSZ = 256: v$ = String$(vSZ, 0)
R = RegQueryValueEx(hSubKey, valname$, 0, dwType, ByVal v$, vSZ)
If R = ERROR_SUCCESS And dwType = REG_SZ Then
RetVal$ = left$(v$, vSZ - 1)
Else
RetVal$ = "--Not String--"
End If
If hInKey = 0 Then R = RegCloseKey(hSubKey)
Quit_Now:
RegGetString$ = RetVal$
End Function
Dim objSnap As Snap
Private Sub Command1_Click()
Form2.Show
End Sub
Private Sub Form_Activate()
objSnap.snapTo
End Sub
Private Sub Form_Load()
Command1.Caption = "Show Form2"
Command2.Caption = "Default Button"
Set objSnap = New Snap
' determine the default button and save it in the Snap class
Call objSnap.setDefaultButton(Me.Controls)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set objSnap = Nothing
End Sub
143274
: How To Retrieve Printer Name from Windows 95 Registry in VB
166199
: SnapTo Feature May Not Work in Mouse Orientation Tool
Keywords: kbhowto kbinterop KB186428