VB6 更改ComboBox的Style属性（对应C# Dropdown属性）

Private Const GWL_STYLE = (-16)

Private Const GW_CHILD = 5

 

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long

 

Const SW_HIDE = 0

Const SW_SHOW = 5

 

'将  ComboBox 的 Style 改为 2 - DropdownList

Private Sub Command1_Click()

    Dim ChildHwnd As Long

   

    Combo1.AddItem "One"

    Combo1.AddItem "Two"

     

    ChildHwnd = GetWindow(Combo1.hwnd, GW_CHILD)          '取edit句柄

    Call DestroyWindow(ChildHwnd)                         'Kill edit窗口

   

    '改变cmbDropList的Style，这一语句可有可无~~~~，

    'Call SetWindowLong(Combo1.hwnd, GWL_STYLE, GetWindowLong(Combo1.hwnd, GWL_STYLE) + 1)

   

End Sub




---------------------------------------------------------------------------------




Form Code,

1. ' Add 3 command buttons in the form and paste this code.
2. Option Explicit
3.  
4. Private Sub Command1_Click()
5.     Dim ctl As ComboBox
6.     '
7.     Set ctl = AddSimpleCombo(Me, "Cbo1")
8.  
9.     '
10.     If Not ctl Is Nothing Then
11.         ctl.AddItem "AAAA"
12.         ctl.AddItem "BBBB"
13.         ctl.AddItem "CCCC"
14.         ctl.Left = Command1.Left + Command1.Width + 200
15.         ctl.Top = Command1.Top
16.         ctl.Visible = True
17.     End If
18.  
19.     '
20. End Sub
21.  
22. Private Sub Command2_Click()
23.     Dim ctl As ComboBox
24.     '
25.     Set ctl = AddDropDownCombo(Me, "Cbo2")
26.  
27.     '
28.     If Not ctl Is Nothing Then
29.         ctl.AddItem "DDDD"
30.         ctl.AddItem "EEEE"
31.         ctl.AddItem "FFFF"
32.         ctl.Left = Command2.Left + Command2.Width + 200
33.         ctl.Top = Command2.Top
34.         ctl.Visible = True
35.     End If
36.  
37.     '
38. End Sub
39.  
40. Private Sub Command3_Click()
41.     Dim ctl As ComboBox
42.     '
43.     Set ctl = AddDropDownList(Me, "Cbo3")
44.  
45.     '
46.     If Not ctl Is Nothing Then
47.         ctl.AddItem "GGGG"
48.         ctl.AddItem "HHHH"
49.         ctl.AddItem "IIII"
50.         ctl.Left = Command3.Left + Command3.Width + 200
51.         ctl.Top = Command3.Top
52.         ctl.Visible = True
53.     End If
54.  
55.     '
56. End Sub
57.  
58. Private Sub Form_Load()
59.     Command1.Left = 300
60.     Command1.Caption = "Add Simple Combo"
61.     '
62.     Command2.Left = 300
63.     Command2.Caption = "Add DropDown Combo"
64.     '
65.     Command3.Left = 300
66.     Command3.Caption = "Add DropDown List"
67. End Sub

Module Code,

1. Option Explicit
2. '
3. Private Const CBS_SIMPLE As Long = &H1&
4. Private Const CBS_DROPDOWN As Long = &H2&
5. Private Const CBS_DROPDOWNLIST As Long = &H3&
6. '
7. Private Declare Function SetWindowsHookEx _
8.                 Lib "user32" _
9.                 Alias "SetWindowsHookExA" (ByVal idHook As Long, _
10.                                            ByVal lpFn As Long, _
11.                                            ByVal hMod As Long, _
12.                                            ByVal dwThreadId As Long) As Long
13. Private Declare Function UnhookWindowsHookEx _
14.                 Lib "user32" (ByVal hHook As Long) As Long
15. Private Declare Function CallNextHookEx _
16.                 Lib "user32" (ByVal hHook As Long, _
17.                               ByVal nCode As Long, _
18.                               ByVal wParam As Long, _
19.                               lParam As Any) As Long
20. '
21. Private Const WH_CBT = 5&
22. Private Const HC_ACTION = 0&
23. Private Const HCBT_CREATEWND = 3&
24. '
25. Private Const GWL_STYLE = (-16)
26. Private Const GWL_EXSTYLE = (-20)
27. '
28. Private Declare Function GetWindowLong _
29.                 Lib "user32" _
30.                 Alias "GetWindowLongA" (ByVal hwnd As Long, _
31.                                         ByVal nIndex As Long) As Long
32. Private Declare Function SetWindowLong _
33.                 Lib "user32" _
34.                 Alias "SetWindowLongA" (ByVal hwnd As Long, _
35.                                         ByVal nIndex As Long, _
36.                                         ByVal dwNewLong As Long) As Long
37. Private Declare Function GetClassName _
38.                 Lib "user32" _
39.                 Alias "GetClassNameA" (ByVal hwnd As Long, _
40.                                        ByVal lpClassName As String, _
41.                                        ByVal nMaxCount As Long) As Long
42. 'hook arg vars...
43. Dim m_hHook As Long
44. Dim m_ClassName As String
45. Dim m_StylesAdd As Long, m_StylesRemove As Long
46. Dim m_ExStylesAdd As Long, m_ExStylesRemove As Long
47. Dim m_CallNext As Boolean
48. Dim m_UseExactClassname As Boolean
49.  
50. Public Function AddSimpleCombo(ContainerForm As Form, _
51.                                strComboName As String) As ComboBox
52.  
53.     If NoControlWithSameName(ContainerForm, strComboName) Then
54.         CbtHookStyle "ThunderComboBox", True, CBS_SIMPLE, CBS_DROPDOWN Or CBS_DROPDOWNLIST, 0, 0, True
55.         Set AddSimpleCombo = ContainerForm.Controls.Add("VB.ComboBox", strComboName)
56.         CbtUnhookStyle
57.     End If
58.  
59. End Function
60.  
61. Public Function AddDropDownCombo(ContainerForm As Form, _
62.                                  strComboName As String) As ComboBox
63.  
64.     If NoControlWithSameName(ContainerForm, strComboName) Then
65.         CbtHookStyle "ThunderComboBox", True, CBS_DROPDOWN, 0, 0, 0, True
66.         Set AddDropDownCombo = ContainerForm.Controls.Add("VB.ComboBox", strComboName)
67.         CbtUnhookStyle
68.     End If
69.  
70. End Function
71.  
72. Public Function AddDropDownList(ContainerForm As Form, _
73.                                 strComboName As String) As ComboBox
74.  
75.     If NoControlWithSameName(ContainerForm, strComboName) Then
76.         CbtHookStyle "ThunderComboBox", True, CBS_DROPDOWNLIST, 0, 0, 0, True
77.         Set AddDropDownList = ContainerForm.Controls.Add("VB.ComboBox", strComboName)
78.         CbtUnhookStyle
79.     End If
80.  
81. End Function
82.  
83. Private Sub CbtHookStyle(sClassname As String, _
84.                          Optional ByVal UseExactClassname As Boolean = False, _
85.                          Optional ByVal StylesAdd As Long = 0&, _
86.                          Optional ByVal StylesRemove As Long = 0&, _
87.                          Optional ByVal ExStylesAdd As Long = 0&, _
88.                          Optional ByVal ExStylesRemove As Long = 0&, _
89.                          Optional ByVal CallNextHook As Boolean = False)
90.     'Sets hook - call just prior to adding control
91.     CbtUnhookStyle 'allow only 1 active at any time
92.     m_ClassName = sClassname
93.     m_StylesAdd = StylesAdd
94.     m_StylesRemove = StylesRemove
95.     m_ExStylesAdd = ExStylesAdd
96.     m_ExStylesRemove = ExStylesRemove
97.     m_CallNext = CallNextHook
98.     m_UseExactClassname = UseExactClassname
99.     m_hHook = SetWindowsHookEx(WH_CBT, AddressOf CbtHook, 0&, App.ThreadID)
100. End Sub
101.  
102. Private Sub CbtUnhookStyle()
103.  
104.     'unhooks - call immediately after adding control
105.     If m_hHook <> 0& Then
106.         UnhookWindowsHookEx m_hHook
107.         m_hHook = 0&
108.     End If
109.  
110. End Sub
111.  
112. Private Function NoControlWithSameName(ContainerForm As Form, _
113.                                        strComboName As String) As Boolean
114.     On Error GoTo ErrHndlr
115.     Dim ctl As Control
116.  
117.     For Each ctl In ContainerForm.Controls
118.  
119.         If ctl.Name = strComboName Then
120.             Exit Function
121.         End If
122.  
123.     Next
124.  
125.     NoControlWithSameName = True
126.     Exit Function
127. ErrHndlr:
128. End Function
129.  
130. Private Function CbtHook(ByVal nCode As Long, _
131.                          ByVal hwnd As Long, _
132.                          ByVal lpCBCT As Long) As Long
133.  
134.     Select Case nCode
135.  
136.         Case Is < HC_ACTION
137.             CbtHook = CallNextHookEx(m_hHook, nCode, hwnd, ByVal lpCBCT)
138.             Exit Function '===============>>>
139.  
140.         Case HCBT_CREATEWND
141.             OnCreate ByVal hwnd
142.  
143.         Case Else
144.             'do nothing
145.     End Select
146.  
147.     If m_CallNext Then
148.         CbtHook = CallNextHookEx(m_hHook, nCode, hwnd, ByVal lpCBCT)
149.     End If
150.  
151. End Function
152.  
153. Private Sub OnCreate(ByVal hwnd As Long)
154.     Dim L As Long, lRet As Long
155.     Dim sClass As String
156.     Dim bHit As Boolean
157.     sClass = String(256, 0)
158.     lRet = GetClassName(hwnd, sClass, 255&)
159.  
160.     If lRet > 0& Then
161.         If m_UseExactClassname Then
162.             '(non case-sens match)
163.             sClass = Left$(sClass, lRet)
164.             bHit = (StrComp(sClass, m_ClassName, vbTextCompare) = 0)
165.         Else
166.             '(fuzzy match)
167.             bHit = (InStr(1, sClass, m_ClassName, vbTextCompare) > 0)
168.         End If
169.  
170.         If bHit Then
171.  
172.             'make style, exstyle changes...
173.             If (m_StylesAdd Or m_StylesRemove) <> 0& Then
174.                 L = GetWindowLong(hwnd, GWL_STYLE)
175.                 L = L Or m_StylesAdd
176.                 L = L And (Not m_StylesRemove)
177.                 SetWindowLong hwnd, GWL_STYLE, L
178.             End If
179.  
180.             If (m_ExStylesAdd Or m_ExStylesRemove) <> 0& Then
181.                 L = GetWindowLong(hwnd, GWL_EXSTYLE)
182.                 L = L Or m_ExStylesAdd
183.                 L = L And (Not m_ExStylesRemove)
184.                 SetWindowLong hwnd, GWL_EXSTYLE, L
185.             End If
186.         End If 'is class
187.     End If
188.  
189. End Sub

http://www.vbforums.com/showthread.php?525442-changing-the-Style-of-Combo-in-runtime