Selama ini VB hanya dapat menampilkan tooltip biasa dan hanya 1 baris,
coding berikut menampilkan "Multiline Tooltip" dengan gaya balon, dengan cara
menggeser cursor di commandbutton.
1. Buat 1 project dengan 1 Form
2. Tambahkan 2 Commanbutton
Copy coding dibawah ini dan paste di Editor Form:
Option Explicit
Private Declare Function CreateWindowEx Lib "user32" _
Alias "CreateWindowExA" (ByVal dwExStyle As Long, _
ByVal lpClassName As String, ByVal lpWindowName As _
String, ByVal dwStyle As Long, ByVal X As Long, _
ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight _
As Long, ByVal hWndParent As Long, ByVal hMenu _
As Long, ByVal hInstance As Long, lpParam As Any) _
As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
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
Private Declare Function GetClientRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function DestroyWindow Lib "user32" _
(ByVal hwnd As Long) As Long
'UDT (User Defined Type) RECT.
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'UDT TOOLINFO.
Private Type TOOLINFO
cbSize As Long
uFlags As Long
hwnd As Long
uid As Long
RECT As RECT
hinst As Long
lpszText As String
lParam As Long
End Type
Private Const CW_USEDEFAULT = &H80000000
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOSIZE = &H1
Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1
Private Const HWND_BOTTOM = 1
Private Const WS_POPUP = &H80000000
Private Const WS_EX_TOPMOST = &H8&
Private Const WM_USER = &H400
Private Const TTDT_AUTOMATIC = 0
Private Const TTDT_AUTOPOP = 2
Private Const TTDT_INITIAL = 3
Private Const TTDT_RESHOW = 1
Private Const TTF_ABSOLUTE = &H80
Private Const TTF_CENTERTIP = &H2
Private Const TTF_DI_SETITEM = &H8000
Private Const TTF_IDISHWND = &H1
Private Const TTF_RTLREADING = &H4
Private Const TTF_SUBCLASS = &H10
Private Const TTF_TRACK = &H20
Private Const TTF_TRANSPARENT = &H100
Private Const TTM_ACTIVATE = (WM_USER + 1)
Private Const TTM_ADDTOOLA = (WM_USER + 4)
Private Const TTM_ADDTOOLW = (WM_USER + 50)
Private Const TTM_ADJUSTRECT = (WM_USER + 31)
Private Const TTM_DELTOOLA = (WM_USER + 5)
Private Const TTM_DELTOOLW = (WM_USER + 51)
Private Const TTM_ENUMTOOLSA = (WM_USER + 14)
Private Const TTM_ENUMTOOLSW = (WM_USER + 58)
Private Const TTM_GETBUBBLESIZE = (WM_USER + 30)
Private Const TTM_GETCURRENTTOOLA = (WM_USER + 15)
Private Const TTM_GETCURRENTTOOLW = (WM_USER + 59)
Private Const TTM_GETDELAYTIME = (WM_USER + 21)
Private Const TTM_GETMARGIN = (WM_USER + 27)
Private Const TTM_GETMAXTIPWIDTH = (WM_USER + 25)
Private Const TTM_GETTEXTA = (WM_USER + 11)
Private Const TTM_GETTEXTW = (WM_USER + 56)
Private Const TTM_GETTIPBKCOLOR = (WM_USER + 22)
Private Const TTM_GETTIPTEXTCOLOR = (WM_USER + 23)
Private Const TTM_GETTOOLCOUNT = (WM_USER + 13)
Private Const TTM_GETTOOLINFOA = (WM_USER + 8)
Private Const TTM_GETTOOLINFOW = (WM_USER + 53)
Private Const TTM_HITTESTA = (WM_USER + 10)
Private Const TTM_HITTESTW = (WM_USER + 55)
Private Const TTM_NEWTOOLRECTA = (WM_USER + 6)
Private Const TTM_NEWTOOLRECTW = (WM_USER + 52)
Private Const TTM_POP = (WM_USER + 28)
Private Const TTM_RELAYEVENT = (WM_USER + 7)
Private Const TTM_SETDELAYTIME = (WM_USER + 3)
Private Const TTM_SETMARGIN = (WM_USER + 26)
Private Const TTM_SETMAXTIPWIDTH = (WM_USER + 24)
Private Const TTM_SETTIPBKCOLOR = (WM_USER + 19)
Private Const TTM_SETTIPTEXTCOLOR = (WM_USER + 20)
Private Const TTM_SETTITLEA = (WM_USER + 32)
Private Const TTM_SETTITLEW = (WM_USER + 33)
Private Const TTM_SETTOOLINFOA = (WM_USER + 9)
Private Const TTM_SETTOOLINFOW = (WM_USER + 54)
Private Const TTM_TRACKACTIVATE = (WM_USER + 17)
Private Const TTM_TRACKPOSITION = (WM_USER + 18)
Private Const TTM_UPDATE = (WM_USER + 29)
Private Const TTM_UPDATETIPTEXTA = (WM_USER + 12)
Private Const TTM_UPDATETIPTEXTW = (WM_USER + 57)
Private Const TTM_WINDOWFROMPOINT = (WM_USER + 16)
Private Const TTS_ALWAYSTIP = &H1
Private Const TTS_BALLOON = &H40
Private Const TTS_NOANIMATE = &H10
Private Const TTS_NOFADE = &H20
Private Const TTS_NOPREFIX = &H2
Private Const TOOLTIPS_CLASS = "tooltips_class"
Private Const TOOLTIPS_CLASSA = "tooltips_class32"
Dim hwndTT As Long
Private Sub Form_Load()
Dim ti As TOOLINFO
Dim RECT As RECT
Dim uid As Long
uid = 0
Dim strPntr As String
strPntr = "Inilah tooltip yang dibuat dengan menggunakan fungsi API. " & _
vbCrLf & "Seperti yang dapat Anda lihat, dia kini mendukung banyak baris, " & vbCrLf & _
"pindah baris, menampilkan batas atau jendela tooltip bergaya balon, " & vbCrLf & _
"serta dapat menampilkan warna latar dan huruf sesuai keinginan."
Dim RetVal As Long
hwndTT = CreateWindowEx(WS_EX_TOPMOST, _
TOOLTIPS_CLASSA, vbNullString, _
WS_POPUP Or TTS_NOPREFIX Or TTS_BALLOON, _
CW_USEDEFAULT, CW_USEDEFAULT, _
CW_USEDEFAULT, CW_USEDEFAULT, _
Me.hwnd, 0, App.hInstance, 0)
SetWindowPos hwndTT, HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE
GetClientRect Command1.hwnd, RECT
ti.cbSize = Len(ti)
ti.uFlags = TTF_CENTERTIP Or TTF_SUBCLASS
ti.hwnd = Command1.hwnd
ti.hinst = App.hInstance
ti.uid = uid
ti.lpszText = strPntr
ti.RECT.Left = RECT.Left
ti.RECT.Top = RECT.Top
ti.RECT.Right = RECT.Right
ti.RECT.Bottom = RECT.Bottom
RetVal = SendMessage(hwndTT, TTM_ADDTOOLA, 0, ti)
RetVal = SendMessage(hwndTT, TTM_SETMAXTIPWIDTH, _
0, 80)
RetVal = SendMessage(hwndTT, TTM_SETTIPBKCOLOR, _
&HC0FFC0, 0)
RetVal = SendMessage(hwndTT, TTM_SETTIPTEXTCOLOR, _
vbBlue, 0)
RetVal = SendMessage(hwndTT, TTM_UPDATETIPTEXTA, 0, ti)
Command2.ToolTipText = "Inilah tooltip standar VB." & vbCrLf & _
"Seperti yang Anda lihat, karakter CrLf di sebelah kiri " & "baris ini tidak berfungsi di sini. " & _
vbCrLf & "Karakter VbCrLf ditandai dengan garis dua tebal vertikal"
End Sub
Private Sub Form_Unload(Cancel As Integer)
DestroyWindow hwndTT
End Sub
Tidak ada komentar:
Posting Komentar