|
使窗体居中显示代码 access中的窗体虽然设置了自动居中,但是打开后总是有点不居中的感觉,加下如下代码可以做到真正居中显示
Private Sub Form_Load() DoCmd.Echo False Dim x, y As Integer DoCmd.Maximize x = Me.WindowWidth y = Me.WindowHeight DoCmd.Restore DoCmd.Echo True Move (x - Me.WindowWidth) / 2, (y - Me.WindowHeight) / 2 End Sub
下列代码适用于accessXP以上
'使用方法:
'Private Sub Form_Load() ' moveFormToCenter Me '居中 'End Sub
'Private Sub Form_Load() ' moveFormToCenter Me, 3000, 2000 '调整窗体大小并居中 'End Sub
Option Compare Database Option Explicit
Type RECT x1 As Long y1 As Long x2 As Long y2 As Long End Type
Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'菜单栏高:22 '工具栏高:26 '状态栏高:20
Public Function moveFormToCenter(ByRef Frm As Form, Optional ByVal longFormWidth As Long = 0, Optional ByVal longFormHeight As Long = 0)
Dim lngW, lngH As Long
lngW = GetaccessClientWidth() - 4 '-4为测试微调值 lngW = lngW * 15
lngH = GetaccessClientHeight() - 4 '-4为测试微调值 'lngH = lngH - (22 * 1) '一个菜单栏 lngH = lngH - (26 * 1) '一个工具栏 'lngH = lngH - (20 * 1) '一个状态栏 lngH = lngH * 15
If longFormWidth + longFormHeight = 0 Then Frm.Move (lngW - Frm.WindowWidth) / 2, (lngH - Frm.WindowHeight) / 2 End If
If longFormWidth > 0 And longFormHeight > 0 Then Frm.Move (lngW - longFormWidth) / 2, (lngH - longFormHeight) / 2, longFormWidth, longFormHeight End If
End Function
Public Function GetaccessClientWidth() As Integer Dim R As RECT Dim hwnd As Long Dim RetVal As Long
hwnd = Application.hWndaccessApp
RetVal = GetClientRect(hwnd, R) 'Debug.Print R.x2 'Debug.Print R.x1 GetaccessClientWidth = R.x2 - R.x1
End Function Public Function GetaccessClientHeight() As Integer Dim R As RECT Dim hwnd As Long Dim RetVal As Long
hwnd = Application.hWndaccessApp
RetVal = GetClientRect(hwnd, R) 'Debug.Print R.y2 'Debug.Print R.y1 GetaccessClientHeight = R.y2 - R.y1
End Function
|