ctrl_channelbar.ctl

一个简单的快餐店收银软件

Public Sub AddSubItem(m_SubItem As String)
    With UserControl
        v_iSubItemCount = v_iSubItemCount + 1
        Load .lbl_SubItem(v_iSubItemCount)
        .lbl_SubItem(v_iSubItemCount).Caption = m_SubItem
        .lbl_SubItem(v_iSubItemCount).Width = TextWidth(.lbl_SubItem(v_iSubItemCount).Caption) + 300
        .lbl_SubItem(v_iSubItemCount).Top = SubItemTop '395
        .lbl_SubItem(v_iSubItemCount).Left = .lbl_SubItem(v_iSubItemCount - 1).Left + .lbl_SubItem(v_iSubItemCount - 1).Width + 180
        .lbl_SubItem(v_iSubItemCount).Visible = True
    End With
End Sub

Private Sub UnloadItems()
    Dim v_iLoop As Integer
    
    For v_iLoop = 1 To v_iItemCount
        Unload UserControl.lbl_Item(v_iLoop)
    Next v_iLoop
    v_iItemCount = 0
End Sub

Private Sub UnloadSubItems()
    Dim v_iLoop As Integer
    
    For v_iLoop = 1 To v_iSubItemCount
        Unload UserControl.lbl_SubItem(v_iLoop)
    Next v_iLoop
    v_iSubItemCount = 0
End Sub

'Public Property Get SkinPath() As String
'    SkinPath = v_sSkinPath
'End Property

'Public Property Let SkinPath(ByVal m_SkinPath As String)
'    v_sSkinPath = m_SkinPath
'    PropertyChanged "SkinPath"
'End Property

Public Property Get ForeColor() As OLE_COLOR
    ForeColor = v_oForeColor
End Property

Public Property Let ForeColor(ByVal m_ForeColor As OLE_COLOR)
    v_oForeColor = m_ForeColor
    PropertyChanged "ForeColor"
End Property

Public Property Get MouseMoveColor() As OLE_COLOR
    MouseMoveColor = v_oMouseMoveColor
End Property

Public Property Let MouseMoveColor(ByVal m_MouseMoveColor As OLE_COLOR)
    v_oMouseMoveColor = m_MouseMoveColor
    PropertyChanged "MouseMoveColor"
End Property

Public Property Get MouseDownColor() As OLE_COLOR
    MouseDownColor = v_oMouseDownColor
End Property

Public Property Let MouseDownColor(ByVal m_MouseDownColor As OLE_COLOR)
    v_oMouseDownColor = m_MouseDownColor
    PropertyChanged "MouseDownColor"
End Property

Public Property Get SubMouseMoveColor() As OLE_COLOR
    SubMouseMoveColor = v_oSubMouseMoveColor
End Property

Public Property Let SubMouseMoveColor(ByVal m_SubMouseMoveColor As OLE_COLOR)
    v_oSubMouseMoveColor = m_SubMouseMoveColor
    PropertyChanged "SubMouseMoveColor"
End Property

Public Property Get SubMouseDownColor() As OLE_COLOR
    SubMouseDownColor = v_oSubMouseDownColor
End Property

Public Property Let SubMouseDownColor(ByVal m_SubMouseDownColor As OLE_COLOR)
    v_oSubMouseDownColor = m_SubMouseDownColor
    PropertyChanged "SubMouseDownColor"
End Property

Public Property Get SubItemTop() As Integer
    SubItemTop = v_iSubItemTop
End Property

Public Property Let SubItemTop(ByVal m_SubItemTop As Integer)
    v_iSubItemTop = m_SubItemTop
    PropertyChanged "SubItemTop"
End Property

Private Sub lbl_Item_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim v_lRtn As Long
    Dim v_iCenterImgFrequency As Integer
    Dim v_iLoop As Integer

    RaiseEvent ItemMouseMove(Index, Button, Shift, X, Y)
    With UserControl
        .pic_MouseMove.Left = .lbl_Item(Index).Left - 90
        .pic_MouseMove.Width = .lbl_Item(Index).Width + 180
        .pic_MouseMove.Height = 360
        
        .pic_MouseMove.Cls
        v_lRtn = BitBlt(.pic_MouseMove.hdc, 0, 0, 22, 24, .pic_PullDownMenu.hdc, 154, 0, SRCCOPY)
        v_iCenterImgFrequency = Abs((.pic_MouseMove.Width / Screen.TwipsPerPixelX) / 22)
        If v_iCenterImgFrequency > 0 Then
            For v_iLoop = 1 To v_iCenterImgFrequency
                v_lRtn = BitBlt(.pic_MouseMove.hdc, v_iLoop * 22, 0, 22, 24, .pic_PullDownMenu.hdc, 172, 0, SRCCOPY)
            Next v_iLoop
        End If
        v_lRtn = BitBlt(.pic_MouseMove.hdc, (.pic_MouseMove.Width / Screen.TwipsPerPixelX) - 8, 0, 8, 24, .pic_PullDownMenu.hdc, 212, 0, SRCCOPY)
        
        .lbl_MouseMove.Caption = .lbl_Item(Index).Caption
        .lbl_MouseMove.ForeColor = MouseMoveColor
        .lbl_MouseMove.Width = .lbl_Item(Index).Width
        .lbl_MouseMove.Top = 75
        .lbl_MouseMove.Left = 240
        .lbl_MouseMove.Visible = True
        .pic_MouseMove.Visible = True
    End With
    v_iLastItem = Index
End Sub

Private Sub lbl_MouseMove_Click()
    Call UnloadSubItems
    Call Refresh
    UserControl.pic_SubMouseMove.Visible = False
    RaiseEvent Click(v_iLastItem)
End Sub

Private Sub lbl_MouseMove_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim v_lRtn As Long
    Dim v_iCenterImgFrequency As Integer
    Dim v_iLoop As Integer

    If Button = 1 Then

    With UserControl
        .pic_MouseMove.Cls
        .lbl_MouseMove.ForeColor = MouseDownColor
        v_lRtn = BitBlt(.pic_MouseMove.hdc, 0, 0, 22, 24, .pic_PullDownMenu.hdc, 7, 0, SRCCOPY)
        v_iCenterImgFrequency = Abs((.pic_MouseMove.Width / Screen.TwipsPerPixelX) / 8)
        If v_iCenterImgFrequency > 0 Then
            For v_iLoop = 1 To v_iCenterImgFrequency
                v_lRtn = BitBlt(.pic_MouseMove.hdc, v_iLoop * 22, 0, 22, 24, .pic_PullDownMenu.hdc, 30, 0, SRCCOPY)
            Next v_iLoop
        End If
        v_lRtn = BitBlt(.pic_MouseMove.hdc, (.pic_MouseMove.Width / Screen.TwipsPerPixelX) - 8, 0, 8, 24, .pic_PullDownMenu.hdc, 70, 0, SRCCOPY)
    End With
    
    End If
End Sub

Private Sub lbl_SubItem_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim v_lRtn As Long
    Dim v_iCenterImgFrequency As Integer
    Dim v_iLoop As Integer

    RaiseEvent SubItemMouseMove(v_iLastItem, Index, Button, Shift, X, Y)
    With UserControl
        .pic_SubMouseMove.Left = .lbl_SubItem(Index).Left - 90
        .pic_SubMouseMove.Width = .lbl_SubItem(Index).Width + 180
        .pic_SubMouseMove.Height = 360
        
        .pic_SubMouseMove.Cls
        v_lRtn = BitBlt(.pic_SubMouseMove.hdc, 0, 0, 22, 24, .pic_PullDownMenu.hdc, 154, 24, SRCCOPY)
        v_iCenterImgFrequency = Abs((.pic_SubMouseMove.Width / Screen.TwipsPerPixelX) / 22)
        If v_iCenterImgFrequency > 0 Then
            For v_iLoop = 1 To v_iCenterImgFrequency
                v_lRtn = BitBlt(.pic_SubMouseMove.hdc, v_iLoop * 22, 0, 22, 24, .pic_PullDownMenu.hdc, 172, 24, SRCCOPY)
            Next v_iLoop
        End If
        v_lRtn = BitBlt(.pic_SubMouseMove.hdc, (.pic_SubMouseMove.Width / Screen.TwipsPerPixelX) - 8, 0, 8, 24, .pic_PullDownMenu.hdc, 212, 24, SRCCOPY)
        
        .lbl_SubMouseMove.Caption = .lbl_SubItem(Index).Caption
        .lbl_SubMouseMove.ForeColor = SubMouseMoveColor
        .lbl_SubMouseMove.Width = .lbl_SubItem(Index).Width
        .lbl_SubMouseMove.Top = SubItemTop - 365 '30
        .lbl_SubMouseMove.Left = 210
        .lbl_SubMouseMove.Visible = True
        .pic_SubMouseMove.Visible = True
    End With
    v_iLastSubItem = Index
End Sub

Private Sub lbl_SubMouseMove_Click()
    RaiseEvent SubClick(v_iLastItem, v_iLastSubItem)
End Sub

Private Sub lbl_SubMouseMove_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim v_lRtn As Long
    Dim v_iCenterImgFrequency As Integer
    Dim v_iLoop As Integer

    If Button = 1 Then

    With UserControl
        .pic_SubMouseMove.Cls
        .lbl_SubMouseMove.ForeColor = SubMouseDownColor
        v_lRtn = BitBlt(.pic_SubMouseMove.hdc, 0, 0, 22, 24, .pic_PullDownMenu.hdc, 7, 24, SRCCOPY)
        v_iCenterImgFrequency = Abs((.pic_SubMouseMove.Width / Screen.TwipsPerPixelX) / 8)
        If v_iCenterImgFrequency > 0 Then
            For v_iLoop = 1 To v_iCenterImgFrequency
                v_lRtn = BitBlt(.pic_SubMouseMove.hdc, v_iLoop * 22, 0, 22, 24, .pic_PullDownMenu.hdc, 30, 24, SRCCOPY)
            Next v_iLoop
        End If
        v_lRtn = BitBlt(.pic_SubMouseMove.hdc, (.pic_SubMouseMove.Width / Screen.TwipsPerPixelX) - 8, 0, 8, 24, .pic_PullDownMenu.hdc, 70, 24, SRCCOPY)
    End With
    
    End If
End Sub

Private Sub UserControl_InitProperties()
    'v_sSkinPath = App.Path & "\Skins\Titanium"
    v_oForeColor = DefForeColor
    v_oMouseMoveColor = DefMouseMoveColor
    v_oMouseDownColor = DefMouseDownColor
    v_oSubMouseMoveColor = DefSubMouseMoveColor
    v_oSubMouseDownColor = DefSubMouseDownColor
    v_iSubItemTop = DefSubItemTop
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    'v_sSkinPath = PropBag.ReadProperty("SkinPath", App.Path & "\Skins\Titanium")
    'Call DrawMenu
    
    v_oForeColor = PropBag.ReadProperty("ForeColor", DefForeColor)
    UserControl.lbl_Item(0).ForeColor = v_oForeColor

    v_oMouseMoveColor = PropBag.ReadProperty("MouseMoveColor", DefMouseMoveColor)
    UserControl.lbl_MouseMove.ForeColor = v_oMouseMoveColor
    
    v_oMouseDownColor = PropBag.ReadProperty("MouseDownColor", DefMouseDownColor)
    
    v_iSubItemTop = PropBag.ReadProperty("SubItemTop", DefSubItemTop)

    v_oSubMouseMoveColor = PropBag.ReadProperty("SubMouseMoveColor", DefSubMouseMoveColor)
    
    v_oSubMouseDownColor = PropBag.ReadProperty("SubMouseDownColor", DefSubMouseDownColor)
End Sub

Private Sub UserControl_Resize()
    Call Refresh
End Sub

Private Sub UserControl_Terminate()
    Call UnloadItems
    Call UnloadSubItems
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    'Call PropBag.WriteProperty("SkinPath", v_sSkinPath, App.Path & "\Skins\Titanium")
    Call PropBag.WriteProperty("ForeColor", v_oForeColor, DefForeColor)
    Call PropBag.WriteProperty("MouseMoveColor", v_oMouseMoveColor, DefMouseMoveColor)
    Call PropBag.WriteProperty("MouseDownColor", v_oMouseDownColor, DefMouseDownColor)
    Call PropBag.WriteProperty("SubItemTop", v_iSubItemTop, DefSubItemTop)
    Call PropBag.WriteProperty("SubMouseMoveColor", v_oSubMouseMoveColor, DefSubMouseMoveColor)
    Call PropBag.WriteProperty("SubMouseDownColor", v_oSubMouseDownColor, DefSubMouseDownColor)
End Sub