xpmccombo.ctl

进销存管理系统,我是个新手,请大家多多帮助哈1

End Property

Public Property Let BorderColor(ByVal New_BorderColor As OLE_COLOR)

    m_BorderColor = New_BorderColor
    PropertyChanged "BorderColor"
    Call DrawControl

End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get BorderColorOver() As OLE_COLOR

    BorderColorOver = m_BorderColorOver

End Property

Public Property Let BorderColorOver(ByVal New_BorderColorOver As OLE_COLOR)

    m_BorderColorOver = New_BorderColorOver
    PropertyChanged "BorderColorOver"
    Call DrawControl

End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get BorderColorDown() As OLE_COLOR

    BorderColorDown = m_BorderColorDown

End Property

Public Property Let BorderColorDown(ByVal New_BorderColorDown As OLE_COLOR)

    m_BorderColorDown = New_BorderColorDown
    PropertyChanged "BorderColorDown"
    Call DrawControl

End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get BgColor() As OLE_COLOR

    BgColor = m_BgColor

End Property

Public Property Let BgColor(ByVal New_BgColor As OLE_COLOR)

    m_BgColor = New_BgColor
    PropertyChanged "BgColor"
    Call DrawControl

End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get BgColorOver() As OLE_COLOR

    BgColorOver = m_BgColorOver

End Property

Public Property Let BgColorOver(ByVal New_BgColorOver As OLE_COLOR)

    m_BgColorOver = New_BgColorOver
    PropertyChanged "BgColorOver"
    Call DrawControl

End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get BgColorDown() As OLE_COLOR

    BgColorDown = m_BgColorDown

End Property

Public Property Let BgColorDown(ByVal New_BgColorDown As OLE_COLOR)

    m_BgColorDown = New_BgColorDown
    PropertyChanged "BgColorDown"
    Call DrawControl

End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get ButtonColor() As OLE_COLOR

    ButtonColor = m_ButtonColor

End Property

Public Property Let ButtonColor(ByVal New_ButtonColor As OLE_COLOR)

    m_ButtonColor = New_ButtonColor
    PropertyChanged "ButtonColor"
    Call DrawControl

End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get ButtonColorOver() As OLE_COLOR

    ButtonColorOver = m_ButtonColorOver

End Property

Public Property Let ButtonColorOver(ByVal New_ButtonColorOver As OLE_COLOR)

    m_ButtonColorOver = New_ButtonColorOver
    PropertyChanged "ButtonColorOver"
    Call DrawControl

End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get ButtonColorDown() As OLE_COLOR

    ButtonColorDown = m_ButtonColorDown

End Property

Public Property Let ButtonColorDown(ByVal New_ButtonColorDown As OLE_COLOR)

    m_ButtonColorDown = New_ButtonColorDown
    PropertyChanged "ButtonColorDown"
    Call DrawControl

End Property
Public Property Get ColumnHeaders() As Boolean
    ColumnHeaders = m_ColumnHeaders
End Property

Public Property Let ColumnHeaders(ByVal New_ColumnHeaders As Boolean)
    m_ColumnHeaders = New_ColumnHeaders
    
    PropertyChanged "ColumnHeaders"
End Property

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()

  Dim lcolor As Long
  Dim oColor As Long

    m_BorderColor = m_def_BorderColor
    m_BorderColorOver = RGB(10, 36, 106)
    m_BorderColorDown = RGB(10, 36, 106)
    m_BgColor = m_def_BgColor
    m_BgColorOver = m_def_BorderColorOver
    m_BgColorDown = RGB(133, 146, 181)
    m_ButtonColor = RGB(219, 216, 209)
    m_ButtonColorOver = RGB(182, 189, 210)
    m_ButtonColorDown = m_def_ButtonColorDown
    m_BorderColorOver = m_def_BorderColorOver
    m_ButtonSize = m_def_ButtonSize
    m_Text = m_def_Text
    m_ColumnHeaders = True
    m_ListHeight = 3070
    m_oStartColor = vbWhite
    m_oEndColor = vbButtonFace
    m_Style = m_def_Style
    m_FocusColor = m_def_FocusColor
    m_ButtonFadeColor = m_def_ButtonFadeColor
     m_DropListEnabled = True
  
    Call DrawControl
    
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    IniLat = Height
    IniLung = Width
    m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor)
    m_BorderColorOver = PropBag.ReadProperty("BorderColorOver", m_def_BorderColorOver)
    m_BorderColorDown = PropBag.ReadProperty("BorderColorDown", m_def_BorderColorDown)
    m_BgColor = PropBag.ReadProperty("BgColor", m_def_BgColor)
    m_BgColorOver = PropBag.ReadProperty("BgColorOver", m_def_BgColorOver)
    m_BgColorDown = PropBag.ReadProperty("BgColorDown", m_def_BgColorDown)
    m_ButtonColor = PropBag.ReadProperty("ButtonColor", m_def_ButtonColor)
    m_ButtonColorOver = PropBag.ReadProperty("ButtonColorOver", m_def_ButtonColorOver)
    m_ButtonColorDown = PropBag.ReadProperty("ButtonColorDown", m_def_ButtonColorDown)
    m_ButtonSize = PropBag.ReadProperty("ButtonSize", m_def_ButtonSize)
    m_Text = PropBag.ReadProperty("Text", m_def_Text)
    Text1.text = m_Text
    m_NrColVisible = PropBag.ReadProperty("NrColVisible", 1)
    
    m_ListHeight = PropBag.ReadProperty("ListHeight", 3070)
    
    m_ListWidth = PropBag.ReadProperty("ListWidth", "100")
    m_BoundColumns = PropBag.ReadProperty("m_BoundColumns", "0")
    bgBottomColor = PropBag.ReadProperty("bgBottomColor", vbWhite)
    bgTopColor = PropBag.ReadProperty("bgTopColor", vbButtonFace)
    m_Style = PropBag.ReadProperty("Style", m_def_Style)
    m_FocusColor = PropBag.ReadProperty("FocusColor", m_def_FocusColor)
    m_ButtonFadeColor = PropBag.ReadProperty("ButtonFadeColor", m_def_ButtonFadeColor)

    Text1.ForeColor = PropBag.ReadProperty("Text_ForeColor", &H80000008)
    Text1.Enabled = PropBag.ReadProperty("Text_Enabled", True)
    Text1.Locked = PropBag.ReadProperty("Text_Locked", False)
    m_DropListEnabled = PropBag.ReadProperty("DropListEnabled", True)
    m_ColumnHeaders = PropBag.ReadProperty("ColumnHeaders", True)
   
    Call DrawControl

End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor)
    Call PropBag.WriteProperty("BorderColorOver", m_BorderColorOver, m_def_BorderColorOver)
    Call PropBag.WriteProperty("BorderColorDown", m_BorderColorDown, m_def_BorderColorDown)
    Call PropBag.WriteProperty("BgColor", m_BgColor, m_def_BgColor)
    Call PropBag.WriteProperty("BgColorOver", m_BgColorOver, m_def_BgColorOver)
    Call PropBag.WriteProperty("BgColorDown", m_BgColorDown, m_def_BgColorDown)
    Call PropBag.WriteProperty("ButtonColor", m_ButtonColor, m_def_ButtonColor)
    Call PropBag.WriteProperty("ButtonColorOver", m_ButtonColorOver, m_def_ButtonColorOver)
    Call PropBag.WriteProperty("ButtonColorDown", m_ButtonColorDown, m_def_ButtonColorDown)
    Call PropBag.WriteProperty("ButtonSize", m_ButtonSize, m_def_ButtonSize)
    
    Call PropBag.WriteProperty("Text", m_Text, m_def_Text)
    
    Call PropBag.WriteProperty("FocusColor", m_FocusColor, m_def_FocusColor)

    
    Call PropBag.WriteProperty("bgBottomColor", bgBottomColor, vbWhite)
    Call PropBag.WriteProperty("bgTopColor", bgTopColor, vbButtonFace)
    Call PropBag.WriteProperty("ButtonFadeColor", m_ButtonFadeColor, m_def_ButtonFadeColor)

    Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
    
    Call PropBag.WriteProperty("NrColVisible", m_NrColVisible, 1)
    
    Call PropBag.WriteProperty("ListHeight", m_ListHeight, 3070)
   
    Call PropBag.WriteProperty("ListWidth", m_ListWidth, "100")
     Call PropBag.WriteProperty("BoundColumns", m_BoundColumns, "0")
    Call PropBag.WriteProperty("ColumnHeaders", m_ColumnHeaders, True)
    
    Call PropBag.WriteProperty("Text_ForeColor", Text1.ForeColor, &H80000008)
    Call PropBag.WriteProperty("Text_Enabled", Text1.Enabled, True)
    Call PropBag.WriteProperty("Text_Locked", Text1.Locked, False)
    Call PropBag.WriteProperty("DropListEnabled", m_DropListEnabled, True)
    

       
End Sub

Private Sub UserControl_Click()

    RaiseEvent Click

End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)

    RaiseEvent KeyDown(KeyCode, Shift)

End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)

    RaiseEvent KeyPress(KeyAscii)

End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)

    RaiseEvent KeyUp(KeyCode, Shift)

End Sub

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

    RaiseEvent MouseDown(Button, Shift, X, Y)
    IsButtDown = True

End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get ButtonSize() As Long

    ButtonSize = m_ButtonSize

End Property

Public Property Let ButtonSize(ByVal New_ButtonSize As Long)

    m_ButtonSize = New_ButtonSize
    PropertyChanged "ButtonSize"
    Call DrawControl

End Property

Public Sub ShowPopup(Show As Integer)
 If Show = 0 And IsWindowVisible(frmpopup.hWnd) = 0 Then
    GoTo ShowDropDown_Exit
 ElseIf Show = 1 And (IsWindowVisible(frmpopup.hWnd) <> 0 Or m_DropListEnabled = False) Then
    GoTo ShowDropDown_Exit
 End If
 
  If Show Then
  
  Dim ClrPos As RECT
  Dim crx As Long
   
    Call GetWindowRect(hWnd, ClrPos)
    IsMDown = True
    IsCrlOver = True
    Call DrawControl
    
  RaiseEvent DropList
    With frmpopup
        
        .Left = ClrPos.Left * Screen.TwipsPerPixelX
        .Top = ClrPos.Bottom * Screen.TwipsPerPixelY
        .BackColor = m_BgColor
        
        .lsw.BackColor = m_BgColor
        .isclick = False
        .lsw.Width = lTotalWid
        .lsw.Height = m_ListHeight
        .selectedtext = Text1.text
        If (.Top + .Height) > Screen.Height Then
            .Top = ClrPos.Top * Screen.TwipsPerPixelY - .Height
        End If
        'Compensate Width based on 800by600 Pixes.
        Dim cWidth As Long
        cWidth = 0
        If NumBounds < 3 Then
          If NumBounds = 1 Then cWidth = 190
          If NumBounds = 2 Then cWidth = 100
        Else
         cWidth = 0
         End If
        .Width = lTotalWid + (NumBounds * 380) + cWidth
        If m_ListHeight <= 2000 Then
           m_ListHeight = 2000
        End If
        
        'Check whether ColumnHeader is on or Hide
        If m_ColumnHeaders = False Then
        .Height = m_ListHeight - 270
        Else
        .Height = m_ListHeight + 10
        End If
        
        'Modal Mode
        .Show 1
        
        If .isclick Then
            Text1.text = .selectedtext
            
        End If
        
        Unload frmpopup
                
       End With
        IsMDown = False
        IsCrlOver = False
        Call DrawControl
       End If
       
ShowDropDown_Exit:
    Exit Sub
End Sub

Public Property Get text() As String

    text = m_Text

End Property

Public Property Let text(ByVal New_Text As String)

    m_Text = New_Text
    
    Text1.text = m_Text
    PropertyChanged "Text"

End Property
Public Property Get Text_ForeColor() As OLE_COLOR
    Text_ForeColor = Text1.ForeColor
End Property
Public Property Let Text_ForeColor(ByVal Text_New_ForeColor As OLE_COLOR)
    Text1.ForeColor() = Text_New_ForeColor
    PropertyChanged "Text_ForeColor"
End Property
Public Property Get Text_Enabled() As Boolean
    Text_Enabled = Text1.Enabled
End Property