Friday, June 8, 2012

Memeriksa Apakah Pointer Mouse Masuk Di atas Sebuah Objek

Menjelaskan mengenai cara untuk memeriksa apakah pointer/cursor mouse berada di atas sebuah objek - Terkadang kita memerlukan sebuah kode untuk memeriksa apakah cursor atau pointer berada di atas sebuah objek, misalnya untuk keperluan hover, dsb. Untuk kasus objek yang memiliki property .hwnd hal tersebut mudah sekali dilakukan yaitu dengan memanggil fungsi API SetCapture dan ReleaseCapture, tapi bagaimana jika objek tersebut tidak memiliki property .hwnd, misalnya objek label atau image?

Di bawah ini merupakan module untuk memeriksa apakah pointer atau cursor berada di atas sebuah objek, untuk mengujinya sediakan 1 Timer dengan property Name = tmrInBox, kemudian 1 PictureBox dengan properpty Name = Picture1 (default).
'simpan kode di bawah pada sebuah module 
Option Explicit

Private Declare Function
ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function
GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type
POINTAPI
x As Long
y As Long
End Type

Public Function
InBox(ctl As Control) As Boolean
Dim pt As
POINTAPI
GetCursorPos pt
ScreenToClient ctl.Parent.hwnd, pt
InBox = Not (pt.x < ctl.Left Or pt.y < ctl.Top Or pt.x > ctl.Left + ctl.Width Or pt.y > ctl.Top + ctl.Height)
End Function

'simpan kode di bawah pada form 
Option Explicit

Dim
blnFlag As Boolean

Private Sub
Form_Load()
Form1.ScaleMode = vbPixels 'pixels units
tmrInBox.Interval = 10 'or 1 if posible
End Sub

Private Sub
tmrInBox_Timer()
If Not InBox(Picture1) Then
blnFlag = False
tmrInBox.Enabled = False
Picture1.BackColor = vbBlack
End If
End Sub

Private Sub
Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If blnFlag Then Exit Sub
blnFlag = True
tmrInBox.Enabled = True
Picture1.BackColor = vbWhite
End Sub