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