如何使下拉框收回去？

[ybcaa]

自己做了个下拉选择的控件，下拉框用的是ListBox，当点击使下拉框显示出来后，怎样才能在点窗体或其它控件时使我的控件的下拉框收回去？

[liul17]

我刚刚解决了此问题
将下面代码粘入控件中，控件上有三个基本控件(txtContent文本框,cmdSel按钮,grd（Msflexgrid）)
我弹出的是msflexgrid你可以改为listbox
若还有问题你可以 emailto: [e-mail]

Option Explicit

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()
Private Declare Function GetCapture Lib "user32" () 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 SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long


Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOOLWINDOW = &H80


Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type


Private Sub cmdSel_Click()

Dim ctlRect As RECT

grd.Visible = Not grd.Visible
If grd.Visible Then

ShowPopUp
txtContent.SetFocus
txtContent.SelStart = 0
txtContent.SelLength = Len(txtContent)
Else
HidePopup

End If
End Sub

Private Sub grd_Click()
MsgBox grd.Row
End Sub

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

If X < 0 Or X > grd.Width Or Y < 0 Or Y > grd.Height Then
HidePopup
Else
HidePopup
End If
End Sub

Private Sub UserControl_ExitFocus()
grd.Visible = False
End Sub

Private Sub UserControl_Initialize()
grd.Visible = False
SetWindowLong grd.hwnd, GWL_EXSTYLE, WS_EX_TOOLWINDOW
SetParent grd.hwnd, 0
End Sub

Private Sub UserControl_LostFocus()
grd.Visible = False
End Sub

Private Sub UserControl_Resize()

txtContent.Move 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight
cmdSel.Width = txtContent.Height - 50
cmdSel.Height = txtContent.Height - 50
cmdSel.Move UserControl.ScaleWidth - cmdSel.Width - 25, 30
grd.Move 0, txtContent.Height, UserControl.ScaleWidth, 1000

End Sub


Private Sub ShowPopUp()

'显示下拉框

Dim ileft As Long
Dim iTop As Long
Dim ctlRect As RECT

'决定显示下拉框的显示位置


GetWindowRect UserControl.hwnd, ctlRect '获取控件的矩形区域
If ctlRect.Bottom + (grd.Height / Screen.TwipsPerPixelX) > Screen.Height / Screen.TwipsPerPixelY Then
'置前
iTop = (ctlRect.Top - (grd.Height / Screen.TwipsPerPixelY)) * Screen.TwipsPerPixelY
Else
'置后
iTop = ctlRect.Bottom * Screen.TwipsPerPixelY
End If
'If the popup window is as wide as, or wider than the control, we want to align
'it to the left edge of the control. Otherwise, we align it to the right. If
'we're too far to the right, we push it back left.
If (ctlRect.Right - ctlRect.Left) > grd.Width / Screen.TwipsPerPixelX Then
'try to align to the right of the control
If ctlRect.Right > Screen.Width / Screen.TwipsPerPixelX Then
ileft = Screen.Width - grd.Width
Else
ileft = ctlRect.Right * Screen.TwipsPerPixelX - grd.Width
End If
'Check we haven't gone outside the left edge of the screen
If ileft < 0 Then ileft = 0
Else
'try to align to the left
If ctlRect.Left < 0 Then
ileft = 0
Else
ileft = ctlRect.Left * Screen.TwipsPerPixelX
End If
'Check we haven't gone outside the left edge of the screen
If ileft + grd.Width > Screen.Width Then ileft = Screen.Width - grd.Width
End If

With grd
.Top = iTop
.Left = ileft
.Visible = True
.ZOrder
End With

DoEvents
SetCapture grd.hwnd

End Sub

Private Sub HidePopup()
'隐藏下拉框

If GetCapture = grd.hwnd Then
ReleaseCapture
End If
grd.Visible = False
DoEvents


End Sub

[ybcaa]

liuli7,太感谢了！也多谢上面几位！

[rainstormmaster]

处理ListBox的LostFocus事件

[wingchi]

up

[xingnup]

处理LostFocus事件

[liuxiang800314]

lostfocus

[ybcaa]

我的控件是点击image显示listbox的，listbox并没有获得焦点，也就无从处理lostFocus事件

[girl888]

LostFocus

[ybcaa]

不行的