Access911.net   |   a9BBS   |   OTaA System  
  搜索文章︰  
Access911歡迎您光臨  
   主頁      上傳      简体版       論壇     
設為首頁  |  加入收藏   
  
你現在的位置︰文章索引 -> 文章分類 -> API  
 首頁|  近日更新|  下載  |  文章索引  |  搜索|  朮語|  承接工程|  
 
系統正在加載內容,請耐心等待...
 
 查詢
 窗体
 報表
 
 
 VBA
 函數
 ADO/DAO/ADO.NET
 API
 ADP
 安全
 發布
 OA
 ASP/ASP.NET
 其他語言
 控件
 DELPHI
 C#/.Net
 本站
 其他
 小例程
 常用軟件
 參考文檔
 業主作品
 网友大作
 
 
友情鏈接
 access911.net
 
訪問人次
 1702374
 
站長 E-Mail
 net911@sina.com
 access911@gmail.com
 
RSS 訂閱

顯示附加信息 >>>

如何得知combobox組合框的下拉狀態

作者︰未詳  摘自︰未詳  ︰cg1  更新日期︰2003-9-5  瀏覽人次︰

 

【摘】
Access提供給我們DropDown方法來強制combobox彈出下拉列表。但是Access本身卻沒有提供相應的屬性告訴我們當前combobox列表打開与否

現在有兩种方法通過編程來确定combobox的下拉列表狀態。
一种是通過几個Access窗口的窗体類名,另一种是通過屏幕坐標來确定


1)  通過類名

'******* Code Start *********
' This code was originally written by Dev Ashish.
' 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
' Dev Ashish
'
'  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
'  returns true if a combo box on the form is dropped down
'  only one combo can have the focus => only one drop down
'
Static hwnd As Long
Static hWndCBX_LBX As Long

   hwnd = 0: hWndCBX_LBX = 0

   '  Start with finding the window with "ODCombo" class name
   hwnd = apiFindWindow(ACC_CBX_LISTBOX_PARENT_CLASS, _
                                vbNullString)
   '  Parent window of ODCombo is the Access window
   If apiGetParent(hwnd) = hWndAccessApp Then
         '  Child window of ODCombo window is the
         '  drop down listbox associated with a combobox
         hWndCBX_LBX = apiGetWindow(hwnd, GW_CHILD)
         '  another check to confirm that we're looking at the right window
         If fGetClassName(hWndCBX_LBX) = _
                        ACC_CBX_LISTBOX_CLASS Then
            '  Finally, if this window is visible,
            If apiGetWindowLong(hwnd, GWL_STYLE) And WS_VISIBLE Then
               '  the Combo must be open
               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)  通過坐標

'******* 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 *********


 

 
相關文章
     沒有手動相關文章
 
評論
     查看或發表更多的評論,請單擊這里。
 
 
 
 
 
   
  Access911.net   |   a9BBS   |   OTaA System   |
建站日期︰2000年4月2日  |  設計施工︰陳格 ( access911 & cg1 )
 Copyright © 2000 - 2003 COMET, 陳格 保留所有權利