extooltip.cls

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

  zSetTrue = True
  bValue = True
End Function



Public Property Let Alive(ByVal vData As Boolean)
   mAlive = vData
End Property

Public Property Get Alive() As Boolean
   Alive = mAlive
End Property

Public Property Let Shadow(ByVal vData As Boolean)
   mShadow = vData
End Property

Public Property Get Shadow() As Boolean
   Shadow = mShadow
End Property

Public Property Get Font() As IFont
   Set Font = m_fnt
End Property

Public Property Set Font(ByRef fnt As IFont)
   Set m_fnt = fnt    'Defined By System but can change by user choice.
End Property

Public Property Let Font(ByRef fnt As IFont)
   Set m_fnt = fnt
End Property

Public Property Let IconSize(ByVal vData As ttIconSize)
   mIconSize = vData
End Property

Public Property Get IconSize() As ttIconSize
   IconSize = mIconSize
End Property

Public Property Let ToolTipStyle(ByVal Style As ttStyleEnum)
   mToolTipStyle = Style
End Property

Public Property Get ToolTipStyle() As ttStyleEnum
   ToolTipStyle = mToolTipStyle
End Property

Public Property Let TextColor(ByVal vcolor As Long)
   mTextColor = vcolor
End Property

Public Property Get TextColor() As Long
   TextColor = mTextColor
End Property

Public Property Let GradientColorStart(ByVal vcolor As Long)
   mGCStart = vcolor
End Property

Public Property Get GradientColorStart() As Long
   GradientColorStart = mGCStart
End Property

Public Property Let GradientColorEnd(ByVal vcolor As Long)
   mGCEnd = vcolor
End Property

Public Property Get GradientColorEnd() As Long
   GradientColorEnd = mGCEnd
End Property

Public Property Let BackColor(ByVal vcolor As Long)
   mBackColor = vcolor
End Property

Public Property Get BackColor() As Long
   BackColor = mBackColor
End Property

Public Property Let BackStyle(ByVal bStyle As Long)
   mBackStyle = bStyle
End Property

Public Property Get BackStyle() As Long
   BackStyle = mBackStyle
End Property

Public Property Let DelayTime(ByVal Time As Long)
   mDelayTime = Time
End Property

Public Property Get DelayTime() As Long
   DelayTime = mDelayTime
End Property

Public Property Let KillTime(ByVal Time As Long)
   mKillTime = Time
End Property

Public Property Get KillTime() As Long
   KillTime = mKillTime
End Property

Public Property Set Picture(xPic As StdPicture)
    Set M_ExWindow.Pic = xPic
End Property

Public Property Get Picture() As StdPicture
Set Picture = M_ExWindow.Pic
End Property


'======================================================================
'CONVERTION FUNCTION
Private Function GetLngColor(Color As Long) As Long

    If (Color And &H80000000) Then
        GetLngColor = GetSysColor(Color And &H7FFFFFFF)
    Else
        GetLngColor = Color
    End If

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

'======================================================================
'DRAWS A LINE WITH A DEFINED COLOR
Private Sub DrawLine( _
           ByVal X As Long, _
           ByVal Y As Long, _
           ByVal Width As Long, _
           ByVal Height As Long, _
           ByVal cHdc As Long, _
           ByVal Color As Long)

    Dim Pen1    As Long
    Dim Pen2    As Long
    Dim Outline As Long
    Dim POS     As POINTAPI

    Pen1 = CreatePen(0, 1, GetLngColor(Color))
    Pen2 = SelectObject(cHdc, Pen1)
    
        MoveToEx cHdc, X, Y, POS
        LineTo cHdc, Width, Height
          
    SelectObject cHdc, Pen2
    DeleteObject Pen2
    DeleteObject Pen1

End Sub
'======================================================================

'======================================================================
'DRAWS A FILL RECTANGLE AREA OF AN SPECIFIED COLOR
Private Sub DrawFillRectangle(ByRef dRect As RECT, ByVal Color As Long, ByVal MyHdc As Long)

Dim hBrush    As Long
   
   hBrush = CreateSolidBrush(GetLngColor(Color))
   FillRect MyHdc, dRect, hBrush
   DeleteObject hBrush

End Sub
'======================================================================

'======================================================================
'DRAWS A BORDER RECTANGLE AREA OF AN SPECIFIED COLOR
Private Sub DrawRgnRectangle(ByRef hRect As Long, ByVal Color As Long, ByVal MyHdc As Long)

Dim hBrush As Long

   hBrush = CreateSolidBrush(GetLngColor(Color))
   FrameRgn MyHdc, hRect, hBrush, 1, 1
   DeleteObject hBrush

End Sub
'======================================================================

'======================================================================
'DRAWS A IMAGE AREA OF AN SPECIFIED DC
Private Sub DrawBkgImgDC(ByRef dRect As RECT, ByVal m_Picture As Long)

Dim Brush      As Long
Dim origBrush  As Long

       If m_Picture = 0 Then Exit Sub                        '//-- In Case No Picture is Choosen
              
       Brush = CreatePatternBrush(m_Picture)                 '//-- Use Pattern Picture Draw
       origBrush = SelectObject(m_Hdc, Brush)
       
       PatBlt m_Hdc, 0, 0, dRect.Right - dRect.Left, dRect.Bottom - dRect.TOP, vbPatCopy
         
       SelectObject m_Hdc, origBrush
       DeleteObject Brush
       
End Sub
'======================================================================


Private Function CreateNewWindow() As Long

    
    If M_ExWindow.hwnd <> 0 Then
        KillTimer LWnd, 1                       '//-- Destroy the API Timer
        DestroyWindow M_ExWindow.hwnd           '//-- Destroy the ToolTip Window when the Mouse Leaves the Control
        M_ExWindow.hwnd = 0                     '//-- Reset the HWnd    Value
        CreateNewWindow = -1                    '//-- If The ToolTip is Visible Exit Function
        Exit Function
    End If
    
    M_ExWindow.Hover = False                    '//-- Reset the Hover Value
    M_ExWindow.Flag = False                     '//-- Reset the Flag  Value
   
    Call Start(LWnd)                            '//-- SubClass The Calling Control To Initialize a Timer.
    Call AddMsg(LWnd, WM_MOUSEMOVE, MSG_AFTER)
    Call AddMsg(LWnd, WM_TIMER, MSG_AFTER)
    Call AddMsg(LWnd, WM_MOUSEACTIVATE, MSG_AFTER)

End Function


Private Sub DrawToolTipBody()
     
Dim ClientRect As RECT
Dim hIcon      As Long
        
    '================================================================
    'DRAW THE FILL OF THE TOOLTIP (BACKGROUND,TEXT,ICON)
    '================================================================
        
    With M_ExWindow
       
           '============================================================================================
           '/-- Get The ToolTip Area Cords.
           GetClientRect .hwnd, ClientRect
           '============================================================================================
           '/-- Solid BackGround Fill
           If mBackStyle = TTNrml Then
              DrawFillRectangle ClientRect, mBackColor, m_Hdc
           '============================================================================================
           '/-- Picture BackGround Fill
           ElseIf mBackStyle = TTPict Then