Inicio > Microsoft Access > Quitar las barras de título de los formulario

Quitar las barras de título de los formulario

'Crea un módulo nuevo y pega este código. Nombre: basQuitarBarraTitulos

Option Compare Database
Option Explicit

Const NombreModulo = "basFormGlobal"

' Store rectangle coordinates.
Type adhTypeRect
    X1 As Long
    Y1 As Long
    x2 As Long
    Y2 As Long
End Type

Declare Function adh_apiIsIconic Lib "user32" _
        Alias "IsIconic" (ByVal hWnd As Long) As Long

Declare Function adh_apiGetDeviceCaps Lib "gdi32" _
        Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Declare Function adh_apiGetWindowRect Lib "user32" _
        Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As adhTypeRect) As Long

Declare Function adh_apiGetParent Lib "user32" _
        Alias "GetParent" (ByVal hWnd As Long) As Long

Declare Function adh_apiGetClientRect Lib "user32" _
        Alias "GetClientRect" (ByVal hWnd As Long, lpRect As adhTypeRect) As Long

Declare Function adh_apiGetWindowLong Lib "user32" _
        Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Declare Function adh_apiGetSystemMetrics Lib "user32" _
        Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Declare Function adh_apiGetActiveWindow Lib "user32" _
        Alias "GetActiveWindow" () As Long

'=======================================================================

' Store group/subform dimensions.
Type adhTypeDimensions
    sglLeft As Double
    sglTop As Double
    sglWidth As Double
    sglHeight As Double
    strCtlName As String
End Type

' These are the class names used in Access.
Public Const adhcAccessClass = "OMain"
Public Const adhcMDIClientClass = "MDICLIENT"
Public Const adhcAccessDBCClass = "ODb"
Public Const adhcAccessFormClass = "OForm"

' Windows API declarations.
Declare Function adh_apiCreateIC Lib "gdi32" _
        Alias "CreateICA" (ByVal lpDriverName As String, _
        ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long

Declare Function adh_apiDeleteDC Lib "gdi32" _
        Alias "DeleteDC" (ByVal hdc As Long) As Long

Declare Function adh_apiMoveWindow Lib "user32" _
        Alias "MoveWindow" (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

Declare Function adh_apiSetWindowLong Lib "user32" _
        Alias "SetWindowLongA" (ByVal hWnd As Long, _
        ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function adh_apiGetWindow Lib "user32" _
        Alias "GetWindow" (ByVal hWnd As Long, ByVal wCmd As Long) As Long

Declare Function adh_apiGetClassName Lib "user32" _
        Alias "GetClassNameA" (ByVal hWnd As Long, _
        ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Declare Function adh_apiFindWindow Lib "user32" _
        Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long

Declare Function adh_apiGetNextWindow Lib "user32" _
        Alias "GetNextWindow" (ByVal hWnd As Long, ByVal wFlag As Long) As Long

Declare Function adh_apiSetFocus Lib "user32" _
        Alias "SetFocus" (ByVal hWnd As Long) As Long

' Get a string from a private INI file.  Returns the number of bytes
' copied into strReturned, not including the trailing null.
Declare Function adh_apiGetPrivateProfileString Lib "kernel32" _
        Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As String, ByVal lpDefault As String, _
        ByVal lpReturnedString As String, ByVal nSize As Long, _
        ByVal lpFileName As String) As Long

' Write a string to a private INI file.  Returns a non-zero value if successful,
' otherwise it returns a 0.
Declare Function adh_apiWritePrivateProfileString Lib "kernel32" _
        Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As String, ByVal lpString As String, _
        ByVal lpFileName As String) As Long

' These functions aren't actually used
' but are provided here for reference only.

' Get a string from WIN.INI. Returns the number of bytes copied into strReturned,
' not including the trailing null.
Declare Function adh_apiGetProfileString Lib "kernel32" _
        Alias "GetProfileStringA" (ByVal lpadhcAppName As String, _
        ByVal lpKeyName As String, ByVal lpDefault As String, _
        ByVal lpReturnedString As String, ByVal nSize As Long) As Long

' Get an integer from WIN.INI.  Returns either the integer it found,
' or the value sent in intDefault.
Declare Function adh_apiGetProfileInt Lib "kernel32" _
        Alias "GetProfileIntA" (ByVal lpadhcAppName As String, _
        ByVal lpKeyName As String, ByVal nDefault As Long) As Long

' Write a string to WIN.INI.  Returns a non-zero value if successful,
' otherwise it returns a 0.
Declare Function WriteProfileString Lib "kernel32" _
        Alias "WriteProfileStringA" (ByVal lpszSection As String, _
        ByVal lpszKeyName As String, ByVal lpszString As String) As Long

' Get an integer from a private INI file. Returns either the integer it found,
' or the value sent in intDefault.
Declare Function GetPrivateProfileInt Lib "kernel32" _
        Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As String, ByVal nDefault As Long, _
        ByVal lpFileName As String) As Long

' GetNextWindow() constants
Public Const adhcGW_CHILD = 5
Public Const adhcGW_HWNDNEXT = 2

' Windows API Constants
Public Const adhcVERTRES = 10
Public Const adhcHORZRES = 8
Public Const adhcLOGPIXELSX = 88
Public Const adhcLOGPIXELSY = 90

' General Constants
Public Const adhcTwipsPerInch = 1440

' GetWindowLong Constant
Public Const adhcGWL_STYLE = -16

' Windows Style constant
Public Const adhcWS_CAPTION = &HC00000

' System Metrics Constant
Public Const adhcSM_CYCAPTION = 4
Public Const adhcSM_CXFULLSCREEN = 16
Public Const adhcSM_CYFULLSCREEN = 17

'Para quitar la barra de título de de cualquier formulario.
'En el evento, "Al abrir el formulario" : Call adhRemoveCaptionBar(Me)

Function adhRemoveCaptionBar(Frm As Form)
On Error GoTo Err_adhRemoveCaptionBar
    adhRemoveWindowCaptionBar Frm.hWnd
    Exit Function
Err_adhRemoveCaptionBar:
    MsgBox Err.Description
End Function

Sub adhRemoveWindowCaptionBar(ByVal hWnd As Long)
On Error GoTo Err_adhRemoveWindowCaptionBar

    Dim lngOldStyle As Long
    Dim lngNewStyle As Long
    Dim rct As adhTypeRect
    Dim intDX As Integer, intDY As Integer

    ' Get the current window style of the form.
    lngOldStyle = adh_apiGetWindowLong(hWnd, adhcGWL_STYLE)

    ' Turn off the bit that enables the caption.
    lngNewStyle = lngOldStyle And Not adhcWS_CAPTION

    ' Set the new window style.
    lngOldStyle = adh_apiSetWindowLong(hWnd, adhcGWL_STYLE, lngNewStyle)

    ' The caption's been removed, but now resize
    ' the whole window to match the size of the interior.

    ' Get the current size, including the caption.
    adh_apiGetWindowRect hWnd, rct

    ' Calculate the new width and height.

'    intDX = 648
'    intDY = 466

    intDX = rct.x2 - rct.X1
    intDY = rct.Y2 - rct.Y1 - _
     adh_apiGetSystemMetrics(adhcSM_CYCAPTION)

    ' Move the window to the same left and top,
    ' but with new width and height.
    ' This will make the new form appear
    ' a little lower than the original.
    Call adh_apiMoveWindow(hWnd, rct.X1, _
     rct.Y1, intDX, intDY, True)
    Exit Sub
Err_adhRemoveWindowCaptionBar:
    MsgBox Err.Description
End Sub

Sub RemoveAccessCaptionBar()
On Error GoTo Err_RemoveAccessCaptionBar
    ' Not terribly useful, but this procedure will remove the
    ' main Access caption bar!
    Call adhRemoveWindowCaptionBar2(Application.hWndAccessApp)
    Exit Sub
Err_RemoveAccessCaptionBar:
    MsgBox Err.Description
End Sub

Sub adhRemoveWindowCaptionBar2(ByVal hWnd As Long)
On Error GoTo Err_adhRemoveWindowCaptionBar

    Dim lngOldStyle As Long
    Dim lngNewStyle As Long
    Dim rct As adhTypeRect
    Dim intDX As Integer, intDY As Integer

    ' Get the current window style of the form.
    lngOldStyle = adh_apiGetWindowLong(hWnd, adhcGWL_STYLE)

    ' Turn off the bit that enables the caption.
    lngNewStyle = lngOldStyle And Not adhcWS_CAPTION

    ' Set the new window style.
    lngOldStyle = adh_apiSetWindowLong(hWnd, adhcGWL_STYLE, lngNewStyle)

    ' The caption's been removed, but now resize
    ' the whole window to match the size of the interior.

    ' Get the current size, including the caption.
    adh_apiGetWindowRect hWnd, rct

    ' Calculate the new width and height.
    intDX = rct.x2 - rct.X1
    intDY = rct.Y2 - rct.Y1 - _
     adh_apiGetSystemMetrics(adhcSM_CYCAPTION)

    ' Move the window to the same left and top,
    ' but with new width and height.
    ' This will make the new form appear
    ' a little lower than the original.
    Call adh_apiMoveWindow(hWnd, rct.X1, _
     rct.Y1, intDX, intDY + 20, True)
    Exit Sub
Err_adhRemoveWindowCaptionBar:
    MsgBox Err.Description
End Sub
Categorías:Microsoft Access
  1. Aún no hay comentarios.
  1. Aún no hay trackbacks