TopPicLogo TopPicText

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

'Мгновенное выравнивание формы по центру
'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
Назад ToTop
L.E. 22.11.2017
Рейтинг@Mail.ru