⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ucverywellsstatusbarxp.ctl

📁 显示XP效果的状态栏程序.希望能和大家一起学习
💻 CTL
📖 第 1 页 / 共 5 页
字号:
        Case [Simple], [XP Diagonal Left], [XP Diagonal Right]
                Y = 1                               ' Start the panel 1 pixel down from the top edge.
                Y1 = UserControl.ScaleHeight - 1    ' Height of the panel
                
    End Select
    
    
    ' Two tasks for this loop:
    '               1 - How many panels with PanelType = [PT Text spring size] we have ?
    '               2 - Adjust panels size with PanelType = [PT Text AutoSize contents]
    lSpringer = 0
    For i = 1 To m_PanelCount
        With m_Panels(i)
            Select Case .PanelType
            
                Case [PT Text spring size]
                        lSpringer = lSpringer + 1
                    
                    
                Case [PT Text AutoSize contents]
                        .ClientWidth = UserControl.TextWidth(.PanelText) + (UserControl.ScaleX(.PanelPicture.Width, 8, UserControl.ScaleMode)) + 12
                        lFixedSizeTotal = lFixedSizeTotal + .ClientWidth     ' Get total size of fixed-size panels
                        
                        
                Case Else
                        lFixedSizeTotal = lFixedSizeTotal + .ClientWidth     ' Get total size of fixed-size panels
                        
            End Select
        End With
    Next i
    
    ' If we have spring panels:  Adjust the width of all! spring panels
    If lSpringer > 0 Then
    
        lSpringSize = (UserControl.ScaleWidth - (lFixedSizeTotal + IIf(bDrawGripper = True, 17, 5))) / lSpringer
        If lSpringSize < 0 Then
            lSpringSize = 0
        End If
        
        For i = 1 To m_PanelCount
            With m_Panels(i)
                If .PanelType = [PT Text spring size] Then
                    .ClientWidth = lSpringSize
                End If
            End With
        Next i
        
    End If
    
    
    ' Loop through the panels
    For i = 1 To m_PanelCount
        With m_Panels(i)
        'Position the panel.
            .ClientLeft = X
            .ClientTop = Y
            
            X1 = .ClientWidth
            .ClientHeight = Y1
            
                        
            'Create a RECT area using the above dimentions to draw into.
            With rc
                .lLeft = X
                .lTop = Y
                .lRight = .lLeft + X1
                .lBottom = Y1
            End With
            ReDim Preserve rcPanel(i)
            rcPanel(i) = rc
            InflateRect rcPanel(i), -2, 0
        
            With UserControl
                If FullRedraw = True And bDrawSeperators = True Then
                
                    Select Case m_Apperance
    
                        Case [Office XP]
                                
                                
                        Case [Windows XP]
                            lColorTmp1 = TranslateColorToRGB(oBackColor, 0, 0, 0, 50)
                            lColorTmp2 = TranslateColorToRGB(oBackColor, 0, 0, 0, -50)
                        
                            ' Draw the seperators taking into acount the first and last
                            ' panel seperators are different.
                            If i <> 1 Then
                                ' This will draw the left line ( The lighter shade )
                                ' so the first panel does not need one
                                DrawALine .hDC, X, Y, X, Y1, lColorTmp1
                            End If
                            
                            If i <> m_PanelCount Then
                                ' This will draw the right line ( The darker shade )
                                ' Every panel will have this line exept the last
                                ' panel has this line positioned differently.
                                DrawALine .hDC, rc.lRight - 1, Y, rc.lRight - 1, Y1, lColorTmp2
                            Else
                                ' Lines for the last panel.
                                DrawALine .hDC, rc.lRight - 1, Y, rc.lRight - 1, Y1, lColorTmp1
                                DrawALine .hDC, rc.lRight - 2, Y, rc.lRight - 2, Y1, lColorTmp2
                            End If
                
                        
                    Case [Simple]
                            DrawALine .hDC, X, Y, X, Y1, TranslateColorToRGB(oBackColor, 0, 0, 0, 50)
                            
                            
                    Case [XP Diagonal Left]
                            If i > 1 Then
                                lOffset = (Y1 / 2 = Int(Y1 / 2))    ' even or odd ?
                                ltmp = Y1 \ 2
                                DrawALine .hDC, X - ltmp - 1, Y, X + ltmp + lOffset - 1, Y1, vbGray
                                DrawALine .hDC, X - ltmp, Y, X + ltmp + lOffset, Y1, RGB(90, 90, 90)
                                DrawALine .hDC, X - ltmp + 1, Y, X + ltmp + lOffset + 1, Y1, vbWhite
                                UserControl.Refresh
                            End If
        
                    Case [XP Diagonal Right]
                            If i > 1 Then
                                lOffset = (Y1 / 2 = Int(Y1 / 2))    ' even or odd ?
                                ltmp = Y1 \ 2
                                DrawALine .hDC, X + ltmp - 1, Y, X - ltmp - lOffset - 1, Y1, vbGray
                                DrawALine .hDC, X + ltmp, Y, X - ltmp - lOffset, Y1, RGB(90, 90, 90)
                                DrawALine .hDC, X + ltmp + 1, Y, X - ltmp - lOffset + 1, Y1, vbWhite
                                UserControl.Refresh
                            End If
                            
                    End Select
                    
                End If
                
            
                ' Design the panel
                Select Case m_Apperance
    
                    Case [Office XP]
                            ' DrawASquare UserControl.hDC, rcPanel(i), oBackColor, True  (Not sure when needed ... LT)
                            DrawASquare .hDC, rcPanel(i), vbButtonShadow, False
                            
                                        
                    Case [Windows XP]
                            ' DrawASquare .hDC, rcPanel(i), oBackColor, True  (Not sure when needed ... LT)
                            
                    Case [Simple]
                            X = X + 2
    
                End Select
            End With
            
            ' ### Maybe we want to draw some fancy background gradients and framing stuff ;) ... ###
            InflateRect rc, -3, -2
                        
            ' Gradients ?
            lGapToBorder = UserControl.ScaleHeight / 7
            Select Case .PanelGradient

                    Case 1      ' [Transparent]     :  So do nothing ;)
            
            
                    Case 2      ' [Opaque]          :  Draw a simple rectangle in panel background color
                                CopyRect rcTemp, rc
                                rcTemp.lLeft = rcTemp.lLeft + 1
                                rcTemp.lRight = rcTemp.lRight - 2
                                DrawASquare UserControl.hDC, rcTemp, .PanelBckgColor, True
                                
            
                    Case 3      ' [Top Bottom]      :  Simple gradient 1
                                DrawVertGradient .PanelBckgColor, vbWhite, _
                                        X + 3, .ClientWidth - 7, _
                                        lGapToBorder, UserControl.ScaleHeight - lGapToBorder
                                        
                                        
                    Case 4      ' [Top 1/3 Bottom]  :  Complex gradient 1
                                DrawVertGradient .PanelBckgColor, vbWhite, _
                                        X + 3, .ClientWidth - 7, _
                                        lGapToBorder, UserControl.ScaleHeight / 3 + 2
                                        
                                DrawVertGradient vbWhite, .PanelBckgColor, _
                                        X + 3, .ClientWidth - 7, _
                                        UserControl.ScaleHeight / 3 + 2, UserControl.ScaleHeight - lGapToBorder
                                        
                                        
                    Case 5      ' [Top 1/2 Bottom]  :  Complex gradient 2
                                DrawVertGradient .PanelBckgColor, vbWhite, _
                                        X + 3, .ClientWidth - 7, _
                                        lGapToBorder, UserControl.ScaleHeight / 2
                                        
                                DrawVertGradient vbWhite, .PanelBckgColor, _
                                        X + 3, .ClientWidth - 7, _
                                        UserControl.ScaleHeight / 2, UserControl.ScaleHeight - lGapToBorder
                                            
                                            
                    Case 6      ' [Top 2/3 Bottom]  :  Complex gradient 3
                                DrawVertGradient .PanelBckgColor, vbWhite, _
                                        X + 3, .ClientWidth - 7, _
                                        lGapToBorder, (UserControl.ScaleHeight / 3) * 2 - 3
                                        
                                DrawVertGradient vbWhite, .PanelBckgColor, _
                                        X + 3, .ClientWidth - 7, _
                                        (UserControl.ScaleHeight / 3) * 2 - 2, UserControl.ScaleHeight - lGapToBorder
                                        
                                        
                    Case 7      ' [Bottom Top]      :  Simple gradient 2
                                DrawVertGradient vbWhite, .PanelBckgColor, _
                                        X + 3, .ClientWidth - 7, _
                                        lGapToBorder, UserControl.ScaleHeight - lGapToBorder
                                            
                                            
                    Case Else   ' Just for sure ;)
                    
                                
            End Select

        
            ' Draw the OUTER Edge
            rc.lTop = lGapToBorder
            rc.lBottom = UserControl.ScaleHeight - (lGapToBorder - 2)
            DrawEdge UserControl.hDC, rc, .PanelEdgeOuter, BF_TOPLEFT
            DrawEdge UserControl.hDC, rc, .PanelEdgeOuter, BF_BOTTOMRIGHT
            
            ' make rectangle smaller by inner spacing property
            InflateRect rc, -.PanelEdgeSpacing, -.PanelEdgeSpacing
            
            ' Draw the INNER Edge
            DrawEdge UserControl.hDC, rc, .PanelEdgeInner, BF_TOPLEFT
            DrawEdge UserControl.hDC, rc, .PanelEdgeInner, BF_BOTTOMRIGHT
                        
            
            
            GetPanelPictureSize i, pX, pY   ' Get the size of the picture even if there is no one set
    
            ' Create a temporary RECT to draw some text into.
            GetClientRect UserControl.hwnd, rcTemp
            DrawText UserControl.hDC, .PanelText, Len(.PanelText), rcTemp, DT_CALCRECT Or DT_WORDBREAK
            CopyRect rc, rcTemp
            
            ' Position our RECT
            Select Case .PanelPicAlignment
            
                Case [PP Left]
                        rc.lLeft = X + pX + 2
                        rc.lRight = ((rc.lLeft + X1) - 10) - pX
                            
                Case [PP Center]
                        rc.lLeft = X
                        rc.lRight = ((rc.lLeft + X1) - 10)
                        
                Case [PP Right]
                        rc.lLeft = X
                        rc.lRight = ((rc.lLeft + X1) - 10) - pX
                        
            End Select
            
            If .PanelEdgeOuter <> 0 Then
                InflateRect rc, -3, 0
            End If
            If .PanelEdgeInner <> 0 Then
                InflateRect rc, -(.PanelEdgeSpacing + 3), 0
            End If
            
            ' Save this contents area !
            .ContentsLeft = rc.lLeft
            .ContentsTop = rc.lTop
            .ContentsRight = rc.lRight
            .ContentsBottom = rc.lBottom
            
            
            ' Draw the text into our new panel.
            SetTextColor UserControl.hDC, IIf(.pEnabled = True, oForeColor, oDissColor)
            OffsetRect rc, 4, (ScaleHeight - rc.lBottom) / 2
            DrawTheText UserControl.hDC, .PanelText, Len(.PanelText), rc, .TextAlignment
            
        
            ' Add a PanelPicture if required.
            
            ' TODO :
            '           Picture will spill into the next panel if for some reason someone
            '           sets the PanelWidth to a smaller width than the image.
            '
            '           Seems not really be a great prob... ;) - LT
            
            If Not (.PanelPicture Is Nothing) Then
            
                lPPxPos = Choose(.PanelPicAlignment + 1, _
                        IIf(.PanelEdgeInner = 0, X + 5, X + 7 + .PanelEdgeSpacing), _
                        X + (.ClientWidth / 2) - (pX / 2), _
                        (X + .ClientWidth) - (pX + 5 + IIf(.PanelEdgeInner = 0, 0, .PanelEdgeSpacing)))
                        
                PaintTransparentPicture UserControl.hDC, _
                        .PanelPicture, _
                        lPPxPos, (ScaleHeight - pY) / 2, _
                        pX, pY, _
                        0, 0, _
                        oMaskColor
                       
                Refresh
                        
            End If
                        
            'Dont forget to move the X for the next panel....
            X = X + .ClientWidth
                       
        End With
    Next i

    ' If there are integrated controls: Set position(s)             ' Magic number format "### 03 0050 +"
    On Error Resume Next                                            ' Means: Put control to panel 3, 50 twips from left panel
    For Each ContainedCtrl In UserControl.ContainedControls         ' border and adjust size in horicontaldirection. Use "-"
        With ContainedCtrl                                          ' for no adjustment e.g. "### 02 0050 -"
            If Len(.Tag) = 13 And Left$(.Tag, 4) = "### " Then      ' Handle controls with "magic number tag" only!
                i = Val(Mid$(.Tag, 5, 2))                           ' Get panel index
                
                If i > 0 And i <= m_PanelCount Then                 ' Only if we HAVE panels!
                    X = Val(Mid$(.Tag, 8, 4))
                    .Left = UserControl.ScaleX(m_Panels(i).ContentsLeft + 3, vbPixels, vbTwips) + X
                    If Right$(.Tag, 1) = "+" Then
                        .Width = (UserControl.ScaleX(m_Panels(i).ContentsRight, vbPixels, vbTwips)) - .Left
                    End If
                End If
            End If
            
        End With
    Next ContainedCtrl
    
    On Error GoTo 0

    If bDrawGripper = True Then
        DrawGripper
    End If
    
    RaiseEvent AfterRedraw

    On Error GoTo 0

    Exit Sub


error_handler:

    MsgBox "Error [" + Err.Description + "] in procedure 'DrawStatusBar()' at Benutzersteuerelement ucVeryWellsStatusBarXP"
    
End Sub


Public Sub RefreshAll()
    ' Redraw all

    DrawStatusBar True

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -