MessageBox personalizzato

 
Option Explicit
'
Private Type MSGBOXPARAMS
    cbSize As Long
    hwndOwner As Long
    hInstance As Long
    lpszText As Long
    lpszCaption As Long
    dwStyle As Long
    lpszIcon As Long
    dwContextHelpId As Long
    lpfnMsgBoxCallback As Long
    dwLanguageId As Long
End Type
'
Private Type MSGBOXDATA_Earlier
    params As MSGBOXPARAMS
    pwndOwner As Long
    wLanguageId As Long
    pidButton As Long
    ppszButtonText As Long
    cButtons As Long
    DefButton As Long
    CancelId As Long
    Timeout As Long
End Type
'
Private Type MSGBOXDATA_Later
    params As MSGBOXPARAMS
    unk1 As Long
    pwndOwner As Long
    wLanguageId As Long
    pidButton As Long
    ppszButtonText As Long
    cButtons As Long
    DefButton As Long
    CancelId As Long
    Timeout As Long
    unk2(5) As Long
End Type
'
Private Declare Function SoftModalMessageBox_Earlier Lib "user32" Alias "SoftModalMessageBox" (pMsgBoxParams As MSGBOXDATA_Earlier) As Long
Private Declare Function SoftModalMessageBox_Later Lib "user32" Alias "SoftModalMessageBox" (pMsgBoxParams As MSGBOXDATA_Later) As Long
'

Public Sub Main()
    Dim md_Earlier      As MSGBOXDATA_Earlier
    Dim md_Later        As MSGBOXDATA_Later
    Dim lBtn(3)         As Long
    Dim sTxt(3)         As String
    Dim iRet            As Long
    '


    sTxt(0) = "Lavoratori"
    lBtn(0) = 1
    sTxt(1) = "Documenti"
    lBtn(1) = 2
    sTxt(2) = "Entrambi"
    lBtn(2) = 3
    sTxt(3) = "Nessuno"
    lBtn(3) = 4
    '
    If WindowsVersi0n() < 61 Then ' Vista and below use earlier structure.
        With md_Earlier
            With .params
                .cbSize = LenB(md_Earlier.params)
                .lpszText = StrPtr("Quali dati vuoi aggiornare?")
                .lpszCaption = StrPtr("VBforums")
                .dwStyle = vbQuestion Or vbYesNoCancel
            End With
            .DefButton = 0
            .CancelId = 2
            .cButtons = 4
            .pidButton = VarPtr(lBtn(0))
            .ppszButtonText = VarPtr(sTxt(0))
            .Timeout = -1
        End With
        iRet = SoftModalMessageBox_Earlier(md_Earlier)
        MsgBox "Our custom message box returned: " & Format$(iRet)
    Else
        With md_Later
            With .params
                .cbSize = LenB(md_Later.params)
                .lpszText = StrPtr("Quali dati vuoi aggiornare?")
                .lpszCaption = StrPtr("VBforums")
                .dwStyle = vbQuestion Or vbYesNoCancel
            End With
            .DefButton = 0
            .CancelId = 2
            .cButtons = 4
            .pidButton = VarPtr(lBtn(0))
            .ppszButtonText = VarPtr(sTxt(0))
            .Timeout = -1
        End With
        iRet = SoftModalMessageBox_Later(md_Later)
        MsgBox "Our custom message box returned: " & Format$(iRet)
    End If

End Sub

Public Function WindowsVersi0n() As Long
    '    OS              WindowsVersion return
    ' Windows 10                100
    ' Windows 8.1                63
    ' Windows 8.0                62
    ' Windows 7                  61
    ' Windows Vista              60
    ' Windows XP                 51
    ' Windows 2000               50
    Dim SystemSet As Object
    Dim System As Object
    Dim s As String
    Dim i As Long
    '
    Set SystemSet = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
    For Each System In SystemSet: s = System.Version: Next
    '
    i = InStr(s, ".")
    s = Left$(s, i - 1) & Mid$(s, i + 1)
    i = InStr(s, ".")
    If i Then s = Left$(s, i - 1)
    WindowsVersion = Val(s)
End Function

Select Case iRet
  
        Case Is = 1
        MsgBox "Hai scelto l'opzione Lavoratori"
    
        Case Is = 2
        MsgBox "Hai scelto l'opzione Documenti"
 
        Case Is = 3
        MsgBox "Hai scelto l'opzione Entrambi"
 
        'Case Is = 4
        'MsgBox "Hai scelto di interrompere lo script"

        End Select
        'MsgBox "Our custom message box returned: " & Format$(iRet)
    End If