Balloon Tooltips

(TTM_TRACKACTIVATE=(&H400+17

(TTM_TRACKPOSITION=(&H400+18

(TTM_ACTIVATE=(&H400+1

CW_USEDEFAULT = &80000000
        TTM_ADDTOOL = &404
        TTM_TRACKACTIVATE = &411
        TTM_UPDATETIPTEXT = &40C
        TTS_BALLOON = 64
        TTS_ALWAYSTIP = 1
        TTS_NOPREFIX = 2
 
        WS_POPUP = &80000000

TTF_RTLREADING=&H4

TTF_TRACK=&H20

TTF_CENTERTIP=&H2

TTF_SUBCLASS=&H10

TTF_TRANSPARENT=&H100

TTF_ABSOLUTE=&H80

Type TOOLINFOA

cbSize As Long

uFlags As Long

hwnd As Long

uId As Long

rect As RECT

hinst As Long

lpszText As String

End Type

 : uFlags
TTF_CENTERTIP
TTF_RTLREADING
TTF_SUBCLASS
TTF_TRACK

---

TTM_TRACKACTIVATE message
wParam : True(Activate tracking) /False(Deactivate

 tracking)

lParam
Pointer to a TOOLINFO structure that identifies the tool to which this message applies. The hwnd and uId members identify the tool, and the cbSize member specifies the size of the structure. All other 

.members are ignored

---

TTM_TRACKPOSITION message

.Sets the position of a tracking tooltip

wParam

.Must be zero

lParam

The LOWORD specifies the x-coordinate of the point at which the tracking tooltip will be displayed, in screen coordinates. The HIWORD specifies the y-coordinate of the point at which the tracking tooltip will 

.be  displayed, in screen coordinates

---

To have tooltip windows displayed at specific coordinates, include th TTF_ABSOLUTE flag in the uFlagsmember of the TOOLINFO 

.structure .when  adding the tool

WM_CREAT

g_hwndTT =CreateWindow(TOOLTIPS_CLASS,NULL, WS_POPUP Or TTS_ALWAYSTIP Or 

(TTS_BALLOON,0,0,0,0,hWnd,0,0,0
if not g_hwndTT  Then
MessageBeep(0) ' just to signal error somehow
(g_ti.cbSize =Len(TOOLINFO
g_ti.uFlags=TTF_TRACK Or TTF_ABSOLUTE
g_ti.hwnd=hWnd
"g_ti.lpszText="Hi there
(if( ! SendMessage(g_hwndTT, TTM_ADDTOOL,0, g_ti) )

MessageBeep(0) ' just to have some error signal 'subclass edit control
SetWindowSubclass  hEdit, EditSubProc, 0, 0
return 0



,EditSubProc ( HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam, UINT_PTR 

(uIdSubclass, DWORD_PTR dwRefData 

Select Case  message
case WM_CHAR
!if not isdigit( wParam ) ' if not a number pop a tooltip
Dim ebt As EDITBALLOONTIP
(ebt.cbStruct = Len(EDITBALLOONTIP

"!ebt.pszText =" Tooltip text
"!!!ebt.pszTitle =" Tooltip title
ebt.ttiIcon =TTI_ERROR_LARGE 'tooltip icon
(SendMessage(hwnd, EM_SHOWBALLOONTIP, 0,ebt

return FALSE
else
(SendMessage(hwnd, EM_HIDEBALLOONTIP,0,0
,return DefSubclassProc( hwnd, message, wParam,

(lParam 

tooltip-for-button

---

Private Type TOldWndProc
    hwnd As Long
    lPrevWndProc As Long
End Type

Private WndProc() As TOldWndProc
Private NumTips As Long
Const iOffset = 8
Const FontType = "Tahoma" & vbNullChar
Const FontSize = 13

Private Function CustomTipProc(ByVal hwnd As Long, ByVal uiMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long


Case WM_PAINT
          Get the Current Window Rect'
        GetWindowRect hwnd, rc
        GetCursorPos CurPos
        rc.Right = CurPos.x - iOffset + 6 + rc.Right - rc.Left
        rc.Bottom = CurPos.y + 20 + rc.Bottom - rc.Top
        rc.Left = CurPos.x - iOffset + 6
        rc.Top = CurPos.y + 20
        MoveWindow hwnd, rc.Left, rc.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, False
BeginPaint hwnd, ps
  .
.
.

ToolTip_DrawBalloon hwnd, ps.hdc, lpszText
EndPaint hwnd, ps
CustomTipProc = 0


Case Else
        ' Sends message to previous procedure
        For i = 0 To NumTips - 1
            If WndProc(i).hwnd = hwnd Then
                CustomTipProc = CallWindowProc(WndProc(i).lPrevWndProc, hwnd, uiMsg, _
                    wParam, lParam)
                Exit For
            End If
        Next
    End Select
End Function


,Private Sub ToolTip_DrawBalloon(hwndTip As Long,

(hdc As Long, lpszText As String
    Dim rc As RECT
    Dim hRgn, hrgn1, hrgn2 As Long
    Dim pts(0 To 2) As POINTAPI

    GetClientRect hwndTip, rc
    pts(0).x = rc.Left + iOffset
    pts(0).y = rc.Top
    pts(1).x = pts(0).x
    pts(1).y = pts(0).y + iOffset
    pts(2).x = pts(1).x + iOffset
    pts(2).y = pts(1).y
    hRgn = CreateRectRgn(0, 0, 0, 0)
    ' Create the rounded box
    hrgn1 = CreateRoundRectRgn(rc.Left, rc.Top + iOffset, rc.Right, rc.Bottom, 15, 15)
    ' Create the arrow
    hrgn2 = CreatePolygonRgn(pts(0), 3, ALTERNATE)
    ' combine the two regions
    CombineRgn hRgn, hrgn1, hrgn2, RGN_OR
    ' Fill the Region with the Standard BackColor of the ToolTip Window
    FillRgn hdc, hRgn, GetSysColorBrush(COLOR_INFOBK

    Draw the Frame Region'
    FrameRgn hdc, hRgn, GetStockObject(DKGRAY_BRUSH), 1, 1
    rc.Top = rc.Top + iOffset * 2
    rc.Bottom = rc.Bottom - iOffset
    rc.Left = rc.Left + iOffset
    rc.Right = rc.Right - iOffset
    ' Draw the Shadow Text
    SetTextColor hdc, GetSysColor(COLOR_3DLIGHT)
    DrawText hdc, lpszText, Len(lpszText), rc, DT_VCENTER + DT_NOCLIP
    rc.Left = rc.Left - 1
    rc.Top = rc.Top - 1
    ' Draw the Text
    SetTextColor hdc, GetSysColor(COLOR_INFOTEXT)
    DrawText hdc, lpszText, Len(lpszText), rc, DT_VCENTER + DT_NOCLIP
End Sub

Public Sub AddCustomToolTip(x As Object, ToolTipText As String, FormOwner As Form)
    Dim ti As TOOLINFO
    Dim dwStyle As Long
    Dim hTip As Long

      A tooltip control with the TTS_ALWAYSTIP style 

appears when the cursor is on a tool, regardless of whether the tooltip control's owner window is active or inactive. Without this style, the tooltip control appears when the tool's  owner window is active, but not when it 

.is inactive

    hTip=CreateWindowEx(0&, "tooltips_class32", "", TTS_ALWAYSTIP, CW_USEDEFAULT,CW_USEDEFAULT, CW_USEDEFAULT, 

(CW_USEDEFAULT, FormOwner.hwnd,0,0,0

     (ti.cbSize = Len(ti

    ti.uFlags =TTF_IDISHWND +TTF_SUBCLASS
    ti.hwnd = x.hwnd
    ti.uId = x.hwnd
    ti.lpszText = ToolTipText

    SendMessage hTip,TTM_ADDTOOL,0,ti

    ' SubClass the tooltip window
     (ReDim Preserve WndProc(NumTips
    WndProc(NumTips).lPrevWndProc = SetWindowLong(hTip,GWL_WNDPROC, AddressOf 

(CustomTipProc
    WndProc(NumTips).hwnd=hTip
    NumTips = NumTips + 1
    Remove Border from ToolTip'

     (dwStyle = GetWindowLong(hTip, GWL_STYLE
     (dwStyle = dwStyle And (Not WS_BORDER
    SetWindowLong hTip, GWL_STYLE, dwStyle
End Sub

()Private Sub Form_Load
  AddCustomToolTip Command2, "This is another" & vbCrLf & "custom ToolTip", Form1
AddCustomToolTip Command3, "Hi! I'm a Tip", Form1
AddCustomToolTip Text1, "TextBox ToolTip", Form1
End Sub

ارسال پیام به ToolTips 

SendMessage (HWND)ToolTipCtrl,TTM_SETTITLE(adds a standard 

--icon and title string to a ToolTip),(WPARAM) tti_ICON  [TTI_NONE = 0 - no icon] [TTI_INFO = 1 - information icon] [TTI_WARNING = 2 - warning icon] [TTI_ERROR = 3 - error icon],(LPARAM) (LPCTSTR) title