Access判断组合框是否处于下拉状态
时间:2004-11-28 22:26 来源:TheAccessWeb 作者:Dev Ashi… 阅读:次
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 *********
(责任编辑:admin)
顶一下
(0)
0%
踩一下
(0)
0%
相关内容
- ·API函数详细解释
- ·Access从剪切版里复制和粘贴数据
- ·Access利用api实现打开/关闭光驱
- ·应用程序开机自动启动(注册表操作技巧
- ·Access VBA 判断网络是否连通的多种办
- ·什么是ADP,了解ADP的优缺点
- ·优秀产品大全--通用票据打印软件(新)
- ·[技巧分享]多条Shell语句执行导致判断
- ·在access中可以调用API函数GetFileInfo
- ·Access API集中营--增加临时使用的字体
- ·API ShellExecute 功能说明及应用示例
- ·在VB中使用API函数(什么是API? )
- ·API实现完美的图片出现效果(转)
- ·API 设置调整系统当前时间
- ·如何检测以及设置键盘状态
- ·不关闭当前数据库COPY当前数据库
最新内容
推荐内容