95 Style Status Bar for Windows 3.11
Listing 1 looks like this...
Option Explicit
Private mCanvas As Object
Private msName As String
Private mPanels As Panels
Private mnStyle As Integer
Private msSimpleText As String
Private Const Simple = "#Simple Panel#"
Public Property Set Canvas(newObj As Object)
If TypeName(newObj) = "PictureBox" Then
Set mCanvas = newObj
mnStyle = sbrNormal
mCanvas.Enabled = False
mCanvas.Height = 390 ' twips
mCanvas.BorderStyle = vbTransparent
mCanvas.Align = vbAlignBottom
Set mPanels.Parent = mCanvas
mPanels.Add Key:=Simple
mCanvas.Visible = True
mCanvas.Enabled = True
End If
End Property
Public Property Get Canvas() As Object
Set Canvas = mCanvas
End Property
Private Sub Class_Initialize()
Set mPanels = New Panels
End Sub
Private Sub Class_Terminate()
Set mPanels = Nothing
Set mCanvas = Nothing
End Sub
Private Sub DrawSimple()
Dim ForeColor As Long
Dim ColorTopLeft As Long
Dim ColorBottomRight As Long
Dim x1 As SingleDim y1 As Single
On Error Resume Next
ForeColor = vbButtonText
ColorTopLeft = vb3DShadow
ColorBottomRight = vb3DHighlight
mCanvas.Cls
mCanvas.ForeColor = ForeColor
x1 = gGap * 4
y1 = mCanvas.Height / 2 - mCanvas.TextHeight("gh") / 2
mCanvas.CurrentX = x1: mCanvas.CurrentY = y1
mCanvas.Print msSimpleText
mCanvas.Line (gGap * 2, gGap)-Step(mCanvas.ScaleWidth - gGap * 4, 0), ColorTopLeft
mCanvas.Line (gGap * 2, gGap)-Step(0, mCanvas.ScaleHeight - gGap * 2), ColorTopLeft
mCanvas.Line (gGap * 2, mCanvas.ScaleHeight + 15 - gGap * 2)-
Step(mCanvas.ScaleWidth - 15 - gGap * 4, 0), ColorBottomRight
mCanvas.Line (mCanvas.ScaleWidth - 15 - gGap * 2, gGap)-
Step(0, mCanvas.ScaleHeight - 15 - gGap * 2), ColorBottomRight
If Err.Number > 0 Then Err.Clear
End Sub
Public Property Let Name(Value As String)
msName = Value
End Property
Public Property Get Name() As String
Name = msName
End Property
Public Property Get Panels() As Panels
Set Panels = mPanels
End Property
Public Sub Refresh()
Dim pnlX As Panel
Dim CurrentXPos As Single
Dim Currentpanel As Integer
Dim NoOfPanels As Integer
Static mbRefresh As Boolean
If Not mbRefresh Then
If Not mCanvas Is Nothing Then
If mCanvas.Visible And mCanvas.Enabled Then
mbRefresh = True
Select Case mnStyle
Case sbrNormal
NoOfPanels = mPanels.Count
If NoOfPanels > 0 Then
SetSpringWidth
Currentpanel = 1
CurrentXPos = gGap * 2
mCanvas.Cls
Do Until Currentpanel > NoOfPanels
Set pnlX = mPanels.Item(Currentpanel)
pnlX.Left = CurrentXPos
CurrentXPos = CurrentXPos + pnlX.Width + gGap
pnlX.Refresh
Set pnlX = Nothing
Currentpanel = Currentpanel + 1
Loop
End If
Case sbrSimple
DrawSimple
End Select
mbRefresh = False
End If
End If
End If
End Sub
Private Sub SetSpringWidth()
Dim pnlX As Panel
Dim pnlSpring As Panel
Dim CurrentXPos As Single
Dim RemainingWidth As Single
Dim Currentpanel As Integer
Dim NoOfPanels As Integer
Currentpanel = 1
CurrentXPos = gGap * 2
NoOfPanels = mPanels.Count
Do Until Currentpanel > NoOfPanels
Set pnlX = mPanels.Item(Currentpanel)
CurrentXPos = CurrentXPos + pnlX.Width + gGap
If pnlX.AutoSize = sbrSpring Then Set pnlSpring = pnlX
Set pnlX = Nothing
Currentpanel = Currentpanel + 1
Loop
If Not pnlSpring Is Nothing Then
RemainingWidth = mCanvas.Width - gGap - CurrentXPos
pnlSpring.Width = RemainingWidth + pnlSpring.Width
Set pnlSpring = Nothing
End If
End Sub
Public Property Let SimpleText(Value As String)
Dim RequireRefresh As Boolean
RequireRefresh = msSimpleText <> Value
msSimpleText = Value
If RequireRefresh Then Refresh
End Property
Public Property Get SimpleText() As String
SimpleText = msSimpleText
End Property
Public Property Let Style(Value As Integer)
Dim RequireRefresh As Boolean
RequireRefresh = mnStyle <> Value
mnStyle = Value
If RequireRefresh Then Refresh
End Property
Public Property Get Style() As Integer
Style = mnStyle
End Property
