'//按 ALT+F11 转到 vba 界面，
'//新建一个模块
'//将以下代码 COPY 进去
'//将光标停在 Function RunTest() 这行
'//按 F5 即可运行
'//运行结束后转到 ACCESS 使用界面，即可看到效果
'-----------------------------------------------
'自定义数据类型，GetAccessWindow的返回值
Public Type AWPix
Left As Long
Top As Long
Width As Long
Height As Long
End Type
'-----------------------------------------------
'获取、设置 Window状态的API
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, _
ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Type RECT '屏幕坐标中随同窗口装载的矩形
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'-----------------------------------------------
'获取分辩率设置的 API
Public Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
Public Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Public Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long
Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
Public Const DIRECTION_VERTICAL = 1
Public Const DIRECTION_HORIZONTAL = 0
'-----------------------------------------------
'获取窗体缩放状态的 API
'缩放状态
Public Declare Function IsZoomed Lib "user32" (ByVal hwnd As Long) As Long
'是否最小化
Public Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
'是否可见
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
'---------------------------------------------
'设置窗体状态的 API
Public Const SW_HIDE = 0 '隐藏
Public Const SW_SHOWNORMAL = 1 '普通（还原）
Public Const SW_SHOWMINIMIZED = 2 '最小化
Public Const SW_SHOWMAXIMIZED = 3 '最大化
Public Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
'----------------------------------------------'像素转换成缇，本站以前文章中已经介绍过了。
' 关于单位“缇”与“像素”的转换，以及缇与其他单位（例如：厘米）之间的转换《窗体》
' http://access911.net/index.asp?u1=a&u2=72FAB41E13DCE9F3
Function PixelsToTwips(rlngPixels As Long, rlngDirection As Long) As Long
On Error GoTo PixelsToTwips_Err
Dim lngDeviceHandle As Long
Dim lngPixelsPerInch As Long
lngDeviceHandle = apiGetDC(0)
If rlngDirection = DIRECTION_HORIZONTAL Then '水平X方向
lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSX)
Else '垂直Y方向
lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSY)
End If
lngDeviceHandle = apiReleaseDC(0, lngDeviceHandle)
PixelsToTwips = rlngPixels * 1440 / lngPixelsPerInch
PixelsToTwips_Exit:
On Error Resume Next
Exit Function
PixelsToTwips_Err:
MsgBox Err.Description, vbExclamation, "access911.net"
Resume PixelsToTwips_Exit
End Function
'像素转换成缇，本站以前文章中已经介绍过了。
' 关于单位“缇”与“像素”的转换，以及缇与其他单位（例如：厘米）之间的转换《窗体》
' http://access911.net/index.asp?u1=a&u2=72FAB41E13DCE9F3
Function PixelsToTwips(rlngPixels As Long, rlngDirection As Long) As Long
On Error GoTo PixelsToTwips_Err
Dim lngDeviceHandle As Long
Dim lngPixelsPerInch As Long
lngDeviceHandle = apiGetDC(0)
If rlngDirection = DIRECTION_HORIZONTAL Then '水平X方向
lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSX)
Else '垂直Y方向
lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSY)
End If
lngDeviceHandle = apiReleaseDC(0, lngDeviceHandle)
PixelsToTwips = rlngPixels * 1440 / lngPixelsPerInch
PixelsToTwips_Exit:
On Error Resume Next
Exit Function
PixelsToTwips_Err:
MsgBox Err.Description, vbExclamation, "access911.net"
Resume PixelsToTwips_Exit
End Function
'===========================================================
' 过程及函数名： RunTest
' 版本号 ： --
' 说明 ： 本过程只用于演示如何用VBA+WINAPI 控制
' Access 主窗体的位置和大小
' 引用 ： --
' 输入参数 ： --
' 输出值 ： --
' 返回值 ： --
' 调用演示 ： RunTest
' 最后修改日期： 2008-1-30 16:36:00
'===========================================================
Function RunTest()
'显示当前Access主窗体的高度
Debug.Print GetAccessWindow.Height
'设置当前Access窗体：
'宽 553像素，高400像素，距离上边20像素，左边12像素
SetAccessWindow 12, 20, 553, 400
End Function
'===========================================================
' 过程及函数名： GetAccessWindow
' 版本号 ： --
' 说明 ： 获取 ACCESS 主窗体的大小及位置，获取单位是
' 像素，如果要转为ACCESS的度量衡单位“Twip缇”
' 可以用函数 PixelsToTwips 转换。
' 注意，本函数还定义了一个 Type AWPix
' 引用 ： --
' 输入参数 ： --
' 输出值 ： --
' 返回值 ： 返回自定义类型 AWPix 数据。
' 调用演示 ： Debug.Print GetAccessWindow.Height
' 最后修改日期： 2008-1-30 16:36:00
'===========================================================
Function GetAccessWindow() As AWPix
Dim intWidth As Long, intHeight As Long
Dim tAWPix As AWPix
Dim lngRet As Long
Dim Rc As RECT
Dim lngHwndMDI As Long
'获取ACCESS主窗体内嵌子对象的句柄
lngHwndMDI = FindWindowEx(Application.hWndAccessApp, _
0&, "MDIClient", "")
'上边距中不包含工具栏和菜单栏。尝试去掉工具栏看一下结果，然后再加上工具栏再看看结果
'lngRet = GetWindowRect(lngHwndMDI, Rc)
'获取整个ACCESS窗体最外侧的尺寸，在Win2003+acc2003的情况下最大化时每边都需要+4
lngRet = GetWindowRect(Application.hWndAccessApp, Rc)
With tAWPix
.Top = Rc.Top
.Left = Rc.Left
.Height = Rc.Bottom - Rc.Top
.Width = Rc.Right - Rc.Left
End With
GetAccessWindow = tAWPix
End Function
'===========================================================
' 过程及函数名： SetAccessWindow
' 版本号 ： --
' 说明 ： 设置 ACCESS 主窗体的大小及位置，设置单位是像素
' 引用 ： --
' 输入参数 ： --
' 输出值 ： --
' 返回值 ： --
' 调用演示 ： SetAccessWindow 0,0,150,566
' 最后修改日期： 2008-1-30 16:36:00
'===========================================================
Function SetAccessWindow(ByVal XLeft As Long, _
ByVal YTop As Long, _
ByVal XWidth As Long, _
ByVal YHeight As Long)
Dim lngHwndMDI As Long
Dim lngRet As Long
Dim Rc As RECT
If IsZoomed(Application.hWndAccessApp) = 1 Or _
IsIconic(Application.hWndAccessApp) = 1 Then
apiShowWindow Application.hWndAccessApp, SW_SHOWNORMAL
End If
MoveWindow Application.hWndAccessApp, XLeft, YTop, XWidth, YHeight, True
End Function
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2008-5-2 23:27
