extooltip.cls

工具条演示程序 工具条演示程序

              If Not Nothing Is M_ExWindow.Pic Then DrawBkgImgDC ClientRect, M_ExWindow.Pic.Handle
           '============================================================================================
           '/-- Gradient BackGround Fill
           Else
              DrawGradient mGCEnd, mGCStart, ClientRect, m_Hdc, IIf(mBackStyle = TTGdtH, True, False)
           End If
           '============================================================================================
           '/-- Draw the Tooltip Body Border.
           DrawRgnRectangle rgn2, mTextColor, m_Hdc
               
     End With
        

     DeleteObject rgnNorm  '//-- Delete Rgn
     DeleteObject rgn2     '//-- Delete Rgn
     SetBkMode m_Hdc, 1    '//-- Sets the background mix mode (TRANSPARENT Background remains untouched)
     
     '============================================================================================
     '/-- Draw The Icon
     With M_ExWindow
        If .Icon <> 0 Then
            Select Case .Icon
                Case TTI_ERROR, TTI_INFO, TTI_WARNING
                    If mIconSize > TTIcon24 Then
                       ExtractIconEx GetSystemDir & "\comctl32.dll", .Icon, hIcon, 0, 1
                    Else
                       ExtractIconEx GetSystemDir & "\comctl32.dll", .Icon, 0, hIcon, 1
                    End If
                    DrawIconEx m_Hdc, 12, 8 + IIf(.aExt > 0, .aExt, 0), hIcon, mIconSize, mIconSize, 0, 0, DI_NORMAL
                    DestroyIcon hIcon
                Case Else
                    DrawIconEx m_Hdc, 12, 8 + IIf(.aExt > 0, .aExt, 0), .Icon, mIconSize, mIconSize, 0, 0, DI_NORMAL
            End Select
        End If
        '============================================================================================
        '/-- Draw the Title.
        DrawTexto .Title, True
        '============================================================================================
        '/-- Draw the Text.
        DrawTexto .Text, False, .Title
     End With
     
  End Sub

'======================================================================
'RETRIVES THE SYSTEM DIRECTORY
Private Function GetSystemDir() As String
Dim sSave   As String
Dim Ret     As Long

'Create a buffer
 sSave = Space(255)
'Get the system directory
 Ret = GetSystemDirectory(sSave, 255)
'Remove all unnecessary chr$(0)'s
 GetSystemDir = Left$(sSave, Ret)

End Function
'======================================================================


Public Sub ShowToolTip(ByVal aWnd As Long, ByVal Title As String, ByVal Text As String, ByVal cIcon As Long, Optional TransparentAlpha As Long = 100)
     
  With M_ExWindow
     
          Call StopAll                           '//-- Avoid having the same Window Subclassed again.
                                             
          LWnd = aWnd                            '//-- Pass Parameters to memory
          .Title = Title                         '//-- Pass Parameters to memory
          .Text = Text                           '//-- Pass Parameters to memory
          .Alpha = TransparentAlpha              '//-- Pass Parameters to memory
          .TextH = 0                             '//-- Reset Height Value
          .TextW = 0                             '//-- Reset Widht Value
          .Icon = cIcon                          '//-- Pass Parameters to memory
          Call SetToolTipRect(True)              '//-- Calculate Title Dimensions
          Call SetToolTipRect(False)             '//-- Calculate Text Dimensions
          .Height = M_ExWindow.TextH + IIf(LenB(StrConv(Trim(M_ExWindow.Title), vbFromUnicode)) > 0, 13, 0)
          .Width = M_ExWindow.TextW + 20
                    
          If CreateNewWindow() <> -1 Then mAlive = True   '/-- Start Core Work
                                        
  End With
       
End Sub


Private Function CreateToolTip() As Boolean
    
    Dim XL As Long
    Dim YL As Long
       
   
    With M_ExWindow
           
        'The CreateWindowEx function creates an overlapped, pop-up, or child window with an extended style;
        'otherwise, this function is identical to the CreateWindow function.
        '//-- FYI : #32770: Is the class for dialog boxes.
        '//-- Create a "MFGTOOLTIP" window where the mouse cursor is located.
        '//-- FYI : WS_EX_TOOLWINDOW disables the ShowInTaskBar Window Style.
        .hwnd = CreateWindowEx(WS_EX_TOOLWINDOW, "#32770", "MFG-EXTOOLTIP", 0, CPOS.X, CPOS.Y, .Width, .Height, 0, 0, App.hInstance, 0)
            
        If .hwnd = 0 Then Exit Function '//-- hWnd not found, system error.
                          
        .X = CPOS.X        '//-- Assign X Cursor Coords to Mem.
        .Y = CPOS.Y        '//-- Assign Y Cursor Coords to Mem.
    
        XL = .Width + .X   '//-- ToolTip Rectangle Right-Side.
        YL = .Height + .Y  '//-- ToolTip Rectangle Bottom-Side.
        
        .Width = .Width
        .Height = .Height
        
        '============================================================================
        '//-- Calculate if ToolTip fits on Screen X Coords.
        '============================================================================
        If XL > (Screen.Width / Screen.TwipsPerPixelX) Then
            .bExt = IIf(mToolTipStyle = TTStandard, .aExt = -2, -17)
            .X = .X - .Width
        Else
            .bExt = IIf(mToolTipStyle = TTStandard, .aExt = 2, 17)
            .X = .X + 1
        End If
               
        '============================================================================
        '//-- Calculate if ToolTip fits on Screen Y Coords.
        '============================================================================
        If YL > (Screen.Height / Screen.TwipsPerPixelY) Then
            .aExt = IIf(mToolTipStyle = TTStandard, .aExt = -2, -17)
            .Y = .Y - .Height
        ElseIf .Y - .Height - 20 < 0 Then
            .aExt = IIf(mToolTipStyle = TTStandard, .aExt = 2, 17)
            .Y = .Y + 1
        Else
        '//-- FYI : By default ToolTips always appear on the TOP-LEFT of the screen.
            .aExt = IIf(mToolTipStyle = TTStandard, .aExt = -2, -17)
            .Y = .Y - .Height
        End If
         
        
        '============================================================================
        '//-- Change the window styles, so it can look like a real Tooltip.
        If ChangeWindowStyles(.hwnd) = 0 Then Exit Function
        '============================================================================
        
        '============================================================================
        '//-- Add Shadow to the Tooltip Window, if selected. <Only Layered OS>
        SetClassLong .hwnd, GCL_STYLE, IIf(mShadow = True, GetClassLong(.hwnd, GCL_STYLE) Or CS_DROPSHADOW, 0)
        '============================================================================
                  
        GetWindowRect .hwnd, .hRect                                                    '//-- Get The New ToolTip Coords.
            
        With .hRect
            m_Hdc = ThDC(.Right - .Left, .Bottom - .TOP)                               '//-- Create a Temporary DC, with given Coordinates.
            DCImageDraw m_Hdc, 0, 0, .Right - .Left, .Bottom - .TOP                    '//-- Function that Draws the Tooltip in the temp DC.
            ShowWindow M_ExWindow.hwnd, 4                                              '//-- Displays a window in its most recent size and position. The active window remains active.
            '===============================================================================
            pDraw GetDC(M_ExWindow.hwnd), 0, 0, .Right - .Left, .Bottom - .TOP, 0, 0   '//-- Draw The Temp DC into the Real Window DC.
            '===============================================================================
        End With
        
        pDestroy                '//-- Destroy the Temporary DC.
        ReleaseDC m_Hdc, .hwnd  '//-- The ReleaseDC function releases the window device context (DC), freeing it for use by other applications.
        
        Call Start(.hwnd)                            '//-- SubClass The Tooltip.
        Call AddMsg(.hwnd, WM_DESTROY, MSG_AFTER)
              
    End With
        
       
    CreateToolTip = True         '//-- The MFG ExTooltip was successfully created.
   
       
End Function



Private Sub DCImageDraw( _
            ByVal DstDC As Long, _
            ByVal DstX As Long, _
            ByVal DstY As Long, _
            ByVal DstW As Long, _
            ByVal DstH As Long)
    
    Dim INFO       As BITMAPINFO  'INFO
    Dim Data1()    As RGBQUAD     'RGB
    Dim Data2()    As RGBQUAD     'RGB
    Dim SrcDC      As Long        'DC
    Dim DataDC     As Long        'DC
    Dim DataBmp    As Long        'BMP
    Dim DataObj    As Long        'OBJ
    Dim I          As Long        'COUNTER
    Dim F          As Long        'COUNTER
    Dim A          As Long        'COUNTER
    Dim AlphaD     As Long        'ALPHA PERCENT
    Dim AlphaS     As Long        'ALPHA PERCENT
    
    
    With INFO.bmiHeader
        .biSize = Len(INFO.bmiHeader)   '//-- Specifies the number of bytes required by the structure.
        .biWidth = DstW                 '//-- Specifies the width of the bitmap, in pixels.
        .biHeight = DstH                '//-- Specifies the height of the bitmap, in pixels.
        .biPlanes = 1                   '//-- Specifies the number of planes for the target device. This value must be set to 1.
        .biBitCount = 32                '//-- Specifies the number of bits per pixel.
        .biCompression = 0              '//-- Specifies the type of compression for a compressed bottom-up bitmap.
        .biClrUsed = 0                  '//-- Specifies the number of color indexes in the color table that are actually used by the bitmap.
        .biClrImportant = 0             '//-- Specifies the number of color indexes that are required for displaying the bitmap.
        .biSizeImage = DstW * DstH      '//-- Specifies the size, in bytes, of the image.
    End With
       
    '-----------------------------------------------------------------
    '//-- Fill the Color Table
    '-----------------------------------------------------------------
    For I = 0 To 255
        For F = 0 To 255
            A = I + F
            If A > 255 Then A = 255     '//-- Sanity Color Check
            mCC(I, F) = A
        Next F
    Next I
    
    '-----------------------------------------------------------------
    '//-- Fill the Percent Table
    '-----------------------------------------------------------------
    For I = 0 To 100
        For F = 0 To 255
            mCP(I, F) = F / 100 * I     '//-- Alpha Percent (255 RGB)
        Next F
    Next I
    
    CreateBallonRegion
    DrawToolTipBody
    
    SrcDC = CreateCompatibleDC(0)       '//-- Create a Temp DC.
       
    With M_ExWindow.hRect
       DataObj = CaptureWindow(0, .Left, .TOP, .Right - .Left, .Bottom - .TOP)
    End With
    
    SelectObject SrcDC, DataObj
    DeleteObject DataObj

    GetDCDBitsFromDevice DataDC, DataBmp, DataObj, SrcDC, DstDC, DstH, DstW, Data1, INFO, False
    GetDCDBitsFromDevice DataDC, DataBmp, DataObj, SrcDC, DstDC, DstH, DstW, Data2,