VB5 Status Bar Control Binary (17K)
VB5 Status Bar Control Full Source (96K)
VB6 Status Bar Control Binary (17K)
VB6 Status Bar Control Full Source (98K)
Bugs: 2 / 2
Issues: 0 / 0
Questions: 0 / 0
19 Dec 2002
VB6 version added.
Fixed bug when inserting panels, which led to some randomisation of the panel text and icons.
XP Style status bar now displayed from the demonstration.
Subclassing Without The Crashes
vbAccelerator ImageList Control and Class v2.0
vbAccelerator - Contents of code file: frmTest.frm
VERSION 5.00
Object = "{8245A918-4CF7-11D2-8E21-10B404C10000}#8.1#0"; "vbalIml.ocx"
Object = "{418F6080-7954-11D2-805B-00C04FA4EE99}#2.1#0"; "vbalSbar.ocx"
Begin VB.Form frmTest
Caption = "vbAccelerator Status Bar Control Demonstrator"
ClientHeight = 5985
ClientLeft = 3270
ClientTop = 2460
ClientWidth = 8610
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmTest.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5985
ScaleWidth = 8610
Begin VB.PictureBox picTest
AutoRedraw = -1 'True
Height = 675
Left = 5460
Picture = "frmTest.frx":1272
ScaleHeight = 615
ScaleWidth = 1275
TabIndex = 6
Top = 1860
Visible = 0 'False
Width = 1335
End
Begin vbalSbar.vbalStatusBar sbrMain
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 1
Top = 5610
Width = 8610
_ExtentX = 15187
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackColor = -2147483633
SimpleStyle = 0
End
Begin vbalIml.vbalImageList ilsIcons
Left = 4620
Top = 1080
_ExtentX = 953
_ExtentY = 953
ColourDepth = 24
Size = 9400
Images = "frmTest.frx":4021
KeyCount = 10
Keys = ""
End
Begin VB.ListBox lstTest
Height = 2205
IntegralHeight = 0 'False
Left = 60
TabIndex = 0
Top = 2040
Width = 4455
End
Begin VB.Label lblVBAccel
BackStyle = 0 'Transparent
Caption = "Advanced, free source code at
http://vbaccelerator.com"
ForeColor = &H0080C0FF&
Height = 375
Left = 2640
TabIndex = 3
Top = 360
Width = 2715
End
Begin VB.Label lblLogoStripe
BackColor = &H000040C0&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2580
TabIndex = 4
Top = 330
Width = 3855
End
Begin VB.Image imgVBAccel
Height = 660
Left = 60
Picture = "frmTest.frx":64F9
Top = 120
Width = 2535
End
Begin VB.Label lblSimple
Alignment = 2 'Center
BackColor = &H80000002&
Caption = "Click and hold/drag to demo simple mode"
ForeColor = &H80000009&
Height = 255
Left = 0
TabIndex = 2
Top = 840
Width = 3075
End
Begin VB.Label lblLogoBack
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Label1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 795
Left = 0
TabIndex = 5
Top = 60
Width = 6555
End
Begin VB.Menu mnuTestTop
Caption = "&Test"
Begin VB.Menu mnuTest
Caption = "&Add Panel..."
Index = 0
End
Begin VB.Menu mnuTest
Caption = "&Delete Panel..."
Index = 1
End
Begin VB.Menu mnuTest
Caption = "-"
Index = 2
End
Begin VB.Menu mnuTest
Caption = "&Show MDI..."
Index = 3
End
Begin VB.Menu mnuTest
Caption = "-"
Index = 4
End
Begin VB.Menu mnuTest
Caption = "E&xit"
Index = 5
End
End
Begin VB.Menu mnuViewTOp
Caption = "&View"
Begin VB.Menu mnuView
Caption = "&Status Bar"
Checked = -1 'True
Index = 0
End
End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' for the owner-drawn panel:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As
Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal
hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long)
As Long
Private Const TRANSPARENT = 1
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal
nBkMode As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As
Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal
wFormat As Long) As Long
Private Const DT_CALCRECT = &H400
Private Const DT_CENTER = &H1
Private Const DT_VCENTER = &H4
Private Const DT_SINGLELINE = &H20
Private Const DT_RIGHT = &H2
Private Const DT_BOTTOM = &H8
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal
crColor As Long) As Long
Private Sub Form_Load()
Dim i As Long
Dim eStyle As ESTBRPanelStyle
Dim sText As String
Dim iImg As Long
Dim iMinWIdth As Long
sbrMain.ImageList = ilsIcons
For i = 1 To 5
iImg = -1
iMinWIdth = 64
If (i = 2) Then
eStyle = estbrIns
sText = "Test item " & i
ElseIf (i = 3) Then
eStyle = estbrStandard
sText = ""
iMinWIdth = 12
ElseIf (i = 4) Then
eStyle = estbrOwnerDraw
sText = "Owner Draw"
iMinWIdth = 72
Else
eStyle = estbrStandard
sText = "Test item " & i
End If
sbrMain.AddPanel eStyle, sText, , iImg, iMinWIdth, (i = 1), , , "Item" & i
Next i
sbrMain.PanelIcon("Item3") = 1
sbrMain.PanelToolTipText("Item3") = "Test Tool Tip"
End Sub
Private Sub Form_Resize()
On Error Resume Next
lblLogoBack.Width = Me.ScaleWidth - lblLogoBack.Left * 2
lblSimple.Move lblLogoBack.Left + Screen.TwipsPerPixelX, lblSimple.Top,
lblLogoBack.Width - 2 * Screen.TwipsPerPixelX
lblLogoStripe.Width = lblLogoBack.Width - lblLogoStripe.Left -
Screen.TwipsPerPixelX * 2
lstTest.Move lblLogoBack.Left + Screen.TwipsPerPixelX, lblSimple.Top +
lblSimple.Height + 2 * Screen.TwipsPerPixelY, lblLogoBack.Width,
Me.ScaleHeight - (lblSimple.Top + lblSimple.Height + 4 *
Screen.TwipsPerPixelY + sbrMain.Height * Abs(sbrMain.Visible))
End Sub
Private Sub lblSimple_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
sbrMain.SimpleMode = True
sbrMain.SimpleText = "Drag mouse to see X,Y"
End Sub
Private Sub lblSimple_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
If (Button = vbLeftButton) Then
sbrMain.SimpleText = "Position (twips): " & X & "," & Y
End If
End Sub
Private Sub lblSimple_MouseUp(Button As Integer, Shift As Integer, X As Single,
Y As Single)
sbrMain.SimpleMode = False
End Sub
Private Sub mnuTest_Click(Index As Integer)
Dim sI As String
Dim iPos As Long
Select Case Index
Case 0
' Add
sI = InputBox$("This inserts a panel with a random icon at a random
location." & vbCrLf & "Panel caption?", , "New Panel")
If (sI <> "") Then
iPos = Rnd * sbrMain.PanelCount + 1
If (sbrMain.PanelCount = 0) Or (iPos >= sbrMain.PanelCount) Then
' Add to end
sbrMain.AddPanel , sI, , Rnd * ilsIcons.ImageCount
Else
' Insert panel
sbrMain.AddPanel , sI, , Rnd * ilsIcons.ImageCount, , , , , , iPos
End If
End If
Case 1
' Delete
sbrMain.RemovePanel sbrMain.PanelCount
Case 3
mfrmTest.Show
Case 5
Unload Me
End Select
End Sub
Private Sub mnuView_Click(Index As Integer)
Dim bs As Boolean
bs = Not (mnuView(0).Checked)
mnuView(0).Checked = bs
sbrMain.Visible = bs
Form_Resize
End Sub
Private Sub sbrMain_Click(ByVal iPanel As Long, ByVal X As Single, ByVal Y As
Single, ByVal eButton As MouseButtonConstants)
lstTest.AddItem "Click " & iPanel
End Sub
Private Sub sbrMain_DblClick(ByVal iPanel As Long, ByVal X As Single, ByVal Y
As Single, ByVal eButton As MouseButtonConstants)
lstTest.AddItem "DblClick " & iPanel
End Sub
Private Sub sbrMain_DrawItem(ByVal lHDC As Long, ByVal iPanel As Long, ByVal
lLeftPixels As Long, ByVal lTopPixels As Long, ByVal lRightPixels As Long,
ByVal lBottomPixels As Long)
Dim tR As RECT
'lstTest.AddItem "OwnerDraw DrawItem " & iPanel
tR.Left = lLeftPixels
tR.Right = lRightPixels - 1
tR.Top = lTopPixels
tR.Bottom = lBottomPixels - 1
BitBlt lHDC, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top,
picTest.hdc, 0, 0, vbSrcCopy
SetBkMode lHDC, TRANSPARENT
SetTextColor lHDC, &H303030
tR.Right = tR.Left + sbrMain.PanelMinWidth(iPanel)
tR.Bottom = tR.Bottom - 1
DrawText lHDC, "Owner Draw", 10, tR, DT_CENTER Or DT_BOTTOM Or DT_SINGLELINE
End Sub