Kamis, 01 April 2010

Fungsi MouseHover

Fungsi ini biasanya digunakan untuk mendeteksi kursor mouse, apakah didalam atau diluar area suatu kontrol.

Buat Module baru dan ketikkan :
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Public Function MouseHover(Ctl As Control) As Boolean
Dim X As Single, Y As Single
Dim xyCursor As POINTAPI

SetCapture Ctl.hwnd
GetCursorPos xyCursor
ScreenToClient Ctl.hwnd, xyCursor

X = xyCursor.X * Screen.TwipsPerPixelX
Y = xyCursor.Y * Screen.TwipsPerPixelY

If X < 0 Or Y < 0 Or X > Ctl.Width Or Y > Ctl.Height Then
ReleaseCapture
MouseHover = False
Else
MouseHover = True
End If
End Function

Sebagai contoh penggunaannya, buat sebuah CommandButton (Style=Graphical) baru, lalu pada bagian 'Command1_MouseMove' ketikkan :
If MouseHover(Command1) Then
Command1.BackColor = vbRed
Else
Command1.BackColor = vbButtonFace
End If

CATATAN : Fungsi ini tidak dapat digunakan untuk kontrol yang tidak mempunyai properti 'hWnd'.

Label: , ,

0 Komentar:

Posting Komentar

Pengunjung yang baik selalu meninggalkan jejak berupa komentar. :)

Berlangganan Posting Komentar [Atom]

<< Beranda