'创建气泡提示
'sHWnd 
'nText    提示文本
'nCon     标题
'nIco     图标样式  没有 = 0   通知 = 1   警告 = 2   出错 = 3
'nType    提示类型  经典的 = 1    气球状的 = 64
'Zong     位于中心的  =0跟随鼠标  =1固定
'bColor   背景色
'oColor   前景色
'vTime    显示时间，毫秒单位
'sTime    延迟时间，毫秒单位
'sx sy    显示位置     相对于窗口的坐标，就是鼠标移动到这个范围时才提示
'cx cy    显示范围
'SetToolTip  设置提示
'DestroyWindow m_hwndTip  销毁提示
Function ChuangJieQiPaoTiSi(sHWnd as HWnd ,nText as CWSTR , nCon as CWSTR ="", nIco as Long=0, _
    nType as Long=1, Zong as Long=0, _
    bColor as Long=&HFFFFFF ,  oColor as Long=0 , _
    vTime as Long=10000 , sTime as Long=200 , _
    sx as Long=0, sy as Long=0, cx as Long=0, cy as Long=0) as  HWnd  
'创建气泡提示
'sHWnd 
'nText    提示文本
'nCon     标题
'nIco     图标样式  没有 = 0   通知 = 1   警告 = 2   出错 = 3
'nType    提示类型  经典的 = 1    气球状的 = 64
'Zong     位于中心的  =0跟随鼠标  =1固定
'bColor   背景色
'oColor   前景色
'vTime    显示时间，毫秒单位
'sTime    延迟时间，毫秒单位
'sx sy    显示位置     相对于窗口的坐标，就是鼠标移动到这个范围时才提示
'cx cy    显示范围

    Dim m_hwndTip as   HWnd , Wz as Rect
    If nType=0 Then nType=1
    m_hwndTip = CreateWndTips(sHWnd, nType)
    If m_hwndTip = 0 Then Exit Function

    If sHWnd <> 0 Then
        If sx + sy + cx + cy = 0 Then
            GetClientRect sHWnd, @Wz
        Else
            Wz.Left = sx
            Wz.top = sy
            Wz.Right = cx
            Wz.bottom = cy
            
        End If
       
        SetToolTip sHWnd, Wz, m_hwndTip, nCon, nText,bColor,oColor,vTime,sTime,Zong,nIco
    End If
    Function=m_hwndTip
End Function

'--------------------------------------------------------------------------------
Function CreateWndTips(hWndParent as  HWnd , nStyle as Long) as  HWnd '创建提示窗口
    
    Dim dwFlags as Long, m_hwndTip as Long
    Dim ICEx as InitCommonControlsEx
    
    dwFlags = TTS_NOPREFIX Or TTS_ALWAYSTIP Or nStyle
    

        ICEx.dwSize = SizeOf(ICEx)
        ICEx.dwICC = ICC_WIN95_CLASSES

    
    InitCommonControlsEx @ICEx

    Function = CreateWindowExW(WS_EX_TOPMOST, @TOOLTIPS_CLASSW, Null, WS_POPUP Or dwFlags, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, hWndParent, 0, App.hInstance, 0)
    
'    SetWindowPos m_hwndTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
    
End Function
'--------------------------------------------------------------------------------
Sub SetToolTip(sHWnd as HWnd, xy as Rect, m_hwndTip as  HWnd , nCon as CWSTR ,nText as CWSTR ,bColor as Long, _
               oColor as Long,vTime as Long,sTime as Long , Zong as Long ,nIco as Long)
'设置提示
'sHWnd 控件Id
'xy   位置    相对于窗口的坐标，就是鼠标移动到这个范围时才提示
'nCon 标题 
'nText 提示文本 
'bColor 背景色
'oColor 前景色 
'vTime    显示时间
'sTime    延迟时间
'Zong     位于中心的
'nIco     图标样式  没有 = 0   通知 = 1   警告 = 2   出错 = 3
   Dim  tiInfo as TOOLINFOW, L as Long

'Type TOOLINFOA Dword
'   cbSize     As Dword        ' UINT cbSize
'   uFlags     As Dword        ' UINT uFlags
'   hwnd       As Dword        ' HWND hwnd
'   uId        As Dword        ' UINT_PTR uId
'   Rect       As Rect         ' RECT rect
'   hinst      As Dword        ' HINSTANCE hinst
'   lpszText   As Asciiz Ptr   ' LPSTR lpszText

        If Zong Then '位于中心的 = True
            tiInfo.uFlags = TTF_SUBCLASS Or TTF_CENTERTIP Or TTF_TRANSPARENT
        Else
            tiInfo.uFlags = TTF_SUBCLASS Or TTF_TRANSPARENT
        End If
        
        tiInfo.HWnd = sHWnd
        tiInfo.lpszText = nText.vptr
        tiInfo.hInst = App.hInstance
        tiInfo.Rect = xy
        tiInfo.cbSize = SizeOf(tiInfo)

    SendMessageW m_hwndTip, TTM_ADDTOOL, 0,Cast( LPARAM, VarPtr( tiInfo)) 

    If nCon <> "" Then
        SendMessageW m_hwndTip, TTM_SETTITLE, nIco,Cast( LPARAM, nCon.vptr)
    End If
    
    If bColor > 0 Then
        SendMessage m_hwndTip, TTM_SETTIPBKCOLOR, bColor, 0
    End If
    
    If oColor > 0 Then
        SendMessage m_hwndTip, TTM_SETTIPTEXTCOLOR, oColor, 0
    End If
    
    If vTime > 0 Then
        SendMessage m_hwndTip, TTM_SETDELAYTIME, TTDT_AUTOPOP,Cast( LPARAM, vTime) '显示时间
    End If
    If sTime >= 0 Then
       SendMessage m_hwndTip, TTM_SETDELAYTIME, TTDT_INITIAL, Cast( LPARAM,sTime) '延迟
    End If
SendMessage m_hwndTip, TTM_TRACKPOSITION, 0, &H640064
End Sub
