📄 statusbarpanels.pag
字号:
Index = 3
Left = 4200
TabIndex = 30
Top = 1020
Width = 825
End
Begin VB.Label lblDesc
Caption = "Spacing"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 2
Left = 195
TabIndex = 29
Top = 1020
Width = 555
End
Begin VB.Label lblDesc
Caption = "Background Gradient"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 1
Left = 3015
TabIndex = 27
Top = 345
Width = 1560
End
Begin VB.Label lblDesc
Caption = "Background Color"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 0
Left = 180
TabIndex = 12
Top = 345
Width = 1260
End
Begin VB.Label lblPBckgColor
BackColor = &H00FF8080&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 1635
TabIndex = 11
Top = 300
Width = 900
End
End
Begin VB.CommandButton cmdDelete
Caption = "Delete panel"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 4170
TabIndex = 2
ToolTipText = "Delete current panel"
Top = 165
Width = 1140
End
Begin VB.Frame Frame1
Caption = " Panel Picture "
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2655
Left = 4920
TabIndex = 7
Top = 570
Width = 1755
Begin VB.OptionButton optIconSize
Caption = " Large Icon"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 1
Left = 165
TabIndex = 36
ToolTipText = "Only used when loading icons !"
Top = 1560
Width = 1110
End
Begin VB.OptionButton optIconSize
Caption = " Small Icon"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 165
TabIndex = 35
ToolTipText = "Only used when loading icons !"
Top = 1305
Value = -1 'True
Width = 1110
End
Begin VB.ComboBox cbPPalignment
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
ItemData = "StatusBarPanels.pgx":00AB
Left = 135
List = "StatusBarPanels.pgx":00B8
Style = 2 'Dropdown List
TabIndex = 5
Top = 1875
Width = 1485
End
Begin VB.CommandButton cmdDelPanelsPicture
Height = 435
Left = 1170
Picture = "StatusBarPanels.pgx":00E6
Style = 1 'Graphical
TabIndex = 4
Top = 795
Width = 435
End
Begin VB.PictureBox picPanel
AutoRedraw = -1 'True
AutoSize = -1 'True
Height = 915
Left = 135
ScaleHeight = 57
ScaleMode = 3 'Pixel
ScaleWidth = 61
TabIndex = 8
TabStop = 0 'False
Top = 300
Width = 975
End
Begin VB.CommandButton cmdOpenDlg
Height = 435
Left = 1170
Picture = "StatusBarPanels.pgx":0230
Style = 1 'Graphical
TabIndex = 3
Top = 300
Width = 435
End
Begin VB.Label Label
Caption = "Set [MaskColor] before loading icons !"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 135
TabIndex = 34
Top = 2205
Width = 1560
End
End
Begin VB.HScrollBar hsb
Height = 285
Left = 2295
Max = 0
TabIndex = 0
TabStop = 0 'False
Top = 165
Width = 435
End
Begin VB.CommandButton cmdInsertPanel
Caption = "Insert panel"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 2940
TabIndex = 1
ToolTipText = "Insert after current panel"
Top = 165
Width = 1140
End
Begin VB.Label lblIndex
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00808080&
BorderStyle = 1 'Fixed Single
Caption = "0 / 0"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00E0E0E0&
Height = 270
Left = 1440
TabIndex = 9
Top = 180
Width = 780
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Index"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 3
Left = 810
TabIndex = 6
Top = 210
Width = 555
End
Begin VB.Shape Shape
BackColor = &H00E0E0E0&
BackStyle = 1 'Opaque
Height = 465
Left = 75
Top = 75
Width = 6585
End
End
Attribute VB_Name = "StatusBarPanels"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'
' StatusBarPanels.pag
'
Option Explicit
Const sFilter As String = "All Picture Files (BMP, GIF, ICO, JPG)|*.bmp;*.ico;*.gif;*.jpg|All Files (*.*)|*.*"
Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" _
(ByVal lpszFile As String, _
ByVal nIconIndex As Long, _
phiconLarge As Long, _
phiconSmall As Long, _
ByVal nIcons As Long) As Long
Private Declare Function DestroyIcon Lib "user32" _
(ByVal hIcon As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(lpPictDesc As PICTDESC, _
riid As Any, _
ByVal fOwn As Long, _
ipic As IPicture) As Long
Private Type PICTDESC
cbSize As Long
pictType As Long
hIcon As Long
hPal As Long
End Type
Private sb As ucVeryWellsStatusBarXP
Private iLastPanel As Long
'
'
'
Private Function IconToPicture(ByVal hIcon As Long) As Picture
' Thx to www.VB2TheMax.Com for this nice little gem !
Dim pic As PICTDESC
Dim guid(0 To 3) As Long
' initialize the PictDesc structure
pic.cbSize = Len(pic)
pic.pictType = vbPicTypeIcon
pic.hIcon = hIcon
' this is the IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
' we use an array of Long to initialize it faster
guid(0) = &H7BF80980
guid(1) = &H101ABF32
guid(2) = &HAA00BB8B
guid(3) = &HAB0C3000
' create the picture,
' return an object reference right into the function result
OleCreatePictureIndirect pic, guid(0), True, IconToPicture
End Function
Private Sub cbPanelType_Click()
Select Case cbPanelType.ListIndex
Case [PT Text fixed size]
Case [PT Text spring size]
Case [PT Time]
txt(0).Text = Format(Time, "hh:nn:ss")
Case [PT Date]
txt(0).Text = Format(Date, "d.m.yyyy")
Case [PT CapsLock]
txt(0).Text = "CAPS"
Case [PT NumLock]
txt(0).Text = "NUM"
Case [PT Scroll]
txt(0).Text = "SCROLL"
End Select
Changed = True
End Sub
Private Sub cmdInsertPanel_Click()
Dim lNumberOfPanels As Long
If Changed = True Then
PropertyPage_ApplyChanges
End If
With sb
lNumberOfPanels = .InsertPanel(hsb.Value)
hsb.Min = 1
hsb.Max = lNumberOfPanels
End With
Changed = True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -