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