📄 statusbarpanels.pag
字号:
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
iLastPanel = lNumberOfPanels
UpdateCopyFromCB
picPanel.Picture = Nothing
End Sub
Private Sub cmdDelPanelsPicture_Click()
picPanel.Picture = Nothing
Changed = True
End Sub
Private Sub cmdDelete_Click()
With hsb
sb.DeletePanel .Value
.Max = sb.NumberOfPanels
If .Max = 0 Then
.Min = 0
.Value = 0
End If
End With
UpdateCopyFromCB
End Sub
Private Sub cmdOpenDlg_Click()
Dim sFile As String
Dim lResult As Long
Dim hSmallIcon As Long
Dim hLargeIcon As Long
Dim hUsedIcon As Long
Dim sTMPpathFName As String
On Error GoTo error_handler
sFile = vbNullString
sFile = OpenCommonDialog("Load Picture", sFilter) + Chr$(0)
sFile = Left$(sFile, InStr(1, sFile, Chr$(0)) - 1)
If sFile <> "" Then
If UCase$(Right$(sFile, 4)) = ".ICO" Then
' Get total number of icons this file contains
lResult = ExtractIconEx(sFile, -1&, ByVal 0&, ByVal 0&, 1)
If lResult > 0 Then
lResult = ExtractIconEx(sFile, 0, hLargeIcon, hSmallIcon, 1)
If lResult > 0 Then
If optIconSize(0).Value = True Then
DestroyIcon hLargeIcon
hUsedIcon = hSmallIcon
Else
DestroyIcon hSmallIcon
hUsedIcon = hLargeIcon
End If
picPanel.BackColor = sb.MaskColor
Set picPanel.Picture = IconToPicture(hUsedIcon)
picPanel.Refresh
DestroyIcon hUsedIcon
sTMPpathFName = App.Path + "\~ConvIcon2Bmp.tmp"
SavePicture picPanel.Image, sTMPpathFName
Set picPanel.Picture = LoadPicture(sTMPpathFName)
picPanel.Refresh
Kill sTMPpathFName
End If
End If
Else
Set picPanel.Picture = LoadPicture(sFile)
End If
End If
On Error GoTo 0
Exit Sub
error_handler:
MsgBox "Error loading a picture :" + vbCrLf + vbCrLf + _
"[" + Err.Description + "] in 'cmdOpenDlg_Click()', Modul 'StatusBarPanels'", _
vbExclamation, " Error readin picture/icon"
End Sub
Private Sub hsb_Change()
Static flgDontRecurse As Boolean
Dim i As Long
If flgDontRecurse = True Then
Exit Sub
End If
flgDontRecurse = True
i = hsb.Value
If i <> iLastPanel And Changed = True Then
PropertyPage_ApplyChanges
End If
iLastPanel = i
If sb.NumberOfPanels > 0 Then
ShowProps i
End If
lblIndex.Caption = hsb.Value & " / " & hsb.Max
UpdateCopyFromCB
Changed = False
flgDontRecurse = False
End Sub
Private Sub ShowProps(lIndexPanel As Long)
' Load panels properties onto screen
With sb
txt(0).Text = .PanelCaption(lIndexPanel)
txt(1).Text = .PanelWidth(lIndexPanel)
txt(2).Text = .ToolTipText(lIndexPanel)
txt(3).Text = .PanelTag(lIndexPanel)
txt(4).Text = .PanelMinWidth(lIndexPanel)
cbPanelType.ListIndex = .PanelType(lIndexPanel)
cbTextAlignment.ListIndex = .TextAlignment(lIndexPanel)
chkEnabled.Value = IIf(.PanelEnabled(lIndexPanel) = True, 1, 0)
chkVisible.Value = IIf(.PanelVisible(lIndexPanel) = True, 1, 0)
chkBold.Value = IIf(.PanelTextBold(lIndexPanel) = True, 1, 0)
Set picPanel.Picture = .PanelPicture(lIndexPanel)
cmdDelete.Enabled = IIf(lIndexPanel = 0, False, True)
cbPPalignment.ListIndex = .PanelPicAlignment(lIndexPanel)
lblPBckgColor.BackColor = .PanelBckgColor(lIndexPanel)
cbGradient.ListIndex = .PanelGradient(lIndexPanel) - 1
cbSpacing.ListIndex = .PanelEdgeSpacing(lIndexPanel) - 1
SetListIndexByItemData cbOuterEge, .PanelEdgeOuter(lIndexPanel)
SetListIndexByItemData cbInnerEdge, .PanelEdgeInner(lIndexPanel)
End With
Select Case sb.PanelType(lIndexPanel)
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
End Sub
Private Sub UpdateCopyFromCB()
' Update the list of control 'cbCopyFrom' to match current number of panels
Dim i As Long
With cbCopyFrom
.Clear
.AddItem "Copy from ..."
For i = 1 To hsb.Max
If i <> hsb.Value Then
.AddItem " Panel " & i
End If
Next i
SendMessage .hwnd, CB_SETCURSEL, 0&, ByVal 0& ' Select first item without Click event
End With
PropertyPage.Refresh ' Got strange effect without this: Border of combo will not be drawn ... ;(
End Sub
Private Sub SetListIndexByItemData(TheCB As ComboBox, lItemData As Long)
Dim i As Long
With TheCB
For i = 0 To .ListCount - 1
If .ItemData(i) = lItemData Then
.ListIndex = i
Exit Sub
End If
Next i
End With
End Sub
Private Sub lblPBckgColor_Click()
lblPBckgColor.BackColor = GetColorsByStdDlg(lblPBckgColor.BackColor, PropertyPage.hwnd)
Changed = True
End Sub
Private Sub PropertyPage_ApplyChanges()
Dim i As Long
i = iLastPanel
If i < 1 Then
Exit Sub
End If
If txt(1).Text = "" Then
txt(1).Text = "100"
End If
With sb
.PanelEnabled(i) = IIf(chkEnabled = 1, True, False)
.PanelVisible(i) = IIf(chkVisible = 1, True, False)
.PanelTextBold(i) = IIf(chkBold = 1, True, False)
.PanelCaption(i) = txt(0).Text
.PanelWidth(i) = txt(1).Text
.ToolTipText(i) = txt(2).Text
.PanelTag(i) = txt(3).Text
.PanelMinWidth(i) = txt(4).Text
.PanelType(i) = cbPanelType.ListIndex
.TextAlignment(i) = cbTextAlignment.ListIndex
Set .PanelPicture(i) = picPanel.Picture
.PanelPicAlignment(i) = cbPPalignment.ListIndex
.PanelBckgColor(i) = lblPBckgColor.BackColor
.PanelGradient(i) = cbGradient.ListIndex + 1
.PanelEdgeSpacing(i) = cbSpacing.ListIndex + 1
.PanelEdgeOuter(i) = cbOuterEge.ItemData(cbOuterEge.ListIndex)
.PanelEdgeInner(i) = cbInnerEdge.ItemData(cbInnerEdge.ListIndex)
Select Case .PanelType(i)
Case [PT Text fixed size]
Case [PT Text spring size]
Case [PT Time]
.PanelCaption(i) = Format(Time, "hh:nn:ss")
Case [PT Date]
.PanelCaption(i) = Format(Date, "d.m.yyyy")
Case [PT CapsLock]
.PanelCaption(i) = "CAPS"
Case [PT NumLock]
.PanelCaption(i) = "NUM"
Case [PT Scroll]
.PanelCaption(i) = "SCROLL"
End Select
.RefreshAll
End With
End Sub
Private Sub PropertyPage_Initialize()
Dim i As Long
' Combo presets
With cbGradient
.AddItem "Transparent"
.AddItem "Opaque"
.AddItem "Top Bottom"
.AddItem "Top 1/3 Bottom"
.AddItem "Top 1/2 Bottom"
.AddItem "Top 2/3 Bottom"
.AddItem "Bottom Top"
End With
With cbOuterEge
.AddItem "None"
.ItemData(0) = 0
.AddItem "Border"
.ItemData(1) = 9
.AddItem "Etch"
.ItemData(2) = 6
.AddItem "RaiseLight"
.ItemData(3) = 4
.AddItem "RaiseHeavy"
.ItemData(4) = 5
.AddItem "SunkenLight"
.ItemData(5) = 2
.AddItem "SunkenHeavy"
.ItemData(6) = 10
End With
With cbInnerEdge
.AddItem "None"
.ItemData(0) = 0
.AddItem "Border"
.ItemData(1) = 9
.AddItem "Etch"
.ItemData(2) = 6
.AddItem "RaiseLight"
.ItemData(3) = 4
.AddItem "RaiseHeavy"
.ItemData(4) = 5
.AddItem "SunkenLight"
.ItemData(5) = 2
.AddItem "SunkenHeavy"
.ItemData(6) = 10
End With
With cbSpacing
For i = 1 To 7 ' inc, if you want to ;)
.AddItem i
Next i
End With
End Sub
Private Sub PropertyPage_SelectionChanged()
Set sb = SelectedControls(0)
iLastPanel = 0
lblIndex.Caption = "0 / 0"
If sb.NumberOfPanels > 0 Then
hsb.Min = 1
hsb.Max = sb.NumberOfPanels
lblIndex.Caption = "1 / " & hsb.Max
iLastPanel = 1
hsb_Change
End If
UpdateCopyFromCB
End Sub
Private Sub txt_Change(Index As Integer)
Changed = True
End Sub
Private Sub cbGradient_Click()
Changed = True
End Sub
Private Sub cbInnerEdge_Click()
Changed = True
End Sub
Private Sub cbOuterEge_Click()
Changed = True
End Sub
Private Sub cbPPalignment_Click()
Changed = True
End Sub
Private Sub cbSpacing_Click()
Changed = True
End Sub
Private Sub cbTextAlignment_Click()
Changed = True
End Sub
Private Sub chkEnabled_Click()
Changed = True
End Sub
Private Sub chkVisible_Click()
Changed = True
End Sub
Private Sub chkBold_Click()
Changed = True
End Sub
Private Sub picPanel_Change()
Changed = True
End Sub
' #*#
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -