Вот код вместе с удалением курсора.
В форме пишем:
- Private Sub Form_Load()
-
- Combo1.Text = "Vbnet sample by Executioner"
- Combo1.AddItem "test0"
- Combo1.AddItem "test1"
- Combo1.AddItem "test2"
- Combo1.AddItem "test3"
- ChangeCboParams Combo1
- End Sub
-
- Private Sub Form_Unload(Cancel As Integer)
- RevertCboParams
- End Sub
В модуле пишем:
- Private Declare Function HideCaret Lib "user32" (ByVal hwnd 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 CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
- Private Const GW_CHILD = 5
-
- Const EM_SETSEL = &HB1
- Const WM_LBUTTONDBLCLK = &H203
-
- Dim OldProc As Long
- Dim CboTextHandle As Long
- Private bHooked As Boolean
-
- Public Function ChangeCboParams(Combo As ComboBox)
- If bHooked Then Exit Function
- CboTextHandle = GetWindow(Combo.hwnd, GW_CHILD)
- OldProc = SetWindowLong(CboTextHandle, &HFFFC, AddressOf WndProc)
- bHooked = True
- End Function
-
- Public Function RevertCboParams()
- If Not bHooked Then Exit Function
- SetWindowLong CboTextHandle, &HFFFC, OldProc
- End Function
-
- Private Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Select Case uMsg
- Case EM_SETSEL
- HideCaret CboTextHandle
- Case WM_LBUTTONDBLCLK
-
- Case Else
- WndProc = CallWindowProc(OldProc, hwnd, uMsg, wParam, lParam)
- End Select
- End Function
Ничего более гениального и простого я придумать не смог...
Ответить
|