Option Explicit

'the three declares and five constants
'below are just used in creating the demo
Private Declare Function DrawIcon Lib "user32" _
   (ByVal hdc As Long, ByVal x As Long, _
    ByVal Y As Long, ByVal hIcon As Long) As Long
    
Private Declare Function LoadIcon Lib "user32" _
    Alias "LoadIconA" _
   (ByVal hInstance As Long, _
    ByVal lpIconName As Any) As Long
   
Private Declare Function DestroyIcon Lib "user32" _
   (ByVal hIcon As Long) As Long
   
'icon display values for LoadIcon/DrawIcon
Private Const IDI_APPLICATION = 32512&
Private Const IDI_HAND = 32513&
Private Const IDI_QUESTION = 32514&
Private Const IDI_EXCLAMATION = 32515&
Private Const IDI_ASTERISK = 32516&

Private Type MSGBOXPARAMS  'for MessageBoxIndirect (not shown in this demo)
  'Specifies the structure size,
  'in bytes.
   cbSize As Long
   
  'Identifies the owner window. This
  'member can be null
   hwndOwner As Long
   
  'Identifies the instance containing the
  'icon resource identified by the lpszIcon
  'member, and the string resource identified
  'by the lpszText or lpszCaption member.
   hInstance As Long
   
  'Pointer to a null-terminated string, or
  'the identifier of a string resource, that
  'contains the message to be displayed.
   lpszText As String
   
  'Pointer to a null-terminated string, or
  'the identifier of a string resource, that
  'contains the message box title. If this
  'member is NULL, the default title Error is used.
   lpszCaption As String
   
  'Specifies a set of bit flags that determine
  'the contents and behaviour of the dialog box.
  'This member can be a combination of flags
  'described for the uType parameter of the
  'MessageBoxEx function. In addition, you can
  'specify the MB_USERICON flag if you want the
  'message box to display the icon specified
  'by the lpszIcon member.
   dwStyle As Long
   
  'Identifies an icon resource. This parameter
  'can be either a null-terminated string or an
  'integer resource identifier passed to the
  'MAKEINTRESOURCE macro.
  '
  'To load one of the standard system-defined
  'icons, set the hInstance member to NULL and
  'set lpszIcon to one of the values listed with
  'the LoadIcon function.
  '
  'This member is ignored if the dwStyle member
  'does not specify the MB_USERICON flag.
   lpszIcon As String
   
  'Identifies a Help context. If a Help event occurs,
  'this value is specified in the HELPINFO structure
  'that the message box sends to the owner window
  'or callback function.
   dwContextHelpId As Long
   
  'Pointer to the callback function that processes
  'Help events for the message box. The callback
  'function has the following form:
  '
  '   VOID CALLBACK MsgBoxCallback(LPHELPINFO lpHelpInfo);
  '
  'If this member is NULL, the message box sends WM_HELP
  'messages to the owner window when help events occur.
   lpfnMsgBoxCallback As Long
   
  'Specifies the language in which to display the text
  'contained in the predefined push buttons. This value
  'must be in the form returned by the MAKELANGID macro.
  'For a list of the language identifiers supported by
  'Win32, see Language Identifiers in the msdn. Note
  'that each localized release of Windows and Windows NT
  'typically contains resources only for a limited set
  'of languages. Thus, for example, the U.S. version
  'offers LANG_ENGLISH, the French version offers LANG_FRENCH,
  'the German version offers LANG_GERMAN, and the Japanese
  'version offers LANG_JAPANESE. Each version offers
  'LANG_NEUTRAL. This limits the set of values that
  'can be used with the wLanguageId parameter. Before
  'specifying a language identifier, you should enumerate
  'the locales that are installed on a system.
   dwLanguageId As Long
End Type

'MessageBoxEx function creates, displays,
'and operates a message box. The message box
'contains an application-defined message and
'title, plus any combination of predefined icons
'and push buttons. The wLanguageId parameter
'specifies which set of language resources is
'used for the predefined push buttons. Note that
'Windows identifies this as a reserved parameter.
Private Declare Function MessageBoxEx Lib "user32" _
   Alias "MessageBoxExA" _
  (ByVal hwnd As Long, _
   ByVal lpText As String, _
   ByVal lpCaption As String, _
   ByVal uType As Long, _
   ByVal wLanguageId As Long) As Long

'MessageBoxIndirect function creates, displays,
'and operates a message box. The message box contains
'application-defined message text and title, any icon,
'and any combination of predefined push buttons.
Private Declare Function MessageBoxIndirect Lib "user32" _
   Alias "MessageBoxIndirectA" _
   (lpMsgBoxParams As MSGBOXPARAMS) As Long

'wLanguageId parameter IDs
Private Const LANG_ENGLISH As Long = &H9

'uType parameters
'Icon IDs
Private Const MB_ICONHAND As Long = &H10&
Private Const MB_ICONQUESTION As Long = &H20&
Private Const MB_ICONEXCLAMATION As Long = &H30&
Private Const MB_ICONASTERISK As Long = &H40&
Private Const MB_ICONINFORMATION As Long = MB_ICONASTERISK
Private Const MB_ICONSTOP As Long = MB_ICONHAND

'Button IDs
Private Const MB_OK As Long = &H0&
Private Const MB_OKCANCEL As Long = &H1&
Private Const MB_ABORTRETRYIGNORE As Long = &H2&
Private Const MB_YESNOCANCEL As Long = &H3&
Private Const MB_YESNO As Long = &H4&
Private Const MB_RETRYCANCEL As Long = &H5&
Private Const MB_DEFBUTTON1 As Long = &H0&
Private Const MB_DEFBUTTON2 As Long = &H100&
Private Const MB_DEFBUTTON3 As Long = &H200&
Private Const MB_DEFBUTTON4 As Long = &H300&

'Msgbox style IDs
'modality
Private Const MB_APPLMODAL As Long = &H0&
Private Const MB_SYSTEMMODAL As Long = &H1000&
Private Const MB_TASKMODAL As Long = &H2000&

'misc
'Adds a Help button to the message box. Choosing
'the Help button or pressing F1 generates a Help event.
Private Const MB_HELP As Long = &H4000

'The message box becomes the foreground window. Internally,
'the system calls the SetForegroundWindow function for
'the message box.
Private Const MB_SETFOREGROUND As Long = &H10000

'The desktop currently receiving input must be a
'default desktop; otherwise, the function fails.
'A default desktop is one an application runs on
'after the user has logged on.
Private Const MB_DEFAULT_DESKTOP_ONLY As Long = &H20000

'The message box is created with the WS_EX_TOPMOST
'window style.
Private Const MB_TOPMOST As Long = &H40000

'The text is right-justified.
Private Const MB_RIGHT As Long = &H80000

'Displays message and caption text using
'right-to-left reading order on Hebrew and
'Arabic systems.
Private Const MB_RTLREADING As Long = &H100000


'Windows NT: The caller is a service notifying the user
'of an event. The function displays a message box on the
'current active desktop, even if there is no user logged
'on to the computer. If this flag is set, the hWnd
'parameter must be NULL. This is so the message box
'can appear on a desktop other than the desktop
'corresponding to the hWnd.

'WINVER > = 0x0400; less than 4 uses &H400000
Private Const MB_SERVICE_NOTIFICATION As Long = &H200000

'misc masks
Private Const MB_TYPEMASK As Long = &HF&
Private Const MB_ICONMASK As Long = &HF0
Private Const MB_DEFMASK As Long = &HF00&
Private Const MB_MODEMASK As Long = &H3000&
Private Const MB_NOFOCUS As Long = &H8000&
Private Const MB_MISCMASK As Long = &HC000&

'Return values
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7

'Help Callback structures
Private Type POINTAPI
   x As Long
   Y As Long
End Type

Private Type HELPINFO
   cbSize As Long
   iContextType As Long
   iCtrlId As Long
   hItemHandle As Long
   dwContextId As Long
   MousePos As POINTAPI
End Type

'used in the demo to display appropriate 
'button captions in order to provide a  
'means to pick a default button
Private btnCaptions(0 To 5, 0 To 3) As String

'vars set in the option and button click
'routines and used to track the flags
'in order to display the messagebox
Private msgButtons As Long
Private msgDefButton As Long
Private msgIcon As Long

Private Sub Form_Load()

  'this loads a two-dimensional array with
  'button captions.  The first array index corresponds
  'to the option button index (setting the captions
  'to display on the form buttons), while the second
  'parameter is the defButton control array index.
   btnCaptions(0, 0) = "OK"
   btnCaptions(0, 1) = ""
   btnCaptions(0, 2) = ""
   
   btnCaptions(1, 0) = "OK"
   btnCaptions(1, 1) = "Cancel"
   btnCaptions(1, 2) = ""
   
   btnCaptions(2, 0) = "Abort"
   btnCaptions(2, 1) = "Retry"
   btnCaptions(2, 2) = "Ignore"
   
   btnCaptions(3, 0) = "Yes"
   btnCaptions(3, 1) = "No"
   btnCaptions(3, 2) = "Cancel"
   
   btnCaptions(4, 0) = "Yes"
   btnCaptions(4, 1) = "No"
   btnCaptions(4, 2) = ""
   
   btnCaptions(5, 0) = "Retry"
   btnCaptions(5, 1) = "Cancel"
   btnCaptions(5, 2) = ""
  
  'this sets up the controls ....
   
  'populate the buttons with the built-in
  'icon resources.  NOTE: After completing
  'this demo, I found info in the MSDN stating
  'that LoadIcon is obsolete, replaced with
  'LoadImage. This code continues to work.
  '
  'Since this is to demo using the MessageBoxEx API,
  'and not how to obtain a system icon, I will
  'post using LoadIcon and revise at a future date.
   Dim hIcon As Long
   
   With Picture1
      .AutoRedraw = True
      .BorderStyle = 0
      .Width = 32 * Screen.TwipsPerPixelX
      .Height = 32 * Screen.TwipsPerPixelY
   End With
   
   With Shape1
      .BorderColor = RGB(255, 255, 0)
   End With
   
   With Shape2
      .BorderColor = RGB(255, 0, 0)
   End With
   
   With Command1(0)
      .Width = 1335
      .Height = 345
   End With

   With Command1(1)
      .Width = 1335
      .Height = 345
   End With
   
   With Command1(2)
      .Width = 1335
      .Height = 345
   End With
      
   Command2(0).Caption = "None"
   Command2(1).Caption = ""
   Command2(2).Caption = ""
   Command2(3).Caption = ""
   Command2(4).Caption = ""
   
   With Command3
      .Width = 1815
      .Height = 345
      .Caption = "Show Message"
   End With
   
   Option1(0).Caption = "OK"
   Option1(1).Caption = "OK  Cancel"
   Option1(2).Caption = "Abort  Retry  Ignore"
   Option1(3).Caption = "Yes  No  Cancel"
   Option1(4).Caption = "Yes  No"
   Option1(5).Caption = "Retry  Cancel"
   
   Text1.Text = "VBnet MessageBoxEx Demo"
   Text2.Text = "The license key you entered was invalid. Please try again."
   Text3.Text = ""
      
   hIcon = LoadIcon(0&, IDI_HAND)
   Call DrawIcon(Picture1.hdc, 0, 0, hIcon)
   Command2(1).Picture = Picture1.Image
   Set Picture1.Picture = LoadPicture("")
   Call DestroyIcon(hIcon)
   
   hIcon = LoadIcon(0&, IDI_QUESTION)
   Call DrawIcon(Picture1.hdc, 0, 0, hIcon)
   Command2(2).Picture = Picture1.Image
   Set Picture1.Picture = LoadPicture("")
   Call DestroyIcon(hIcon)
   
   hIcon = LoadIcon(0&, IDI_EXCLAMATION)
   Call DrawIcon(Picture1.hdc, 0, 0, hIcon)
   Command2(3).Picture = Picture1.Image
   Set Picture1.Picture = LoadPicture("")
   Call DestroyIcon(hIcon)
   
   hIcon = LoadIcon(0&, IDI_ASTERISK)
   Call DrawIcon(Picture1.hdc, 0, 0, hIcon)
   Command2(4).Picture = Picture1.Image
   Set Picture1.Picture = LoadPicture("")
   Call DestroyIcon(hIcon)
  
   Option1(0).Value = True
   Command1(0).Value = True
   Command2(0).Value = True
   
End Sub

Private Sub Command1_Click(Index As Integer)
  
  'the default button values are multiples of 256
   msgDefButton = Index * 256
   
  'this just highlights the current selection
   Shape1.Move Command1(Index).Left - 35, _
               Command1(Index).Top - 35, _
               Command1(Index).Width + 70, _
               Command1(Index).Height + 70

End Sub

Private Sub Command2_Click(Index As Integer)
  
  'the icon button values are multiples of 16
   msgIcon = Index * 16
   
  'this just highlights the current selection
   Shape2.Move Command2(Index).Left - 35, _
                    Command2(Index).Top - 35, _
                    Command2(Index).Width + 70, _
                    Command2(Index).Height + 70
  
End Sub

Private Sub Command3_Click()

   Dim sMessage As String
   Dim sTitle As String
   Dim dwFlags As Long

   sTitle = Text1.Text
   sMessage = Text2.Text
   Text3.Text = ""
   
   dwFlags = msgButtons Or msgDefButton Or msgIcon

  'called as a function
   Select Case MessageBoxEx(Me.hwnd, _
                            sMessage, _
                            sTitle, _
                            dwFlags, _
                            LANG_ENGLISH)
                            
      Case IDOK: Text3.Text = "IDOK selected"
      Case IDCANCEL: Text3.Text = "IDCANCEL selected"
      Case IDABORT: Text3.Text = "IDABORT selected"
      Case IDRETRY: Text3.Text = "IDRETRY selected"
      Case IDIGNORE: Text3.Text = "IDIGNORE selected"
      Case IDYES: Text3.Text = "IDYES selected"
      Case IDNO: Text3.Text = "IDNO selected"
   End Select

End Sub

Private Sub Option1_Click(Index As Integer)
  
  'reset the highlight to the first button
   Command1(0).Value = True
   
  'reset the captions and visibility of the
  'available default buttons
   Command1(0).Visible = btnCaptions(Index, 0) > ""
   Command1(1).Visible = btnCaptions(Index, 1) > ""
   Command1(2).Visible = btnCaptions(Index, 2) > ""
   
   Command1(0).Caption = btnCaptions(Index, 0)
   Command1(1).Caption = btnCaptions(Index, 1)
   Command1(2).Caption = btnCaptions(Index, 2)
   
  'the default button style is directly mapped
  'to the index
   msgButtons = Index
   
End Sub