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

📄 xp_statusbar.ctl

📁 主要功能:接收和发送短信
💻 CTL
📖 第 1 页 / 共 5 页
字号:
            
            .PanelType = PropBag.ReadProperty("pType" & i, [PT Text spring size])
            .PanelText = PropBag.ReadProperty("pText" & i)
            .TextAlignment = PropBag.ReadProperty("pTextAlignment" & i, [TA Left])
            .TextBold = PropBag.ReadProperty("pTextBold" & i, False)
            
            Set .PanelPicture = PropBag.ReadProperty("PanelPicture" & i, Nothing)
            .PanelPicAlignment = PropBag.ReadProperty("PanelPicAlignment" & i)
            
            .PanelBckgColor = PropBag.ReadProperty("pBckgColor" & i)
            .PanelGradient = PropBag.ReadProperty("pGradient" & i)
            .PanelEdgeSpacing = PropBag.ReadProperty("pEdgeSpacing" & i)
            .PanelEdgeInner = PropBag.ReadProperty("pEdgeInner" & i)
            .PanelEdgeOuter = PropBag.ReadProperty("pEdgeOuter" & i)
            
            .Tag = PropBag.ReadProperty("pTag" & i, vbNullString)
        End With
    Next i
    
    flgRedrawEnabled = True
    DrawStatusBar True
    
    Exit Sub
    
    
error_handler:

    If Err.number = 327 Then        ' In Immediate Window:  err.raise 327  , then <Help> to get infos
        Err.Clear
    Else
        MsgBox "Error [" + Err.Description + "] in 'UserControl_ReadProperties()', Modul 'XP_StatusBar'", _
                vbExclamation, " Fehler "
    End If
    
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    
    Dim i As Long
    
    On Error GoTo error_handler
    
    flgRedrawEnabled = False
    With PropBag
        .WriteProperty "BackColor", oBackColor
        .WriteProperty "ForeColor", oForeColor
        .WriteProperty "ForeColorDissabled", oDissColor
        .WriteProperty "MaskColor", oMaskColor
        
        .WriteProperty "Font", UserControl.Font
        .WriteProperty "ShowGripper", bDrawGripper
        .WriteProperty "ShowSeperators", bDrawSeperators
        .WriteProperty "Apperance", m_Apperance, m_def_Apperance
        .WriteProperty "UseWindowsColors", m_UseWindowsColors, m_def_UseWindowsColors
        .WriteProperty "TopLine", m_TopLine, True
        .WriteProperty "BckGrndPic", m_BackgroundPic
        
        .WriteProperty "NumberOfPanels", m_PanelCount
    End With

    For i = 1 To m_PanelCount
        With m_Panels(i)
            
            PropBag.WriteProperty "pEnabled" & i, .pEnabled, True
            PropBag.WriteProperty "pVisible" & i, .pVisible, True
            PropBag.WriteProperty "PWidth" & i, .ClientWidth
            PropBag.WriteProperty "PMinWidth" & i, .pMinWidth, 10
            PropBag.WriteProperty "pTTText" & i, .ToolTipTxt
            
            PropBag.WriteProperty "pType" & i, .PanelType
            PropBag.WriteProperty "pText" & i, .PanelText
            PropBag.WriteProperty "pTextAlignment" & i, .TextAlignment
            PropBag.WriteProperty "pTextBold" & i, .TextBold, False
            
            PropBag.WriteProperty "PanelPicture" & i, .PanelPicture
            PropBag.WriteProperty "PanelPicAlignment" & i, .PanelPicAlignment
            
            PropBag.WriteProperty "pBckgColor" & i, .PanelBckgColor
            PropBag.WriteProperty "pGradient" & i, .PanelGradient
            PropBag.WriteProperty "pEdgeSpacing" & i, .PanelEdgeSpacing
            PropBag.WriteProperty "pEdgeInner" & i, .PanelEdgeInner
            PropBag.WriteProperty "pEdgeOuter" & i, .PanelEdgeOuter
            
            PropBag.WriteProperty "pTag" & i, .Tag, vbNullString
                        
        End With
    Next i
    flgRedrawEnabled = True
    
    On Error GoTo 0

    Exit Sub


error_handler:

    MsgBox "Error [" + Err.Description + "] in 'UserControl_WriteProperties()', Modul 'XP_StatusBar'", _
            vbExclamation, " Fehler "
    flgRedrawEnabled = True
    
End Sub

Private Sub UserControl_Resize()

    DrawStatusBar
    
End Sub



' === Rest of Privates ===

Private Sub DrawStatusBar(Optional FullRedraw As Boolean = True)
    ' === Here is were all (most of) the work is done. ===

    Dim i               As Long
    Dim rc              As API_RECT
    Dim rcTemp          As API_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
    
    flgNoTimerInterrupt = True          ' No timer activity during redrawing!
    
    RaiseEvent BeforeRedraw
    
    If FullRedraw = True Then
        With UserControl
            ' == Control Shading Lines ==
            Cls
            
            If m_BackgroundPic Is Nothing Then
                Select Case m_Apperance
    
                    Case [Office XP]
    
                    Case [Windows XP]
                            ' Top lines
                            If m_TopLine = True Then
                                DrawALine .hdc, 0, 0, .ScaleWidth, 0, TranslateColorToRGBSimple(oBackColor, -45)
                            End If
                            lOffset = 36
                            For i = 1 To 4
                                DrawALine .hdc, 0, i, .ScaleWidth, i, TranslateColorToRGBSimple(oBackColor, lOffset)
                                lOffset = lOffset - 9
                            Next i
                                        
                            ' Bottom Lines
                            DrawALine .hdc, 0, .ScaleHeight - 1, .ScaleWidth, .ScaleHeight - 1, _
                                    TranslateColorToRGBSimple(oBackColor, -15), 2
                            DrawALine .hdc, 0, .ScaleHeight - 3, .ScaleWidth, .ScaleHeight - 3, _
                                    TranslateColorToRGBSimple(oBackColor, -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
            Else
                TileBltBckGrnd m_BackgroundPic.handle
                UserControl.Refresh
            End If
        End With
    End If  ' FullRedraw = True


    ' === Now to 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
    
        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)
            If .pVisible = True Then
                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 If
        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] And .pVisible = True Then
                    .ClientWidth = IIf(lSpringSize > .pMinWidth, lSpringSize, .pMinWidth)
                End If
            End With
        Next i
        
    End If
    
    
    ' Loop through the panels, all panel drawing is done here!
    ReDim Preserve rcPanel(m_PanelCount)
    For i = 1 To m_PanelCount
        With m_Panels(i)
        
            If .pVisible = True Then
        
                ' Position the panel.
                .ClientLeft = X
                .ClientTop = Y
                
                X1 = .ClientWidth
                .ClientHeight = Y1
                
                            
                'Create a RECT area using the above dimensions to draw into.
                With rc
                    .lLeft = X
                    .lTop = Y
                    .lRight = .lLeft + X1
                    .lBottom = Y1
                End With
                
                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 = TranslateColorToRGBSimple(oBackColor, 50)
                                lColorTmp2 = TranslateColorToRGBSimple(oBackColor, -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

⌨️ 快捷键说明

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