|
|
Utilidades : MsgBoxEx (nuevo - compatible con VB)
| Autor/es:
Juan M Afán de Ribera | | Pregunta : ¿Es posible hacer que un MsgBox muestre iconos diferentes de los que lleva por defecto? ¿Se puede poner un icono en la barra de título? ¿Y personalizar los textos que aparecen en los botones? | Respuesta : En principio no se puede hacer, con las herramientas nativas de Visual Basic, pero sí que podemos hacerlo si utilizamos el API de Windows.
La función MsgBoxEx está ideada para poder mostrar un MsgBox con iconos personalizados en la barra de título, iconos o cursores animados en la ventana cliente y posibilidad de cambiar los textos de los botones.
Esta función tiene los siguientes | Argumentos | Argumento | Descripción | | Cinco primeros argumentos | Los cinco primeros argumentos de la función MsgBoxEx son idénticos a los que aparecen en la función MsgBox. Para más detalles sobre su descripción y uso, consultar la ayuda de VBA para Access | | IconBar | Opcional. Nombre y ruta completa del archivo de icono (*.ico) que aparecerá en la barra de título del MsgBox | | IconWindow | Opcional. Nombre y ruta completa del archivo de icono (*.ico) o cursor animado (*.ani) que aparecerá en la ventana cliente (la parte del MsgBox donde normalmente aparece el icono) | | BrOk | Opcional. Texto del botón Aceptar del MsgBox | | BtCancel | Opcional. Texto del botón Cancelar del MsgBox | | BtAbort | Opcional. Texto del botón Anular del MsgBox | | BrRetry | Opcional. Texto del botón Reintentar del MsgBox | | BtIgnore | Opcional. Texto del botón Ignorar del MsgBox | | BtYes | Opcional. Texto del botón Sí del MsgBox | | BtNo | Opcional. Texto del botón No del MsgBox |
| Ejemplo de uso:
El siguiente ejemplo mostrará un MsgBox personalizado, con el icono "libro.ico" en la barra de título y el cursor animado "metronom.ani" en la ventana cliente | Call MsgBoxEx( _
"Ejemplo del MsgBoxEx", , _
"MsgBoxEx", , , _
"C:\libro.ico", _
"C:\metronom.ani")
| Los usuarios de Access 97 deberán utilizar el código que aparece en el ejemplo MsgBoxEx97 (sección Ejemplos, más abajo en esta misma página)
A raiz de algunas peticiones y sugerencias, he cambiado algunos detalles del código para que también pueda ser utilizado en el entorno de VB
Pegar este código en un módulo estandar | '---------------------------------------------------------
'
' MsgBoxEx
'
' Código escrito originalmente por Juan M Afán de Ribera.
' Estás autorizado a utilizarlo dentro de una aplicación
' siempre que esta nota de autor permanezca inalterada.
' En el caso de querer publicarlo en una página Web,
' por favor, contactar con el autor en
'
' accessvbafaq@ya.com
'
' Este código se brinda por cortesía de
' Juan M. Afán de Ribera
'
'
' Función que establece el texto de una ventana
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
' Función que devuelve el manipulador de una ventana
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
' Función que devuelve el nombre de clase de una ventana
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
' Función que devuelve el ID del control de un cuadro de diálogo
Private Declare Function GetDlgCtrlID Lib "user32" _
(ByVal hwnd As Long) As Long
' Función que envía un mensaje al control de un cuadro de diálogo
Private Declare Function SendDlgItemMessage Lib "user32" _
Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Any) As Long
' Función que devuelve el manipulador de una imagen
Private Declare 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
' Función que envía un mensaje a una ventana
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
' Función que devuelve el manipulador de la ventana activa en ese momento
Private Declare Function GetForegroundWindow Lib "user32" () As Long
' Función que devuelve información de una ventana
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
' Función que crea un Timer de sistema
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
' Función que destruye un timer de sistema
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
' constante para escribir un texto
Private Const WM_SETTEXT = &HC
' constante para establecer un icono
Private Const WM_SETICON = &H80
' constante para establecer la imagen de un control Static
Private Const STM_SETIMAGE = &H172
' constante que indica que se llama a una imagen tipo icono
Private Const IMAGE_ICON = 1
' constante que indica que la imagen proviene de un fichero
Private Const LR_LOADFROMFILE = &H10
' constante para llamar a una ventana hija
Private Const GW_CHILD = 5&
' constante para llamar a la siguiente ventana
Private Const GW_HWNDNEXT = 2&
' constante de estilo para poder contener un icono
Private Const SS_ICON = &H3&
' constante para devolver información del estilo de una ventana
Private Const GWL_STYLE = (-16)
' variables globales de MsgBoxEx
Private hMsgBox As Long
Private hIconWindow As Long
Private hIconBar As Long
Private Title2 As String
Private ButtonsText(1 To 7) As String
Private Tm As Long
Public Function MsgBoxEx( _
Prompt, _
Optional buttons As VbMsgBoxStyle = vbOKOnly, _
Optional Title, _
Optional HelpFile, _
Optional Context, _
Optional IconBar As String, _
Optional IconWindow As String, _
Optional BtOk As String, _
Optional BtCancel As String, _
Optional BtAbort As String, _
Optional BtRetry As String, _
Optional BtIgnore As String, _
Optional BtYes As String, _
Optional BtNo As String) As VbMsgBoxResult
If hMsgBox = 0 Then
ButtonsText(1) = BtOk ' Texto botón Ok - IDControl = vbOk = 1
ButtonsText(2) = BtCancel ' Texto botón Cancelar/Aceptar - IDControl = vbCancel = 2
ButtonsText(3) = BtAbort ' Texto botón Anular - IDControl = vbAbort = 3
ButtonsText(4) = BtRetry ' Texto botón Reintentar - IDControl = vbRetry = 4
ButtonsText(5) = BtIgnore ' Texto botón Ignorar - IDControl = vbIgnore = 5
ButtonsText(6) = BtYes ' Texto botón Sí - IDControl = vbYes = 6
ButtonsText(7) = BtNo ' Texto botón No - IDControl = vbNo = 7
' si se ha indicado un icono para la barra de título
If IconBar <> "" Then
' se obtiene un manipulador de la imagen
hIconBar = hIcon(IconBar, 16&)
' añadimos unos cuantos blancos para hacer sitio
' en la barra de título para el icono, pues el
' MsgBox no está originalmente preparado para ello
Title2 = Title
Title = Title & String(6, Chr(32))
Else
' si no, ponemos posibles valores anteriores de hIconBar a 0
hIconBar = 0
End If
' necesitamos comprobar que se puede cargar la imagen
' correspondiente a la ventana cliente del MsgBox, para
' configurar el espacio correspondiente al icono. Si la
' ruta fuera incorrecta y no se comprobara, quedaría un
' espacio en blanco correspondiente al control Static
' que contiene estos iconos.
If IconWindow <> "" Then
hIconWindow = hIcon(IconWindow, 32&)
' si se ha podido cargar la imagen, anulamos cualquier
' llamada del usuario a los iconos de mensaje
' predeterminados ...
If hIconWindow Then
If (buttons And vbCritical) = vbCritical Then
buttons = buttons - vbCritical
ElseIf (buttons And vbExclamation) = vbExclamation Then
buttons = buttons - vbExclamation
ElseIf (buttons And vbInformation) = vbInformation Then
buttons = buttons - vbInformation
ElseIf (buttons And vbQuestion) = vbQuestion Then
buttons = buttons - vbQuestion
End If
' y ponemos nosotros uno cualquiera de ellos.
' De esta manera aseguramos que existirá un control
' Static para contener nuestro icono/imagen personalizado.
buttons = buttons + vbCritical
End If
Else
hIconWindow = 0
End If
' Creamos un timer que se ejecutará a la décima de segundo
Tm = SetTimer(0&, 0&, 10, AddressOf TimerProc)
' llamamos al MsgBox de manera normal
On Error GoTo AnularTimer
' llamamos al MsgBox de VBA con los parámetros normales
MsgBoxEx = MsgBox(Prompt, buttons, Title, HelpFile, Context)
End If
Exit Function
AnularTimer:
' si ha habido algún error, se cancela la operación
Call KillTimer(0&, Tm)
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
End Function
' Esta función se ejecutará una décima de segundo después de llamar
' al MsgBox (en modo asíncrono) y "capturará" el cuadro de diálogo
' y sus controles para poder manipularlos
'
Private Sub TimerProc( _
ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
Dim cnt As Long
' capturamos el manipulador del MsgBox
hMsgBox = GetForegroundWindow
' si se ha indicado un icono para la barra de título
If hIconBar Then
' se carga
Call SendMessage(hMsgBox, WM_SETICON, 0&, ByVal hIconBar)
Call SetWindowText(hMsgBox, Title2)
End If
' si se ha indicado un icono para la ventana de cliente
If hIconWindow Then
' se carga - CtrlId devolverá el ID del control que contiene el icono
Call SendDlgItemMessage(hMsgBox, CtrlId, STM_SETIMAGE, IMAGE_ICON, hIconWindow)
End If
' ponemos el texto a los botones (si lo hay)
For cnt = 1 To 7
' si se ha indicado un texto para alguno de los botones
If ButtonsText(cnt) <> "" Then
' se cambia su texto.
' cnt = número de ID de control de cada uno de los botones
' dentro del cuadro de diálogo
Call SendDlgItemMessage(hMsgBox, cnt, WM_SETTEXT, 0&, ButtonsText(cnt))
End If
Next
' anulamos el timer, ya que sólo se ejecutará una vez (de momento)
Call KillTimer(0&, Tm)
hMsgBox = 0
End Sub
' función que devuelve el manipulador de una imagen
' para este código me he basado en el ejemplo que amablemente proporciona
' Klaus Probst en http://www.mvps.org/access/api/api0043.htm
'
Function hIcon(IconPath As String, IconSize As Long) As Long
hIcon = LoadImage(0&, IconPath, IMAGE_ICON, IconSize, IconSize, LR_LOADFROMFILE)
End Function
' Esta función devuelve el ID del control Static que contiene los iconos
' de la ventana cliente del MsgBox.
' El ID de este control, junto con el ID del control Static que contiene
' el texto del MsgBox varía entre versiones, tanto de Access como del sistema
' operativo, así que he tenido que crear una función que lo localizara.
' Se le puede localizar, primero por el tipo de control (Static) y
' después por el estilo SS_ICON, que es un estilo (atributo) que permite al
' control contener un icono y expandirse según su tamaño
'
Function CtrlId() As Long
Dim buffer As String * 100
Dim hwnd As Long
Dim CurStyle As Long
' obtenemos la primera ventana hija del MsgBox
hwnd = GetWindow(hMsgBox, GW_CHILD)
Do While hwnd
' obtenemos el nombre de la clase de ventana
GetClassName hwnd, buffer, 100
' si es de la clase Static
If UCase(Left(buffer, 6)) = "STATIC" Then
CurStyle = GetWindowLong(hwnd, GWL_STYLE)
' si tiene el estilo SS_ICON
If (CurStyle And SS_ICON) = SS_ICON Then
' obtenemos el número de ID del control
CtrlId = GetDlgCtrlID(hwnd)
Exit Function
End If
End If
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
End Function
'---------------------------------------------------------
| Ejemplos: MsgBoxEx Access 2000 o superior MsgBoxEx97 Access 97 | Temas relacionados: InputBoxEx (nuevo - compatible con VB) |
|
