Мгновенное выравнивание формы по центру

'Мгновенное выравнивание формы по центру

'Form.PopUp Property = True !!! (or Modal = True)

'--------------------------------------------------------------------------

'По материалам: http://www.cyberforum.ru/ms-access/thread2140997.html

'--------------------------------------------------------------------------

Private x As Long, Y As Long

Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long

Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As Long

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hwndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, _

ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const SM_CXSCREEN = 0, SM_CYSCREEN = 1

Private Const TwipsPerInch = 1440

Private Const LOGPIXELSY = 90

Private Const LOGPIXELSX = 88

Private Const SWP_NOSIZE = &H1

Private Sub Form_Load()

hidde_on 'Скрытие окна приложения

End Sub

Private Sub Form_Open(Cancel As Integer)

Dim x&, Y&, Z&

x = (GetSystemMetrics(SM_CXSCREEN)) / 2 - (Me.WindowWidth / (TwipsPerInch / apiGetDeviceCaps(apiGetDC(0&), LOGPIXELSX))) / 2

Y = (GetSystemMetrics(SM_CYSCREEN)) / 2 - (Me.WindowHeight / (TwipsPerInch / apiGetDeviceCaps(apiGetDC(0&), LOGPIXELSX))) / 2

Z = SetWindowPos(Me.hWnd, 0, x, Y, 0, 0, SWP_NOSIZE)

End Sub