Al abrir el formulario principal pones este evento.
Private Sub Form_Open(Cancel As Integer)
Dim txtFichero As String
txtFichero = "C:\CARAME\GESPER\logomini.gif"
Call MdiImage(txtFichero)
End Sub
*** Esto "C:\CARAME\GESPER\logomini.gif" lo debes cambiar por el que tu quieras
-------------------------------------------------------------------------------------------------
ESTO QUE SIGUE SON DOS MODULOS NECESARIOS PARA EJECUTAR LA LLAMADA Call MdiImage(txtFichero) (No te comas el coco para comprenderlos)
PRIMER MODULO
Option Compare Database
Option Explicit
' -------------------------------------------------------------
'
' MdiImage
'
' Procedimiento para colocar una imagen en la ventana de fondo
' de Access.
'
' Este código está basado en el que aparece en la base de datos
' de ejemplo de Stephen Lebans ChangeMdiBackground
' http://www.lebans.com
'
' La diferencia es que he utilizado un objeto StdPicture para
' cargar la imagen y tener acceso a su handle, ahorrando todo
' un módulo de clase de código.
'
'
Sub MdiImage(FileName As String)
Dim REC As RECT
Dim hMdi As Long
Dim hBrush As Long, hPrevBrush As Long
Dim oPic As Object ' olestd.StdPicture
hMdi = GetMdiHandle
Set oPic = LoadPicture(FileName)
hBrush = CreatePatternBrush(oPic.Handle)
hPrevBrush = SetClassLong(hMdi, GCL_HBRBACKGROUND, hBrush)
Call GetClientRect(hMdi, REC)
Call InvalidateRect(hMdi, REC, 1&)
Call DeleteObject(hPrevBrush)
Set oPic = Nothing
End Sub
' función que devuelve el handle de la ventan interior de Access
Private Function GetMdiHandle() As Long
GetMdiHandle = FindWindowEx(hWndAccessApp, 0&, "MDIClient", vbNullString)
End Function
' procedimiento para colocar los respectivos valores en la
' estructura TRIVERTEX
Sub FillVertex(tVert As TRIVERTEX, cColor As Long, vWidth As Long, vHeight As Long)
Dim bColor(0 To 2) As Byte
Dim iColor(0 To 2) As Integer
Dim I As Integer
Call CopyMemory(bColor(0), cColor, 3)
For I = 0 To 2
If bColor(I) > &H7F Then
iColor(I) = (bColor(I) * &H100&) - &H10000
Else
iColor(I) = bColor(I) * &H100&
End If
Next
With tVert
tVert.X = vWidth
tVert.Y = vHeight
tVert.Red = iColor(0)
tVert.Green = iColor(1)
tVert.Blue = iColor(2)
tVert.Alpha = 1
End With
End Sub
SEGUNDO MODULO (VARIABLES)
Option Compare Database
Option Explicit
'---------------------------------------------------------------
' Estructuras
'
Type RECT
' Left As Long
' Top As Long
' Right As Long
' Bottom As Long
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type
Type TRIVERTEX
X As Long
Y As Long
Red As Integer
Green As Integer
Blue As Integer
Alpha As Integer
End Type
Type GRADIENT_RECT
UpperLeft As Long
LowerRight As Long
End Type
Type tCHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
'--------------------------------------------------------
' Funciones del API de Windows
'
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As tCHOOSECOLOR) As Long
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDc As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hDc As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject As Long) As Long
Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Declare Function GradientFill Lib "msimg32" (ByVal hDc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
' ------------------------------------------------------------------------
' Constantes
'
Public Const GCL_HBRBACKGROUND = &HFFF6
Public Const COLOR_APPWORKSPACE = &HC
Public Const GRADIENT_FILL_RECT_H = &H0
Public Const GRADIENT_FILL_RECT_V = &H1
Public Const GRADIENT_FILL_TRIANGLE = &H2
Public Const GRADIENT_FILL_OP_FLAG = &HFF
Public Const GWL_HINSTANCE = &HFFFA
'-------------------------------------------------------------------------
