xp_statusbar.ctl

主要功能：接收和发送短信

Private m_hpalHalftone          As Long
Private flgRedrawEnabled        As Boolean              ' Set to FALSE to prevent redawing the statusbar, don't forget
                                                        ' to re-activate! Used in 'Usercontrol_ReadProperties(), ...
Private flgNoTimerInterrupt     As Boolean              ' Prevent internal API timer activity during DrawStatusBar(), ...
'
'
'


' *************************************
' *            INIT/TERM              *
' *************************************

Private Sub UserControl_Initialize()

    flgRedrawEnabled = True
    
End Sub

Private Sub UserControl_Terminate()
    
    flgRedrawEnabled = False
    
    ' Stop timer
    KillTimer UserControl.hwnd, 2201
    flgTimerEnabled = False
        
    Set frm = Nothing
    Erase rcPanel
    
End Sub



' *************************************
' *         PUBLIC FUNCTIONS          *
' *************************************

Public Function InsertPanel(ByVal lCurrentPanel As Long) As Long

    Dim i As Long


    m_PanelCount = m_PanelCount + 1
    ReDim Preserve m_Panels(1 To m_PanelCount) As New clsPanels
    
    ' Make space for the new one
    lCurrentPanel = lCurrentPanel + 1
    For i = m_PanelCount To lCurrentPanel + 1 Step -1
        Set m_Panels(i) = m_Panels(i - 1)
    Next i
    Set m_Panels(lCurrentPanel) = New clsPanels
    With m_Panels(lCurrentPanel)
        .ClientWidth = 100
        .pEnabled = True
        Set .PanelPicture = Nothing
        .PanelEdgeInner = 0
        .PanelEdgeOuter = 0
        .PanelEdgeSpacing = 0
        .PanelGradient = 0
        .pVisible = True
    End With
    PropertyChanged "NumberOfPanels"
    InsertPanel = m_PanelCount
    DrawStatusBar True
    
End Function


Public Function DeletePanel(lPanelIndex As Long)
    
    Dim i As Long
    
    If m_PanelCount > 0 Then
        For i = lPanelIndex To m_PanelCount - 1
            Set m_Panels(i) = m_Panels(i + 1)
        Next i
        Set m_Panels(m_PanelCount) = Nothing
        m_PanelCount = m_PanelCount - 1
        If m_PanelCount > 0 Then
            ReDim Preserve m_Panels(1 To m_PanelCount)
        Else
            Erase m_Panels()
        End If
        PropertyChanged "NumberOfPanels"
        DrawStatusBar True
    End If
    
End Function


Public Sub RefreshAll()
    ' Redraw the whole statusbar from scratch

    DrawStatusBar True

End Sub



' *************************************
' *         FRIEND FUNCTIONS          *
' *************************************

Friend Sub TimerUpdate()

    Dim i   As Long
    
    If flgNoTimerInterrupt = True Then
        
        Exit Sub
    End If
    
    RaiseEvent TimerBeforeRedraw
    
    For i = 1 To m_PanelCount
        With m_Panels(i)
            Select Case .PanelType
            
            Case [PT Date]
                    PanelCaption(i) = Format(Date, constFORMAT_DATE)
                                            
            Case [PT Time]
                    PanelCaption(i) = Format(Time, constFORMAT_TIME)
            
            Case [PT CapsLock]
                    GetKeyboardState kbArray
                    .pEnabled = IIf(kbArray.kbByte(VK_CAPITAL) = 1, True, False)
                    PanelCaption(i) = "CAPS"
            
            Case [PT NumLock]
                    GetKeyboardState kbArray
                    .pEnabled = IIf(kbArray.kbByte(VK_NUMLOCK) = 1, True, False)
                    PanelCaption(i) = "NUM"
            
            Case [PT Scroll]
                    GetKeyboardState kbArray
                    .pEnabled = IIf(kbArray.kbByte(VK_SCROLL) = 1, True, False)
                    PanelCaption(i) = "SCROLL"
            
            End Select
            
        End With
    Next i
    
    RaiseEvent TimerAfterRedraw
    
End Sub



' *************************************
' *         PRIVATE FUNCTIONS         *
' *************************************

Private Sub UserControl_InitProperties()
            
    flgRedrawEnabled = False
    Set UserControl.Font = UserControl.Parent.Font
    oBackColor = vbButtonFace
    oForeColor = vbButtonText
    oDissColor = vbGrayText
    oMaskColor = RGB(255, 0, 255)
    bDrawGripper = True
    flgTimerEnabled = False
    m_Apperance = m_def_Apperance
    m_UseWindowsColors = m_def_UseWindowsColors
    flgRedrawEnabled = True
    DrawStatusBar True
     
End Sub

Private Sub UserControl_Show()

    ' Ensure "special background handling"
    Select Case m_Apperance

    Case [XP Diagonal Left], [XP Diagonal Right]
        BackColor = oBackColor = UserControl.Parent.BackColor

    End Select

    If Ambient.UserMode = True Then
        If flgTimerEnabled = False Then
        
            ' Start API timer
            SetProp UserControl.hwnd, "sbXP_ClassID", ObjPtr(Me)
            SetTimer UserControl.hwnd, 2201, 200, AddressOf API_Timer_Callback
            flgTimerEnabled = True
        End If
    Else
    
        ' Stop timer
        KillTimer UserControl.hwnd, 2201
        flgTimerEnabled = False
    End If
    
End Sub

Private Sub UserControl_Click()
    
    If PanelNum < 1 Then
         
         Exit Sub
    End If
    If m_Panels(PanelNum).pEnabled = True Then
        RaiseEvent Click(PanelNum)
    End If
    
End Sub

Private Sub UserControl_DblClick()
    
    If PanelNum < 1 Then
         
         Exit Sub
    End If
    If m_Panels(PanelNum).pEnabled = True Then
        RaiseEvent DblClick(PanelNum)
    End If
    
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim hRgn    As Long
    Dim i       As Long
    
    PanelNum = 0
    If ShowGripper = True Then
        hRgn = CreateRectRgnIndirect(rcGripper)
        If PtInRegion(hRgn, CLng(X), CLng(Y)) Then
            If Button = vbLeftButton Then
                SizeByGripper frm.hwnd
                DeleteObject hRgn
                
                Exit Sub
            End If
        End If
        
    End If
    
    For i = 1 To m_PanelCount
        hRgn = CreateRectRgnIndirect(rcPanel(i))
        If PtInRegion(hRgn, CLng(X), CLng(Y)) Then
            If Button = vbLeftButton Then
                If m_Panels(i).pEnabled = True Then
                    PanelNum = i
                    RaiseEvent MouseDownInPanel(i)
                End If
                DeleteObject hRgn
            End If
        End If
    Next i
    
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Dim hRgn    As Long
    Dim i       As Long
    
    On Error GoTo error_handler

    If ShowGripper = True Then
        hRgn = CreateRectRgnIndirect(rcGripper)
        If PtInRegion(hRgn, CLng(X), CLng(Y)) Then
            UserControl.MousePointer = vbSizeNWSE
            DeleteObject hRgn
            
            Exit Sub
        Else
            UserControl.MousePointer = vbArrow
            DeleteObject hRgn
        End If
    Else
        UserControl.MousePointer = vbArrow
    End If
    
    If m_PanelCount < 1 Then        ' Jut for sure ...
    
        Exit Sub
    End If
    For i = 1 To m_PanelCount
        hRgn = CreateRectRgnIndirect(rcPanel(i))
        If PtInRegion(hRgn, CLng(X), CLng(Y)) Then
            Extender.ToolTipText = m_Panels(i).ToolTipTxt
        End If
        DeleteObject hRgn
    Next i

    On Error GoTo 0

    Exit Sub


error_handler:
    
    If hRgn Then
        DeleteObject hRgn
    End If
    
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    ReleaseCapture
    
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    
    Dim i As Long

    On Error GoTo error_handler
    
    flgRedrawEnabled = False
    With PropBag
        BackColor = .ReadProperty("BackColor", vbButtonFace)
        ForeColor = .ReadProperty("ForeColor", vbButtonText)
        ForeColorDisabled = .ReadProperty("ForeColorDissabled", vbGrayText)
        MaskColor = .ReadProperty("MaskColor", RGB(255, 0, 255))
        
        Set UserControl.Font = .ReadProperty("Font", UserControl.Parent.Font)
        ShowGripper = .ReadProperty("ShowGripper", True)
        ShowSeperators = .ReadProperty("ShowSeperators", True)
        m_Apperance = .ReadProperty("Apperance", m_def_Apperance)
        m_UseWindowsColors = .ReadProperty("UseWindowsColors", m_def_UseWindowsColors)
        m_TopLine = .ReadProperty("TopLine", True)
        Set m_BackgroundPic = .ReadProperty("BckGrndPic", Nothing)
        
        m_PanelCount = .ReadProperty("NumberOfPanels", 0)
    End With
    
    
    If m_PanelCount > 0 Then
        ReDim m_Panels(1 To m_PanelCount) As New clsPanels
    End If
    For i = 1 To m_PanelCount
        With m_Panels(i)
            .pEnabled = PropBag.ReadProperty("pEnabled" & i, True)
            .pVisible = PropBag.ReadProperty("pVisible" & i, True)
            .ClientWidth = PropBag.ReadProperty("PWidth" & i)
            .pMinWidth = PropBag.ReadProperty("PMinWidth" & i, 10)
            .ToolTipTxt = PropBag.ReadProperty("pTTText" & i)