MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Centrar formulário

    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7780
    Registrado : 05/11/2009

    Centrar formulário Empty Centrar formulário

    Mensagem  Alexandre Neves em 10/3/2014, 19:22

    Em ajuda ao membro lusouza, indiquei o código seguinte para centrar o formulário:

    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function GetWindowRect Lib "user32" _
    (ByVal hwnd As Long, lpRect As RECT) As Long
    Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
    ByVal hdc As Long) As Long
    Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
    ByVal nIndex As Long) As Long
    Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type
    Public Const WU_LOGPIXELSX = 88
    Public Const WU_LOGPIXELSY = 90
    Public Function TwipsPerPixel(strDirection As String) As Long
    'Purpose : Get monitor's Twips per pixel
    'Handle to device
    Dim lngDC As Long
    Dim lngPixelsPerInch As Long
    Const nTwipsPerInch = 1440
    lngDC = GetDC(0)
    If strDirection = "X" Then 'Horizontal
    lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
    Else 'Vertical
    lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
    End If
    lngDC = ReleaseDC(0, lngDC)
    TwipsPerPixel = nTwipsPerInch / lngPixelsPerInch
    End Function
    Public Sub WindowSize(ByRef Height As Long, ByRef Width As Long)
    'Purpose : Get Access window size.
    Dim hwnd As Long
    Dim rct As RECT
    hwnd = FindWindow(vbNullString, "Microsoft Access")
    If hwnd <> 0 And GetWindowRect(hwnd, rct) <> 0 Then
    Height = (rct.Bottom - rct.Top) * TwipsPerPixel("Y")
    Width = (rct.Right - rct.Left) * TwipsPerPixel("X")
    End If
    End Sub
    Public Function CenterMe(frm As Form)
    'Purpose : Center form on screen.
    'Requires :
    ' Code
    ' TwipsPerPixel()
    ' WindowSize()
    ' Type RECT
    ' API Libraries
    ' FindWindow
    ' GetWindowRect
    ' GetDC
    ' ReleaseDC
    ' GetDeviceCaps
    Dim lngWinWidth As Long
    Dim lngWinHeight As Long
    Dim lngFrmWidth As Long
    Dim lngFrmHeight As Long

    Call WindowSize(lngWinHeight, lngWinWidth)
    frm.SetFocus

    DoCmd.MoveSize (lngWinWidth - frm.WindowWidth) \ 2, _
    (lngWinHeight - frm.WindowHeight) \ 2

    End Function

    No formulário, coloca
    CenterMe (Me)


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

      Data/hora atual: 29/11/2020, 19:57