scombobox.ctl

可以用于商业用途

Private Declare Function OpenThemeData Lib "uxtheme.dll" (ByVal hwnd As Long, ByVal pszClassList As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function SetParent Lib "USER32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SetPixel Lib "gdi32.dll" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function SetRect Lib "USER32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "USER32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowRgn Lib "USER32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

'***********************************************************'
'* English: Events of the controls and of the Usercontrol. *'
'* Espa駉l: Eventos de los controles y del Usercontrol.    *'
'***********************************************************'
Private Sub picList_Click()
    '* English: A Element has been selected or the control has been clicked
    '* Espa駉l: Establece el elemento donde se hizo clic.
    On Error Resume Next
    If (ListContents(HighlightedItem + 1).Enabled = True) Then
        If (HighlightedItem + 1 >= ListCount1) Then HighlightedItem = HighlightedItem - 1
        ItemFocus = HighlightedItem + 1
        Call ListIndex1
        Text = ListContents(ItemFocus).Text
        Call DrawAppearance(myAppearanceCombo, 1)
        tmrFocus.Enabled = True
        RaiseEvent SelectionMade(ListContents(ListIndex1).Text, ItemFocus)
    End If
End Sub

Private Sub picList_KeyDown(KeyCode As Integer, Shift As Integer)
    Call UserControl_KeyDown(KeyCode, Shift)
End Sub

Private Sub picList_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    '* English: The mouse has been moved over the list
    '* Espa駉l: Mueve el mouse por la lista.
    FirstView = 1
    HighlightedItem = Int(y / 20)
    If (ListCount < 1) Or (HighlightedItem + 1 + scrollI.Value > MaxListLength) Then Exit Sub
    IndexItemNow = HighlightedItem + 1
    If (ListContents(HighlightedItem + 1 + scrollI.Value).Enabled = True) Then
        HighlightedItem = HighlightedItem + scrollI.Value
        If (HighlightedItem + 1 > scrollI.Value + MaxListLength - 1) Then HighlightedItem = scrollI.Value + MaxListLength - 1
        If (HighlightedItem + 1 > ListCount1 - 1) Then HighlightedItem = ListCount1 - 1
        If (HighlightedItem + 1 < ListCount1) Then Call DrawList(scrollI.Value, NumberItemsToShow)
        picList.Refresh
    Else
        HighlightedItem = -1
    End If
    DoEvents
End Sub

Private Sub scrollI_Change()
    FirstView = 1
    HighlightedItem = Abs(IndexItemNow - 1)
    tmrFocus.Enabled = False
    Call DrawList(scrollI.Value, NumberItemsToShow)
End Sub

Private Sub scrollI_Scroll()
    scrollI_Change
End Sub

Private Sub tmrFocus_Timer()
    If (InFocusControl(UserControl.hwnd) = True) And (picList.Visible = False) Then
        If (m_bOver = False) Then Call DrawAppearance(myAppearanceCombo, 2)
        m_bOver = True
    ElseIf (m_bOver = True) And (picList.Visible = False) Then
        Call DrawAppearance(myAppearanceCombo, 1)
        tmrFocus.Enabled = False
        m_bOver = False
    End If
    If (Enabled = False) Then Call IsEnabled(ControlEnabled)
End Sub

Private Sub txtCombo_Change()
    Dim sItem As Long, iLen As Long, iStart As Long

    On Error Resume Next
    iStart = txtCombo.SelStart
    If (myAutoSel = False) Then
        sItem = FindItemText(txtCombo.Text, 2)
        If (sItem > 0) Then
            If (ListContents(sItem).Enabled = True) Then
                ItemFocus = sItem
                IndexItemNow = sItem
                If (IndexItemNow > NumberItemsToShow) Then
                    iLen = (NumberItemsToShow + IndexItemNow) - IndexItemNow
                Else
                    iLen = IndexItemNow - (NumberItemsToShow + IndexItemNow)
                End If
                If (iLen > scrollI.Max) Then
                    scrollI.Value = scrollI.Max
                ElseIf (iLen < 0) Then
                    scrollI.Value = 0
                Else
                    scrollI.Value = scrollI.Max
                End If
                Call scrollI_Change
            End If
        Else
            ItemFocus = -1
        End If
    ElseIf (KeyPos <> 67) And (KeyPos <> 46) Then
        sItem = FindItemText(txtCombo.Text)
        If (sItem > 0) Then
            iLen = Len(txtCombo.Text)
            txtCombo.Text = txtCombo.Text & Mid$(ListContents(sItem).Text, iLen + 1, Len(ListContents(sItem).Text))
            txtCombo.SelStart = iLen
            txtCombo.SelLength = Len(txtCombo.Text)
            sItem = FindItemText(txtCombo.Text, 2)
            If (sItem > 0) Then
                If (ListContents(sItem).Enabled = True) Then
                    ItemFocus = sItem
                    IndexItemNow = sItem
                End If
            Else
                ItemFocus = -1
            End If
        Else
            ItemFocus = -1
        End If
        Call IsEnabled(ControlEnabled)
    Else
        ItemFocus = FindItemText(txtCombo.Text, 2)
        Call IsEnabled(ControlEnabled)
        txtCombo.SelStart = iStart
    End If
End Sub

Private Sub txtCombo_GotFocus()
    txtCombo.SelStart = 0
    txtCombo.SelLength = Len(txtCombo.Text)
End Sub

Private Sub txtCombo_KeyDown(KeyCode As Integer, Shift As Integer)
    If (KeyCode = 115) Then Call UserControl_KeyDown(KeyCode, Shift)
End Sub

Private Sub txtCombo_KeyUp(KeyCode As Integer, Shift As Integer)
    KeyPos = KeyCode
    If (KeyCode = 115) Then Call UserControl_KeyDown(KeyCode, Shift)
End Sub

Private Sub txtCombo_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If (picList.Visible = False) Then tmrFocus.Enabled = True
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
    If (AppearanceCombo = 18) Then Call IsEnabled(ControlEnabled)
End Sub

Private Sub UserControl_ExitFocus()
    Call IsEnabled(ControlEnabled)
    tmrFocus.Enabled = True
End Sub

Private Sub UserControl_InitProperties()
    '* English: Setup properties values.
    '* Espa駉l: Establece propiedades iniciales.
    ControlEnabled = True
    ItemFocus = -1
    IsPicture = False
    ListIndex = -1
    ListMaxL = 10
    myListShown = 0
    myAutoSel = False
    myAppearanceCombo = defAppearanceCombo
    myArrowColor = defArrowColor
    myBackColor = defListColor
    myDisabledColor = defDisabledColor
    myGradientColor1 = defGradientColor1
    myGradientColor2 = defGradientColor2
    myHighLightBorderColor = defHighLightBorderColor
    myHighLightColorText = defHighLightColorText
    myItemsShow = 7
    myListColor = defListColor
    myListGradient = False
    myNormalBorderColor = defNormalBorderColor
    myNormalColorText = defNormalColorText
    myOfficeAppearance = defOfficeAppearance
    mySelectBorderColor = defSelectBorderColor
    mySelectListBorderColor = defSelectListBorderColor
    mySelectListColor = defSelectListColor
    myShadowColorText = defShadowColorText
    myStyleCombo = defStyleCombo
    myText = Ambient.DisplayName
    Text = myText
    myXpAppearance = 1
    Set g_Font = Ambient.Font
    sumItem = 0
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case 13                                            '* Enter.
            If (picList.Visible = True) Then Call UserControl_MouseDown(0, 0, 0, 0)
        Case 33                                            '* PageDown.
            If (IndexItemNow > NumberItemsToShow) Then
                IndexItemNow = IndexItemNow - NumberItemsToShow - 1
                If (IndexItemNow < 0) Then IndexItemNow = 1
                If (scrollI.Value - NumberItemsToShow - 1 > 0) Then scrollI.Value = scrollI.Value - NumberItemsToShow - 1 Else scrollI.Value = 0
            Else
                IndexItemNow = 1
                scrollI.Value = 0
            End If
            scrollI_Change
        Case 34                                            '* PageUp.
            If (IndexItemNow < sumItem) Then
                IndexItemNow = IndexItemNow + NumberItemsToShow - 1
                If (IndexItemNow > sumItem) Then IndexItemNow = sumItem
                If (scrollI.Value + NumberItemsToShow - 1 < scrollI.Max) Then scrollI.Value = scrollI.Value + NumberItemsToShow - 1 Else scrollI.Value = scrollI.Max
            Else
                IndexItemNow = sumItem
                scrollI.Value = scrollI.Max
            End If
            scrollI_Change
        Case 35                                            '* End.
            IndexItemNow = sumItem
            scrollI.Value = scrollI.Max
            scrollI_Change
        Case 36                                            '* Start.
            IndexItemNow = 1
            scrollI.Value = 0
            scrollI_Change
        Case 38                                            '* Up arrow.
            If (IndexItemNow > 0) Then
                IndexItemNow = IndexItemNow - 1
                If (scrollI.Value > 0) And (IndexItemNow - NumberItemsToShow < NumberItemsToShow) Then scrollI.Value = scrollI.Value - 1
                scrollI_Change
            End If
        Case 40                                            '* Down arrow.
            If (IndexItemNow < sumItem) Then
                IndexItemNow = IndexItemNow + 1
                If (scrollI.Value < scrollI.Max) And (IndexItemNow > NumberItemsToShow) Then scrollI.Value = scrollI.Value + 1
                scrollI_Change
            End If
        Case 115                                           '* Key F4.
            Call UserControl_MouseDown(1, 0, 0, 0)
    End Select
End Sub

Private Sub UserControl_LostFocus()
    Call UserControl_ExitFocus
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim oRect As RECT

    '* English: Show or hide the list.
    '* Espa駉l: Muestra la lista ?la oculta.
    If (Button = vbLeftButton) And (picList.Visible = False) Then
        First = 1
        HighlightedItem = -1
        IndexItemNow = ListIndex
        scrollI.Max = IIf(MaxListLength - NumberItemsToShow < 0, 0, MaxListLength - NumberItemsToShow)
        If (ListCount > NumberItemsToShow) And (ItemFocus > 1) And (ItemFocus < scrollI.Max) Then
            scrollI.Value = IIf(NumberItemsToShow < ItemFocus - 1, Abs(scrollI.Max - NumberItemsToShow), 1)
        ElseIf (ItemFocus > scrollI.Max) Then
            scrollI.Value = scrollI.Max
        Else
            scrollI.Value = 0
        End If
        FirstView = 0
        tmrFocus.Enabled = False
        If (ListCount > NumberItemsToShow) Then
            picList.Height = NumberItemsToShow * 300
        ElseIf (ListCount > 0) Then
            picList.Height = ListCount * 300
        Else
            picList.Height = 240
        End If
        Call GetWindowRect(hwnd, oRect)
        If (myListShown = 1) Then
            '* The list is shown up.
            Call picList.Move(oRect.Left * Screen.TwipsPerPixelX, (oRect.Bottom * Screen.TwipsPerPixelY) - (picList.Height + UserControl.Height + 21))
        Else
            '* The list is shown down.
            Call picList.Move(oRect.Left * Screen.TwipsPerPixelX, oRect.Bottom * Screen.TwipsPerPixelY + 21)