📄 statusbarpanels.pag
字号:
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 4
Left = 1635
TabIndex = 39
Top = 1020
Width = 825
End
Begin VB.Label lblDesc
Caption = "内框斜面:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 3
Left = 4170
TabIndex = 38
Top = 1020
Width = 825
End
Begin VB.Label lblDesc
Caption = "间距:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 2
Left = 195
TabIndex = 37
Top = 1020
Width = 555
End
Begin VB.Label lblDesc
Caption = "渐变背景色:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 1
Left = 3015
TabIndex = 35
Top = 345
Width = 1560
End
Begin VB.Label lblDesc
Caption = "背景色:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 0
Left = 180
TabIndex = 28
Top = 345
Width = 1260
End
Begin VB.Label lblPBckgColor
BackColor = &H00FF8080&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1635
TabIndex = 18
Top = 300
Width = 900
End
End
Begin VB.CommandButton cmdDelete
Caption = "删除窗格(&R)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 3645
TabIndex = 2
ToolTipText = "Delete current panel"
Top = 150
Width = 1140
End
Begin VB.Frame Frame1
Caption = " 图片 "
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2655
Left = 4920
TabIndex = 24
Top = 570
Width = 1755
Begin VB.OptionButton optIconSize
Caption = "大图标"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 1
Left = 165
TabIndex = 16
Top = 1560
Width = 1110
End
Begin VB.OptionButton optIconSize
Caption = "小图标"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 165
TabIndex = 15
Top = 1305
Value = -1 'True
Width = 1110
End
Begin VB.ComboBox cbPPalignment
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
ItemData = "StatusBarPanels.pgx":00AB
Left = 135
List = "StatusBarPanels.pgx":00B8
Style = 2 'Dropdown List
TabIndex = 17
Top = 1875
Width = 1485
End
Begin VB.CommandButton cmdDelPanelsPicture
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 1170
Picture = "StatusBarPanels.pgx":00E6
Style = 1 'Graphical
TabIndex = 14
ToolTipText = "删除图片"
Top = 795
Width = 435
End
Begin VB.PictureBox picPanel
AutoRedraw = -1 'True
AutoSize = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 915
Left = 135
ScaleHeight = 57
ScaleMode = 3 'Pixel
ScaleWidth = 61
TabIndex = 25
TabStop = 0 'False
Top = 300
Width = 975
End
Begin VB.CommandButton cmdOpenDlg
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 1170
Picture = "StatusBarPanels.pgx":0230
Style = 1 'Graphical
TabIndex = 13
ToolTipText = "浏览图片..."
Top = 300
Width = 435
End
Begin VB.Label Label
Caption = "先设置屏蔽色后再加载图表 !"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 135
TabIndex = 40
Top = 2205
Width = 1560
End
End
Begin VB.HScrollBar hsb
Height = 300
Left = 1740
Max = 0
TabIndex = 0
TabStop = 0 'False
Top = 150
Width = 435
End
Begin VB.CommandButton cmdInsertPanel
Caption = "插入窗格(&N)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 2355
TabIndex = 1
ToolTipText = "Insert after current panel"
Top = 150
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 = 285
Left = 885
TabIndex = 26
Top = 165
Width = 780
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "索引:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 3
Left = 255
TabIndex = 23
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 Const CB_SETCURSEL = &H14E
Private sb As XP_StatusBar ' Most important ref to uc !
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 cbCopyFrom_Click()
' Copy all properties from an other panel
Dim lSrcPanel As Long
lSrcPanel = cbCopyFrom.ListIndex
If lSrcPanel < 1 Or lSrcPanel = hsb.Value Then
Exit Sub
End If
ShowProps lSrcPanel
SendMessage cbCopyFrom.hwnd, CB_SETCURSEL, 0&, ByVal 0& ' Select first item without Click event
End Sub
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -