Access - EFECTO AL ABRIR UN FORMULARIO

Pos: 96

Val: 28

EFECTO AL ABRIR UN FORMULARIO

Publicado por Jefferson (382 intervenciones) el 16/07/2009 04:26:47

Con este codigo puedes crear un Efecto al Abrir un Formulario o Informe y asi le das un toque mas personal a tu Aplicacion

Option Compare Database
Option Explicit
'***************************************************************
'& &*
'& &*
'& &*
'& &*
'& Jefferson Jimenez (JJJT) &*
'& Cabimas - Venezuela &*
'& Julio - 2009 &*
'& &*
'& &*
'& &*
'& &*
'& &*
'***************************************************************
'Como hacer para que al abrir y al cerrar nuestros form parezcan desvanecerse
'Primero declaramos las Constantes de Efecto
Const Transp = &H2
Const Oculto = &H10000
Const Efecto = &H80000
'Establezco el color del Formulario
Const Color As Long = 12632256
'Establezco la Transparencia del Formulario
Const EfecTrans As Long = 220
'Declaro las funciones del API de Windows
Declare Function JJJTAnimar Lib "user32" Alias "AnimateWindow" _
(ByVal hwnd As Long, _
ByVal dwTime As Long, _
ByVal dwFlags As Long) _
As Long
Declare Function Ventana_JJJT Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) _
As Long
Declare Function TranVen_JJJT Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
Declare Function Accion_JJJT Lib "user32" Alias "SetLayeredWindowAttributes" _
(ByVal hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) _
As Long
'Creo la Funcion del efecto al abrir
'El Formulario debe tener la Opcion Emergente = Si
Function JJJT_EfectoOpen(frm As Form)
JJJTAnimar frm.hwnd, 200, Efecto
frm.Section(0).BackColor = Color
frm.Modal = True
frm.ShortcutMenu = True
End Function
'Creo la Funcion al cerrar
Function JJJT_EfectoClose(frm As Form)
JJJTAnimar frm.hwnd, 500, Oculto Or Efecto
End Function
'Creo la Funcion Transparencia
Function JJJT_Transparencia(frm As Form)
TranVen_JJJT frm.hwnd, (-20), _
Ventana_JJJT(frm.hwnd, (-20)) _
Or &H80000
Accion_JJJT frm.hwnd, 0, _
EfecTrans, Transp
End Function
'Creo la Funcion Normal
Function JJJT_Normal(frm As Form)
TranVen_JJJT frm.hwnd, (-20), _
Ventana_JJJT(frm.hwnd, (-20)) _
Or &H80000
Accion_JJJT frm.hwnd, 0, _
255, Transp
End Function
'Creo la Funcion CierroTransp
Function JJJT_CierroTransp(frm As Form)
TranVen_JJJT frm.hwnd, (-20), _
Ventana_JJJT(frm.hwnd, (-20)) _
Or &H80000
Accion_JJJT frm.hwnd, 0, _
(EfecTrans - 120), Transp
JJJTAnimar frm.hwnd, 300, _
Efecto Or Oculto
End Function

Para descargar el Ejemplo desde la Direccion URL
Desde Venezuela
Jefferson

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

-1

Responder

Pos: 66

Val: 37

RE:EFECTO AL ABRIR UN FORMULARIO

Publicado por Enrique Ramírez (629 intervenciones) el 21/07/2009 15:34:17

Hola Jefferson, puse tu codigo en un formulario y no crea ningun efecto mas sin embargo si hago clic incluso en el boton salir me marca :
La expresion al hacer clic que introdujo como valor de la propiedad de evento produjo un error.....etc.
me hara falta alguna referencia? o sera la version del access pues utilizo 2002

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

RE:EFECTO AL ABRIR UN FORMULARIO

Publicado por Jefferson (4 intervenciones) el 21/07/2009 16:17:32

Debes colocar el formulario en Emergente y Modal,
En Modal lo hago por codigo VBA
En Emergente todavia no he logrado hacerlo por codigo VBA (Si lo conoces me avisas)

De todas maneras en la Direccion URL hay un ejemplo de como usarlo....

Un Saludo Amigo
Desde Venezuela
Jefferson

Valora esta respuesta

-1

Comentar

Pos: 66

Val: 37

RE:EFECTO AL ABRIR UN FORMULARIO

Publicado por Enrique Ramírez (629 intervenciones) el 21/07/2009 18:17:28

ya funciona si veo la diferencia pero si el efecto fuera un poco mas lento se notaria mas, como quiera gracias por los tips.

Valora esta respuesta

Comentar

RE:EFECTO AL ABRIR UN FORMULARIO

Publicado por Jefferson (2 intervenciones) el 21/07/2009 19:36:16

en la funcion

Function JJJT_EfectoOpen(frm As Form)
JJJTAnimar frm.hwnd, 200, Efecto
frm.Section(0).BackColor = Color
frm.Modal = True
frm.ShortcutMenu = True
End Function

le puedes colocar el Tiempo,,,,,,,!

Gracias Enrique
Desde Venezuela
Jefferson

Valora esta respuesta

-1

Comentar

Pos: 84

Val: 29

excelente codigo me funciona a la perfeccion

Publicado por JUAN MUÑOZ (50 intervenciones) el 05/07/2018 04:50:47

el código funciona excelente gracias por aportar esos detalles, me causa curiosidad que el tiempo de apertura y cierre no se ve reflejado cuando le cambio los valores a la velocidad,

una pregunta adicional y es que estoy buscando la manera que cuando abra una aplicación hecha en access, es que no se muestre la ventana cuando esta cargando access ese que dice cargando access y también se ve el fondo de el desarrollo antes de iniciar mi formulario . hay alguna manera de evitar eso?.......

Valora esta respuesta

Comentar

excelente codigo me funciona a la perfeccion

Publicado por carlos rosado (3 intervenciones) el 07/05/2021 23:16:52

Llegue algo tarde a responder.

A continuación les comparto el siguiente código, el cual permite ocultar el entorno de access, crearle un icono a cada formulario, ocultar la vista en miniatura de la aplicación y mostrar el formulario en la barra de tareas. Adicional, les comparto un script para abrir en otra instancia tu aplicación, lo cual evitara que se vea la ventana de cargando. disfrútenlo porque me costo mucho conseguirlo.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

Option Compare Database

Public Declare PtrSafe Function SetWindowPos _

Lib "user32" ( _

ByVal hwnd As LongPtr, _

ByVal hwndInsertAfter As LongPtr, _

ByVal X As Long, ByVal Y As Long, _

ByVal cx As Long, ByVal cy As Long, _

ByVal wFlags As Long) _

As Long

Public Const SWP_NOSIZE = &H1

Public Const SWP_NOMOVE = &H2

Public Const HWND_TOPMOST = -1

Public Const HWND_NOTOPMOST = -2

Declare PtrSafe Function BuscarIcono Lib "shell32.dll" Alias "ExtractIconA" ( _

ByVal Instala As Long, ByVal ArchivoICO As String, ByVal Indice As Long) As Long

Declare PtrSafe Function BuscaVentana Lib "user32" Alias "FindWindowA" ( _

ByVal Clase As String, ByVal Nombre As String) As Long

Declare PtrSafe Function MandaMensaje Lib "user32" Alias "SendMessageA" ( _

ByVal Ventana As Long, ByVal mensaje As Long, ByVal ParV As Integer, ByVal ParL As Any) As Long

Declare PtrSafe Function ObtenerEstilo Lib "user32" Alias "GetWindowLongA" ( _

ByVal hwnd As Long, ByVal Indice As Long) As Long

Declare PtrSafe Function EstablecerEstilo Lib "user32" Alias "SetWindowLongA" ( _

ByVal hwnd As Long, ByVal Indice As Long, ByVal nuevoEstilo As Long) As Long

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

Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Const WS_MINIMIZEBOX As Long = &H20000

Public Const WS_MAXIMIZEBOX As Long = &H10000

Public Const GWL_STYLE As Long = (-16)

Public ruta As String, icono As Long, Ventana As Long, estilo As Long

Public lngMyHandle As Long, lngCurrentStyle As Long, lngNewStyle As Long

Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" _

(ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Const GWL_EXSTYLE = (-20)

Private Const WS_EX_LAYERED = &H80000

Private Const LWA_ALPHA = &H2

Declare PtrSafe Function GetSystemMenu Lib "user32" _

(ByVal hwnd As Long, ByVal bRevert As Long) As Long

Declare PtrSafe Function GetMenuItemCount Lib "user32" _

(ByVal hMenu As Long) As Long

Declare PtrSafe Function RemoveMenu Lib "user32" _

(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Const MF_BYPOSITION = &H400&

Const MF_REMOVE = &H1000&

Const SW_HIDE = 0

Const SW_NORMAL = 1

Const SW_MINIMIZED = 2

Const SW_MAXIMIZED = 3

Declare PtrSafe Function ShowWindow Lib "user32" _

  (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Public Declare PtrSafe Function LoadImage Lib "user32" _

Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, _

ByVal n2 As Long, ByVal un2 As Long) As Long

Public Declare PtrSafe Function SendMessage Lib "user32" _

Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const WM_GETICON = &H7F

Public Const WM_SETICON = &H80

Public Const ICON_SMALL = 0

Public Const ICON_BIG = 1

Public Const IMAGE_BITMAP = 0

Public Const IMAGE_ICON = 1

Public Const IMAGE_CURSOR = 2

Public Const IMAGE_ENHMETAFILE = 3

Public Const LR_DEFAULTCOLOR = &H0

Public Const LR_MONOCHROME = &H1

Public Const LR_COLOR = &H2

Public Const LR_COPYRETURNORG = &H4

Public Const LR_COPYDELETEORG = &H8

Public Const LR_LOADFROMFILE = &H10

Public Const LR_LOADTRANSPARENT = &H20

Public Const LR_DEFAULTSIZE = &H40

Public Const LR_LOADMAP3DCOLORS = &H1000

Public Const LR_CREATEDIBHeader = &H2000

Public Const LR_COPYFROMRESOURCE = &H4000

Public Const LR_SHARED = &H8000

Public Function SetFormIcon(hwnd As Long, IconPath As String) As Boolean

Dim hIcon As Long

hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)

If hIcon <> 0 Then

Call SendMessage(hwnd, WM_SETICON, 0, ByVal hIcon)

SetFormIcon = True

End If

End Function

Sub iniciar()

If Application.Version < 9 Then

    lngMyHandle = FindWindow("THUNDERXFRAME", Form_Log.Caption)

Else

    lngMyHandle = FindWindow("THUNDERDFRAME", Form_Log.Caption)

End If

lngCurrentStyle = GetWindowLong(lngMyHandle, GWL_STYLE)

lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX

SetWindowLong lngMyHandle, GWL_STYLE, lngNewStyle

End Sub

Sub botones()

ruta = "C:\Users\ico.ico"

icono = BuscarIcono(0, ruta, 0)

Ventana = BuscaVentana(vbNullString, Form_Log.Caption)

MandaMensaje Ventana, &H80, 1, icono

estilo = ObtenerEstilo(Ventana, -16)

EstablecerEstilo Ventana, -16, estilo

estilo = ObtenerEstilo(Ventana, -20) Or &H40000

EstablecerEstilo Ventana, -20, estilo

End Sub

Function OcultarVentanaAccess(Ocultar As Boolean) As Boolean

Dim lngHwnd As Long

Dim bytNivel As Byte

    lngHwnd = Application.hWndAccessApp

    bytNivel = IIf(Ocultar, 0, 255)

    SetWindowLong lngHwnd, GWL_EXSTYLE, GetWindowLong(lngHwnd, GWL_EXSTYLE) Or WS_EX_LAYERED

    SetLayeredWindowAttributes lngHwnd, 0, bytNivel, LWA_ALPHA

    OcultarVentanaAccess = True

End Function

En el evento load del formulario llaman a las siguientes funciones:

Call ShowWindow(hWndAccessApp, 0)

Call iniciar

Call botones

y para agregar un icono a cada formulario colocan en el evento current de cada formulario:

SetFormIcon hwnd, CurrentProject.Path & "\ico.ico"

El Script lo crean en un bloc de notas y lo guardan con extensión VBS

with createobject("access.application")

.opencurrentdatabase("C:\Users\tu base")

end with

Espero les sirva, estas funciones dejan tu aplicación creada en Access como cualquier otro programa desarrollado en otro lenguaje.

Saludos.

Valora esta respuesta

Comentar

Seleccion multiple (NOVATO)

if en informe