程序运行时,主窗体界面会打开。很多时候,我们都把窗体的大小写死。这样就不至于在不同的电脑打开,由于分辨率的不同,样式不同。
现在很多电脑屏幕都很大。又必须顾及老式的小屏幕。所以下面的示例会根据当前屏幕分辨率自动设置Access主窗体大小及居中显示
效果图(打开自动居中且按合适的分辨率自动设置大小):
详细源码:
Option Compare Database
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 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
'----------------------------------------------
'===========================================================
' 过程及函数名: SetAccessWindow
' 版本号 : --
' 说明 : 设置 ACCESS 主窗体的大小及位置,设置单位是像素
' 引用 : --
' 输入参数 : --
' 输出值 : --
' 返回值 : --
' 调用演示 : SetAccessWindow 0,0,150,566
'===========================================================
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