comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

Cambiar Iconos del MsgBox

  • 0 Respuestas
  • 1592 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Conectado ANTRAX

  • *
  • Administrator
  • Mensajes: 5401
  • Actividad:
    38.33%
  • Reputación 31
  • ANTRAX
    • Ver Perfil
    • Underc0de
    • Email
  • Skype: underc0de.org
  • Twitter: @Underc0de
« en: Julio 26, 2010, 03:51:38 pm »
MODULO:

Código: Visual Basic
  1. Option Explicit
  2. Private Const WH_CBT As Long = &H5
  3. Private Const HCBT_ACTIVATE As Long = &H5
  4. Private Const STM_SETICON As Long = &H170
  5. Private Const MODAL_WINDOW_CLASSNAME As String = "#32770"
  6. Private Const SS_ICON As Long = &H3
  7. Private Const WS_VISIBLE As Long = &H10000000
  8. Private Const WS_CHILD As Long = &H40000000
  9. Private Const SWP_NOSIZE As Long = &H1
  10. Private Const SWP_NOZORDER As Long = &H4
  11. Private Const STM_SETIMAGE As Long = &H172
  12. Private Const IMAGE_CURSOR As Long = &H2
  13. Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadID As Long) As Long
  14. Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal CodeNo As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  15. Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  16. Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  17. Private Declare Function GetCurrentThreadId Lib "KERNEL32" () As Long
  18. Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
  19. 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
  20. Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As Any) As Long
  21. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  22. Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  23. Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  24. Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Boolean
  25. Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
  26. Public Type ANICURSOR
  27.    m_hCursor As Long
  28.    m_hWnd As Long
  29. End Type
  30. Private pHook As Long
  31. Private phIcon As Long
  32. Private pAniIcon As String
  33. Public Function XMsgBox(ByVal Message As String, _
  34.                Optional ByVal MBoxStyle As VbMsgBoxStyle = vbOKOnly, _
  35.                Optional ByVal Title As String = "", _
  36.                Optional ByVal hIcon As Long = 0&, _
  37.                Optional ByVal AniIcon As String = "") As VbMsgBoxResult
  38.    pHook = SetWindowsHookEx(WH_CBT, _
  39.           AddressOf MsgBoxHookProc, _
  40.                      App.hInstance, _
  41.                  GetCurrentThreadId())
  42.    phIcon = hIcon
  43.    pAniIcon = AniIcon
  44.    If Len(AniIcon) <> 0 Or phIcon <> 0 Then
  45.       MBoxStyle = MBoxStyle And Not (vbCritical)
  46.       MBoxStyle = MBoxStyle And Not (vbExclamation)
  47.       MBoxStyle = MBoxStyle And Not (vbQuestion)
  48.       MBoxStyle = MBoxStyle Or vbInformation
  49.    End If
  50.    XMsgBox = MsgBox(Message, MBoxStyle, Title)
  51. End Function
  52. Private Function MsgBoxHookProc(ByVal CodeNo As Long, _
  53.                                 ByVal wParam As Long, _
  54.                                 ByVal lParam As Long) As Long
  55.    Dim ClassNameSize As Long
  56.    Dim sClassName As String
  57.    Dim hIconWnd As Long
  58.    Dim M As ANICURSOR
  59.    MsgBoxHookProc = CallNextHookEx(pHook, CodeNo, wParam, lParam)
  60.    If CodeNo = HCBT_ACTIVATE Then
  61.       sClassName = Space$(32)
  62.       ClassNameSize = GetClassName(wParam, sClassName, 32)
  63.       If Left$(sClassName, ClassNameSize) <> MODAL_WINDOW_CLASSNAME Then Exit Function
  64.       If phIcon <> 0 Or Len(pAniIcon) <> 0 Then _
  65.          hIconWnd = FindWindowEx(wParam, 0&, "Static", vbNullString)
  66.       If phIcon <> 0 Then SendMessage hIconWnd, STM_SETICON, phIcon, ByVal 0&
  67.       If Len(pAniIcon) Then AniCreate M, pAniIcon, hIconWnd, 0, 0
  68.       UnhookWindowsHookEx pHook
  69.    End If
  70. End Function
  71. Public Sub AniCreate(ByRef m_AniStuff As ANICURSOR, sAniName As String, hwndParent As Long, x As Long, y As Long)
  72.    AniDestroy m_AniStuff
  73.    With m_AniStuff
  74.       .m_hCursor = LoadCursorFromFile(sAniName)
  75.       If .m_hCursor Then
  76.          .m_hWnd = CreateWindowEx(0, "Static", "", WS_CHILD Or WS_VISIBLE Or SS_ICON, ByVal 20, ByVal 20, 0, 0, hwndParent, 0, App.hInstance, ByVal 0)
  77.          If .m_hWnd Then
  78.             SendMessage .m_hWnd, STM_SETIMAGE, IMAGE_CURSOR, ByVal .m_hCursor
  79.             SetWindowPos .m_hWnd, 0, x, y, 0, 0, SWP_NOZORDER Or SWP_NOSIZE
  80.          Else
  81.             DestroyCursor .m_hCursor
  82.          End If
  83.       End If
  84.    End With
  85. End Sub
  86.  
  87. Public Sub AniDestroy(ByRef m_AniStuff As ANICURSOR)
  88.    With m_AniStuff
  89.       If .m_hCursor Then _
  90.          If DestroyCursor(.m_hCursor) Then .m_hCursor = 0
  91.       If IsWindow(.m_hWnd) Then _
  92.          If DestroyWindow(.m_hWnd) Then .m_hWnd = 0
  93.    End With
  94. End Sub

FORM:

Código: Visual Basic
  1. Option Explicit
  2. Dim M As ANICURSOR
  3.    
  4. Private Sub CmdAniTest_Click()
  5.    XMsgBox "Icono animado", vbInformation + vbYesNo, "Prueba", , App.Path & "\DINOSAUR.ANI"
  6. End Sub
  7.  
  8. Private Sub CmdClearFormAni_Click()
  9.    AniDestroy M
  10.    CmdClearFormAni.Enabled = False
  11. End Sub
  12.  
  13. Private Sub CmdFormAni_Click()
  14.    AniCreate M, App.Path & "\3drbusy10.ani", Me.hwnd, 100, 78
  15.    CmdClearFormAni.Enabled = True
  16. End Sub
  17.  
  18. Private Sub CmdIconTest_Click()
  19.    XMsgBox "Icono diferente", vbCritical + vbYesNo, "Prueba", PicBullsEye
  20. End Sub ' el PicBullsEye es un picturebox
« Última modificación: Mayo 12, 2014, 03:22:10 pm por Expermicid »


 

¿Te gustó el post? COMPARTILO!



Como impedir cambiar el tamaño de una ventana redimensionable

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1621
Último mensaje Julio 26, 2010, 11:33:48 am
por ANTRAX
Como cambiar de color una columna de MSFlexgrid

Iniciado por ANTRAX

Respuestas: 0
Vistas: 2514
Último mensaje Julio 26, 2010, 11:30:30 am
por ANTRAX
Cambiar Fecha u Hora del Sistema

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1414
Último mensaje Julio 26, 2010, 01:39:27 pm
por ANTRAX
Cambiar el nombre del ordenador (A pura API)

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1194
Último mensaje Julio 26, 2010, 12:19:48 pm
por ANTRAX
Cambiar Resolucion De Pantalla

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1391
Último mensaje Julio 26, 2010, 04:10:41 pm
por ANTRAX