ucverywellsstatusbarxp.ctl

显示XP效果的状态栏程序.希望能和大家一起学习

Private Enum DrawTextFlags
    [Word Break] = DT_WORDBREAK
    [Center] = DT_CENTER
    [Use Ellipsis] = DT_WORD_ELLIPSIS
End Enum

Private Type KeyboardBytes
    kbByte(0 To 255)            As Byte
End Type
Private kbArray As KeyboardBytes


' Gripper Stuff
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTBOTTOMRIGHT = 17

Private bDrawGripper            As Boolean
Private frm                     As Form
Private WithEvents eForm        As Form
Attribute eForm.VB_VarHelpID = -1
Private rcGripper               As RECT
Private bDrawSeperators         As Boolean
Private m_TopLine               As Boolean

' Panel Stuff.
Private m_Panels()              As New clsPanels
Private m_PanelCount            As Long
Private rcPanel()               As RECT
    
' Used for Click and DblClick Events
Private PanelNum                As Long

' Panel colors and global mask color.
Private oBackColor              As OLE_COLOR
Private oForeColor              As OLE_COLOR
Private oMaskColor              As OLE_COLOR
Private oDissColor              As OLE_COLOR


' Misc stuff
Private flgTimerEnabled         As Boolean
Private m_UseWindowsColors      As Boolean
Private m_Apperance             As enVWsbXPApperance

Private m_hpalHalftone          As Long
Private flgRedrawEnabled      As Boolean              ' Set to FALSE to prevent redawing the statusbar, don't forget
                                                        ' to re-activate! Used in 'Usercontrol_ReadProperties(), ...
'
'
'




' *************************************
' *            INIT/TERM              *
' *************************************

Private Sub UserControl_Initialize()

    flgRedrawEnabled = True
    
End Sub



Private Sub UserControl_Terminate()
        
    Dim i As Long
    
    flgRedrawEnabled = False
    
    ' Stop timer
    KillTimer UserControl.hwnd, 2201
    flgTimerEnabled = False
        
    Set frm = Nothing
    Erase rcPanel
    
End Sub





' *************************************
' *         PUBLIC FUNCTIONS          *
' *************************************

Public Sub DrawGripper()
    
    Dim lColorHighLite  As Long
    Dim lColorShaddow   As Long
    Dim lColorGrad      As Long
    Dim i               As Long
    
    With rcGripper
        .lLeft = UserControl.ScaleWidth - 15
        .lRight = UserControl.ScaleWidth
        .lBottom = UserControl.ScaleHeight
        .lTop = UserControl.ScaleHeight - 15
    End With
    
    With UserControl
                
        ' HiLite and Shaddow color
        If m_UseWindowsColors = True Then
            lColorHighLite = TranslateColorToRGB(GetSysColor(COLOR_BTNHIGHLIGHT), 0, 0, 0)
            lColorShaddow = TranslateColorToRGB(GetSysColor(COLOR_BTNSHADOW), 0, 0, 0)
        Else
            lColorHighLite = TranslateColorToRGB(.BackColor, 0, 0, 0, -50)
            lColorShaddow = TranslateColorToRGB(.BackColor, 0, 0, 0, 50)
        End If
        
        Select Case m_Apperance
            
            Case [Windows XP]
                    ' Retain the area
                    DrawASquare .hDC, rcGripper, .BackColor, True
                    
                    DrawALine .hDC, rcGripper.lLeft, rcGripper.lBottom - 1, rcGripper.lRight, rcGripper.lBottom - 1, _
                            TranslateColorToRGB(oBackColor, 0, 0, 0, -15), 2

                    DrawALine .hDC, rcGripper.lLeft, rcGripper.lBottom - 3, rcGripper.lRight, rcGripper.lBottom - 3, _
                            TranslateColorToRGB(oBackColor, 0, 0, 0, -8), 2
                    
                    DrawALine .hDC, .ScaleWidth - 3, .ScaleHeight - 3, .ScaleWidth - 3, .ScaleHeight - 3, lColorShaddow, 2
                    DrawALine .hDC, .ScaleWidth - 7, .ScaleHeight - 3, .ScaleWidth - 7, .ScaleHeight - 3, lColorShaddow, 2
                    DrawALine .hDC, .ScaleWidth - 11, .ScaleHeight - 3, .ScaleWidth - 11, .ScaleHeight - 3, lColorShaddow, 2
                
                    DrawALine .hDC, .ScaleWidth - 3, .ScaleHeight - 7, .ScaleWidth - 3, .ScaleHeight - 7, lColorShaddow, 2
                    DrawALine .hDC, .ScaleWidth - 7, .ScaleHeight - 7, .ScaleWidth - 7, .ScaleHeight - 7, lColorShaddow, 2
                
                    DrawALine .hDC, .ScaleWidth - 3, .ScaleHeight - 11, .ScaleWidth - 3, .ScaleHeight - 11, lColorShaddow, 2
                
                    DrawALine .hDC, .ScaleWidth - 4, .ScaleHeight - 4, .ScaleWidth - 4, .ScaleHeight - 4, lColorHighLite, 2
                    DrawALine .hDC, .ScaleWidth - 8, .ScaleHeight - 4, .ScaleWidth - 8, .ScaleHeight - 4, lColorHighLite, 2
                    DrawALine .hDC, .ScaleWidth - 12, .ScaleHeight - 4, .ScaleWidth - 12, .ScaleHeight - 4, lColorHighLite, 2
                
                    DrawALine .hDC, .ScaleWidth - 4, .ScaleHeight - 8, .ScaleWidth - 4, .ScaleHeight - 8, lColorHighLite, 2
                    DrawALine .hDC, .ScaleWidth - 8, .ScaleHeight - 8, .ScaleWidth - 8, .ScaleHeight - 8, lColorHighLite, 2
                
                    DrawALine .hDC, .ScaleWidth - 4, .ScaleHeight - 12, .ScaleWidth - 4, .ScaleHeight - 12, lColorHighLite, 2
        
        
            Case [Office XP]
                    ' Retain the area
                    DrawASquare .hDC, rcGripper, .BackColor, True
                    
                    For i = 5 To 15 Step 5
                        DrawALine .hDC, .ScaleWidth - i, .ScaleHeight, .ScaleWidth, .ScaleHeight - i, lColorHighLite
                    Next i
                    
                    For i = 2 To 14
                        If i = 5 Or i = 10 Then
                            i = i + 2
                        End If
                        DrawALine .hDC, .ScaleWidth - i, .ScaleHeight, .ScaleWidth, .ScaleHeight - i, lColorShaddow
                    Next i
                                                      
            
            Case [Simple]
                    ' In progress ... ;)
                    For i = 2 To 14
                        DrawALine .hDC, .ScaleWidth - i, .ScaleHeight, .ScaleWidth, .ScaleHeight - i, oForeColor
                    Next i
            
            
            Case [XP Diagonal Left], [XP Diagonal Right]
                    For i = 3 To 13
                        lColorGrad = 140 + (6 * i)
                        DrawALine .hDC, .ScaleWidth - i, .ScaleHeight - 3, .ScaleWidth - 1, .ScaleHeight - i, _
                                RGB(lColorGrad, lColorGrad, lColorGrad)
                    Next i

        End Select
        
        UserControl.Refresh
    End With

End Sub

Public Function InsertPanel(ByVal lCurrentPanel As Long) As Long

    Dim i As Long

    m_PanelCount = m_PanelCount + 1
    ReDim Preserve m_Panels(1 To m_PanelCount) As New clsPanels
    
    ' Make space for the new one
    lCurrentPanel = lCurrentPanel + 1
    For i = m_PanelCount To lCurrentPanel + 1 Step -1
        Set m_Panels(i) = m_Panels(i - 1)
    Next i
    Set m_Panels(lCurrentPanel) = New clsPanels
    With m_Panels(lCurrentPanel)
        .ClientWidth = 100
        .pEnabled = True
        Set .PanelPicture = Nothing
        .PanelEdgeInner = 0
        .PanelEdgeOuter = 0
        .PanelEdgeSpacing = 0
        .PanelGradient = 0
    End With
    PropertyChanged "NumberOfPanels"
    InsertPanel = m_PanelCount
    DrawStatusBar True
    
End Function

Public Function DeletePanel(lPanelIndex As Long)
    
    Dim i As Long
    
    If m_PanelCount > 0 Then
        For i = lPanelIndex To m_PanelCount - 1
            Set m_Panels(i) = m_Panels(i + 1)
        Next i
        Set m_Panels(m_PanelCount) = Nothing
        m_PanelCount = m_PanelCount - 1
        If m_PanelCount > 0 Then
            ReDim Preserve m_Panels(1 To m_PanelCount)
        Else
            Erase m_Panels()
        End If
        PropertyChanged "NumberOfPanels"
        DrawStatusBar True
    End If
    
End Function

Public Sub DrawStatusBar(Optional FullRedraw As Boolean = True)

    Dim i               As Long
    Dim rc              As RECT
    Dim rcTemp          As RECT
    Dim X               As Long
    Dim Y               As Long
    Dim X1              As Long
    Dim Y1              As Long
    Dim lOffset         As Long
    Dim pX              As Long
    Dim pY              As Long
    Dim lColorTmp1      As Long
    Dim lColorTmp2      As Long
    Dim lSpringer       As Long
    Dim lFixedSizeTotal As Long
    Dim lSpringSize     As Long
    Dim lPPxPos         As Long
    Dim ContainedCtrl   As Control
    Dim lGapToBorder    As Long         ' Controls distance to top/bottom for panel fillings (gradients ...)
    Dim ltmp            As Long

    
    On Error GoTo error_handler
    
    If flgRedrawEnabled = False Then  ' Prevent redrawing during lot of property changes like in 'Usercontrol_ReadProperties()'
        
        Exit Sub
    End If

    RaiseEvent BeforeRedraw
    
    
    If FullRedraw = True Then
        With UserControl
            ' == Control Shading Lines ==
            Cls
            
            Select Case m_Apperance

                Case [Office XP]

                Case [Windows XP]
                        ' Top lines
                        If m_TopLine = True Then
                            DrawALine .hDC, 0, 0, .ScaleWidth, 0, TranslateColorToRGB(oBackColor, 0, 0, 0, -45)
                        End If
                        lOffset = 36
                        For i = 1 To 4
                            DrawALine .hDC, 0, i, .ScaleWidth, i, TranslateColorToRGB(oBackColor, 0, 0, 0, lOffset)
                            lOffset = lOffset - 9
                        Next i
                                    
                        ' Bottom Lines
                        DrawALine .hDC, 0, .ScaleHeight - 1, .ScaleWidth, .ScaleHeight - 1, _
                                TranslateColorToRGB(oBackColor, 0, 0, 0, -15), 2
                        DrawALine .hDC, 0, .ScaleHeight - 3, .ScaleWidth, .ScaleHeight - 3, _
                                TranslateColorToRGB(oBackColor, 0, 0, 0, -8), 2

                        
                Case [Simple]
                        If m_TopLine = True Then
                            DrawALine .hDC, 0, 0, .ScaleWidth, 0, vbBlack
                        End If
                
                
                Case [XP Diagonal Left], [XP Diagonal Right]
                
                        lColorTmp1 = RGB(90, 90, 90)
                        
                        ' Top lines
                        DrawALine .hDC, 2, 0, .ScaleWidth - 2, 0, lColorTmp1
                        DrawALine .hDC, 2, 1, .ScaleWidth - 1, 1, vbWhite
                        DrawALine .hDC, 2, 2, .ScaleWidth - 1, 2, RGB(248, 248, 248)
                        
                        DrawVertGradient RGB(240, 240, 240), RGB(220, 220, 220), 1, .ScaleWidth - 2, 3, .ScaleHeight - 3
                        
                        ' Bottom Lines
                        DrawALine .hDC, 2, .ScaleHeight - 3, .ScaleWidth - 1, .ScaleHeight - 3, RGB(217, 217, 217)
                        DrawALine .hDC, 2, .ScaleHeight - 2, .ScaleWidth - 1, .ScaleHeight - 2, RGB(190, 190, 190)
                        DrawALine .hDC, 2, .ScaleHeight - 1, .ScaleWidth - 2, .ScaleHeight - 1, lColorTmp1
                
                        ' Left lines
                        DrawALine .hDC, 0, 2, 0, .ScaleHeight - 2, lColorTmp1
                        DrawALine .hDC, 1, 2, 1, .ScaleHeight - 2, RGB(230, 230, 230)
                        
                        ' Right lines
                        DrawALine .hDC, .ScaleWidth - 2, 2, .ScaleWidth - 2, .ScaleHeight - 2, RGB(230, 230, 230)
                        DrawALine .hDC, .ScaleWidth - 1, 2, .ScaleWidth - 1, .ScaleHeight - 2, lColorTmp1
                        
                        ' Draw dots into corners
                        SetPixel .hDC, 1, 1, lColorTmp1
                        SetPixel .hDC, .ScaleWidth - 2, 1, lColorTmp1
                        SetPixel .hDC, 1, .ScaleHeight - 2, lColorTmp1
                        SetPixel .hDC, .ScaleWidth - 2, .ScaleHeight - 2, lColorTmp1
                        
            End Select
            
            
        End With
    End If
    
    ' The Panels
    '******************* Dimensions. **********************
    ' X = Left of the panel
    ' Y = Top of the panel
    ' X1 = Width of the panel
    ' Y1 = Height of the panel
    '******************************************************
    
    Select Case m_Apperance

        Case [Office XP]
                Y = 1                               ' Start the panel 1 pixel down from the top edge.
                Y1 = UserControl.ScaleHeight - 1    ' Height of the panel
    
                
        Case [Windows XP]
                Y = 5                               ' Start the panel 5 pixels down from the top edge.
                Y1 = UserControl.ScaleHeight - 4    ' Height of the panel