Saturday, April 17, 2010

Menampilkan Kata Yang Berada Di atas Pointer Mouse - VB6

Ini merupakan fungsi untuk menampilkan kata yang berada tepat di bawah pointer mouse. Fungsi ini hanya berjalan pada object RichTextBox. Bagaimana implementasi dari kodenya? bisa Anda perhatikan di bawah:
Option Explicit 

Private Const
EM_CHARFROMPOS& = &HD7

Private Type
POINTAPI
x As Long
y As Long
End Type

Private Declare Function
SendMessage Lib "USER32" Alias "SendMessageA" ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

' Return the word the mouse is over.
Public Function RichWordOver(rch As RichTextBox, x As Single, y As Single) As String

Dim pt As
POINTAPI
Dim Pos As Integer
Dim
start_pos As Integer
Dim
end_pos As Integer
Dim ch As String
Dim
txt As String
Dim
txtlen As Integer

' Convert the position to pixels.
pt.x = x \ Screen.TwipsPerPixelX
pt.y = y \ Screen.TwipsPerPixelY

' Get the character number
Pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt)
If Pos <= 0 Then Exit Function

' Find the start of the word.
txt = rch.Text
For start_pos = Pos To 1 Step -1
ch = Mid$(rch.Text, start_pos, 1)
' Allow digits, letters, and underscores.
If Not _
ch >= "0" And ch <= "9") Or _
ch >= "a" And ch <= "z") Or _
ch >= "A" And ch <= "Z") Or _
ch = "_" _
) Then Exit For
Next
start_pos
start_pos = start_pos + 1

' Find the end of the word.
txtlen = Len(txt)
For end_pos = Pos To txtlen
ch = Mid$(txt, end_pos, 1)
' Allow digits, letters, and underscores.
If Not _
ch >= "0" And ch <= "9") Or _
ch >= "a" And ch <= "z") Or _
ch >= "A" And ch <= "Z") Or _
ch = "_" _
) Then Exit For
Next
end_pos
end_pos = end_pos - 1

If
start_pos <= end_pos Then RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1)
End Function
Contoh penggunaanya:
Option Explicit 

Dim
strWordOver As String

Private Sub
RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
strWordOver = RichWordOver(RichTextBox1, x, y)
If Trim(strWordOver) = "" Then Exit Sub
If
Text1.Text <> strWordOver Then
Text1.Text = strWordOver
End If
End Sub