---Soumis par Dev Ashish---
Déterminer l'état de la liste d'un contrôle combo box.
Access fournit la méthode DropDown pour forcer un combo box à afficher sa liste, depuis le code. Par contre, il n'y a pas de propriété associée qui nous permette de dire si cette liste est visible ou non, en un instant donné.
Il y a deux façons de déterminer si un combobox affiche sa liste ou non depuis le code. La première consiste à vérifier certains noms de classe de fenêtre possédés par Access et une seconde méthode, présentée par Stephen Lebans, utilise les coordonnées d'écran pour obtenir le combobox.
Ces deux exemples sont inclus dans CheckComboDrop.zip (Access 97 mdb). Prendre note que les mêmes techniques, avec des noms de classe différents, s'applique également à VB, nous permettant d'éviter GetComboBoxInfo qui n'est disponible que sous Win98 et Win2000.
1) Détecter l'état du combo via un nom de classe
'******* Code Start ********* ' retrieves the name of the class to which the specified window belongs. Private Declare Function apiGetClassName Lib "user32" _ Alias "GetClassNameA" _ (ByVal hwnd As Long, _ ByVal lpClassname As String, _ ByVal nMaxCount As Long) _ As Long ' retrieves a handle to the specified child window's parent window. Private Declare Function apiGetParent Lib "user32" _ Alias "GetParent" _ (ByVal hwnd As Long) _ As Long ' retrieves information about the specified window. The function also ' retrieves the 32-bit (long) value at the specified offset into the ' extra window memory of a window. Private Declare Function apiGetWindowLong Lib "user32" _ Alias "GetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long) _ As Long ' retrieves a handle to the top-level window whose class name and ' window name match the specified strings. This function does not search ' child windows. This function does not perform a case-sensitive search. Private Declare Function apiFindWindow Lib "user32" _ Alias "FindWindowA" _ (ByVal lpClassname As String, _ ByVal lpWindowName As String) _ As Long ' retrieves a handle to a window that has the specified relationship ' (Z order or owner) to the specified window Private Declare Function apiGetWindow Lib "user32" _ Alias "GetWindow" _ (ByVal hwnd As Long, _ ByVal wCmd As Long) _ As Long ' The class name for an Access combo's drop down listbox window Private Const ACC_CBX_LISTBOX_CLASS = "OGrid" ' Class name for the Access window Private Const ACC_MAIN_CLASS = "OMain" ' Class name for an Access combo's drop down listbox's parent window Private Const ACC_CBX_LISTBOX_PARENT_CLASS = "ODCombo" ' class name for an Access form's client window Private Const ACC_FORM_CLIENT_CLASS = "OFormSub" ' class name for Edit controls in Access Private Const ACC_CBX_EDIT_CLASS = "OKttbx" ' class name for VB combo's drop down listbox's parent window (SDI) Private Const VB_CBX_LISTBOX_PARENT_CLASS = "#32769" ' // Desktop ' class name for VB combo's drop down listbox window Private Const VB_CBX_LISTBOX_CLASS = "ComboLBox" ' handle identifies the child window at the top of the Z order, ' if the specified window is a parent window Private Const GW_CHILD = 5 ' Retrieves the window styles. Private Const GWL_STYLE = (-16) ' flag denoting that a window is visible Private Const WS_VISIBLE = &H10000000 Function fIsComboOpen() As Boolean ' retourne vrai si le combo montre sa liste, ' un seul combo à la fois ne peut avoir le focus => une seule liste n'est possible à la fois ' Static hwnd As Long Static hWndCBX_LBX As Long hwnd = 0: hWndCBX_LBX = 0 ' Commencer par trouver la fenêtre avec le nom de classe "ODCombo" hwnd = apiFindWindow(ACC_CBX_LISTBOX_PARENT_CLASS, _ vbNullString) ' Si le parent de ODCombo est Access If apiGetParent(hwnd) = hWndAccessApp Then ' la fenêtre fille de ODCombo est la liste ' associée au combo box hWndCBX_LBX = apiGetWindow(hwnd, GW_CHILD) ' vérification supplémentaire pour vérifier qu'on est au bon endroit If fGetClassName(hWndCBX_LBX) = _ ACC_CBX_LISTBOX_CLASS Then ' et finallement, si la fenêtre est visible, If apiGetWindowLong(hwnd, GWL_STYLE) And WS_VISIBLE Then ' c'est que la liste est bien visible. fIsComboOpen = True End If End If End If End Function Private Function fGetClassName(hwnd As Long) Dim strBuffer As String Dim lngLen As Long Const MAX_LEN = 255 strBuffer = Space$(MAX_LEN) lngLen = apiGetClassName(hwnd, strBuffer, MAX_LEN) If lngLen > 0 Then fGetClassName = Left$(strBuffer, lngLen) End Function '******* Code End *********2) Détecter le combo via ses coordonnées
'******* Code Start ********* ' Copyright ' Stephen Lebans 1999 ' 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) 'Vérifions si le combo box affiche actuellement sa liste 'Handle temporaire pour la liste Dim ComboListhWnd As Long 'Le nombre de TwipsPerPixel 'dépend de la résolution de l'écran 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) 'Si il n'y a pas eu d'erreur, obtenir les résolutions d'écran If lngIC <> 0 Then lngXdpi = apiGetDeviceCaps(lngIC, LOGPIXELSX) lngYdpi = apiGetDeviceCaps(lngIC, LOGPIXELSY) 'Relâcher le contexte. 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 'Ajustements selon les valeurs typiques 'On suppose que la liste fait au moins deux lignes de hauteur 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 = "Le Combo ne montre pas sa liste" Else: Me.txtAPICombo = "Le combo montre sa liste" End If End Sub '******* Code End *********