📄 xp_statusbar.ctl
字号:
.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 + -