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