⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 statusbarpanels.pag

📁 主要功能:接收和发送短信
💻 PAG
📖 第 1 页 / 共 3 页
字号:

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 + -