Ejemplos usando el Api de windows para Visual basic

32 - Crear un MsgBox con mas opciones, como agregarle imégenes en el mensaje e íconos en el título

Este código fue creado por Juan M. Afán de Ribera y le agradezco ya que me permitió colocarlo en esta sección. Si querés visitar su web :http://www.mvp-access.com/juanmafan

Nota: También podés ver este activex para usar msgbox personalizados : CoolMsgbox

Este ejemplo usa las siguientes funciones Api: SetWindowText, GetWindow, GetClassName, SendDlgItemMessage, LoadImage, SendMessage, GetWindowLong y SetTimer

Una previa del MsgBoxEx

Ejemplo de un MsgBox con mas opciones que el clásico de Windows

Para llamar a la función que crea el Msgbox se utiliza la función MsgBoxEx con los siguientes parámetros:

MsgBoxEx "Hola Gente", vbQuestion, "Ejemplo de un MsgBoxEx", , , App.Path & "\1.ico", App.Path & "\1.ani"

Donde el primer parámetro es el Mensaje, el segundo es opcional y si no se muestran gráficos se visualiza un MsgBox común de vb. El tercero es el título. El cuarto y quinto no son importantes y son opcionales. El 6 y 7 son el archivo de ícono del título y el gif animado o mapa de bits estático para el mensaje.

En un formulario:

'Función Api ShellExecute Private Declare Function ShellExecute _ Lib "shell32.dll" _ Alias "ShellExecuteA" ( _ ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long Private Sub Form_Load() 'Llamamos a la función MsgBoxEx "Hola Gente", _ vbQuestion, _ "Ejemplo de un MsgBoxEx", , , _ App.Path & "\1.ico", App.Path & "\1.ani" End Sub

Colocar en un módulo de código .bas

' 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

Recursos Visual basic - Enlaces relacionados

Buscar en Recursos vb