

2) 通过坐标来判断是否已经打开
'******* Code Start ********* ' This code was originally written by Stephen Lebans. ' It is not to be altered or distributed, ' except as part of an application. ' You are free to use it in any application, ' provided the copyright notice is left unchanged. ' ' Code Courtesy of ' Stephen Lebans ' Private Declare Function MapWindowPoints Lib "user32" _ (ByVal hwndFrom As Long, ByVal hwndTo As Long, _ lppt As Any, ByVal cPoints As Long) As Long Private Declare Function WindowFromPoint Lib "user32" _ (ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Declare Function ChildWindowFromPoint Lib "user32" _ (ByVal hwnd As Long, ByVal xPoint As Long, _ ByVal yPoint As Long) As Long Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, _ lpPoint As POINTL) As Long Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, _ lpPoint As POINTL) As Long Private Declare Function apiCreateIC Lib "gdi32" Alias "CreateICA" _ (ByVal lpDriverName As String, ByVal lpDeviceName As String, _ ByVal lpOutput As String, lpInitData As Any) As Long Private Declare Function apiDeleteDC Lib "gdi32" Alias "DeleteDC" _ (ByVal hdc As Long) As Long Private Declare Function apiGetDeviceCaps Lib "gdi32" _ Alias "GetDeviceCaps" (ByVal hdc As Long, _ ByVal nIndex As Long) As Long Private Const LOGPIXELSX = 88 ' Logical pixels/inch in X Private Const LOGPIXELSY = 90 ' Logical pixels/inch in Y Private Type POINTL X As Long Y As Long End Type Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'If user has combo dropped and clicks into 'form we need to check and see if Combo is 'still dropped 'Save duplication of code simply call 'the COmbo's MouseMove Event directly Call MyCombo_MouseMove(0, 0, 0, 0) End Sub Private Sub MyCombo_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Ok if we're here let's see if the Combo is dropped Down 'temp handle for ListBox hWnd Dim ComboListhWnd As Long 'Let's calculate TwipsPerPixel 'Get Screen resolution Dim mypoint As POINTL Dim lngIC As Long Dim lngXdpi As Long Dim lngYdpi As Long Dim TwipsPerPixelX As Long Dim TwipsPerPixelY As Long Dim lngret As Long lngIC = apiCreateIC("DISPLAY", vbNullString, vbNullString, vbNullString) 'If the call to CreateIC didn't fail, then get the Screen X resolution. If lngIC <> 0 Then lngXdpi = apiGetDeviceCaps(lngIC, LOGPIXELSX) lngYdpi = apiGetDeviceCaps(lngIC, LOGPIXELSY) 'Release the information context. apiDeleteDC (lngIC) Else ' Something has gone wrong. Assume an average value. lngret = MsgBox("Error..invalid Display Device Context..Exiting", vbOKOnly) Exit Sub End If TwipsPerPixelX = 1440 \ lngXdpi TwipsPerPixelY = 1440 \ lngYdpi 'adjust to the expected values 'OK lets assume the Combo DropBox is at least 2 rows in height mypoint.X = ((Me.MyCombo.Left + Me.MyCombo.Width) \ 2) \ TwipsPerPixelX mypoint.Y = (Me.MyCombo.Top + (Me.MyCombo.Height * 2)) \ TwipsPerPixelY Call ClientToScreen(Me.hwnd, mypoint) ComboListhWnd = WindowFromPoint(mypoint.X, mypoint.Y) If ComboListhWnd = Me.hwnd Then Me.txtAPICombo = "The Combo has NOT Dropped" Else: Me.txtAPICombo = "The Combo has Dropped" End If End Sub '******* Code End *********