Eigene MSGBox - Buttonrückgabe aber wie

  • VB.NET
  • .NET (FX) 4.5–4.8

Es gibt 31 Antworten in diesem Thema. Der letzte Beitrag () ist von volti.

    Eigene MSGBox - Buttonrückgabe aber wie

    Hallo zusammen,

    ich möchte mir eine eigene MSGBox erstellen, in der ich dann x beliebig viele Buttons einfügen kann.

    Basis ist: VB.Net 2022, Projektvorlage ist Windows Forms-Steuerelementbibliothek (.NET Framework), Keine Veränderungen in den Eigenschaften, VB.Net als Admin gestartet

    Jetzt ist aber direkt schon das erste Problem aufgetreten: Wie bekomme ich in der Hauptanwendung mit, welcher Button gedrückt wurde?

    Mein bisheriger Controlcode sieht so aus:

    Spoiler anzeigen
    ​

    VB.NET-Quellcode

    1. ​
    2. Public Class NeueMSGBox
    4. Private selectedButton As String = ""
    6. ' Diese Methode zeigt die MsgBox an und gibt das Ergebnis zurück
    7. Public Function ShowDialog() As String
    8. Me.ShowDialog()
    9. Return selectedButton
    10. End Function
    12. ' Event-Handler für Button 1
    13. Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    14. selectedButton = "Option 1"
    15. Me.Close()
    16. End Sub
    18. ' Event-Handler für Button 2
    19. Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
    20. selectedButton = "Option 2"
    21. Me.Close()
    22. End Sub
    24. ' Event-Handler für Button 3
    25. Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
    26. selectedButton = "Option 3"
    27. Me.Close()
    28. End Sub
    30. End Class


    Soweit ist mir der Code eigentlich klar, aber bei me.close() kommt die Fehlermeldung "BC30256 Close ist kein Member von NeueMSGBox". Die Korrekturmöglichkeit wäre

    Private Sub Close()
    Throw New NotImplementedException()
    End Sub

    In der Hauptform gibt es einen Verweis auf die DLL-Datei und der Code sieht so aus

    Spoiler anzeigen
    ​

    VB.NET-Quellcode

    1. ​
    2. Imports NeuMsgBox
    3. Public Class Form1
    4. Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    5. Dim msgBox As New NeueMSGBox()
    6. Dim result As String = msgBox.ShowDialog()
    8. Select Case result
    9. Case "Option 1"
    10. MessageBox.Show("Du hast Option 1 gewählt.")
    11. Case "Option 2"
    12. MessageBox.Show("Du hast Option 2 gewählt.")
    13. Case "Option 3"
    14. MessageBox.Show("Du hast Option 3 gewählt.")
    15. Case Else
    16. MessageBox.Show("Keine Option gewählt.")
    17. End Select
    18. End Sub
    19. End Class


    Nachdem ich auf den Testbutton geklickt habe, kommt folgender Fehler

    System.StackOverflowException
    HResult=0x800703E9
    Nachricht = Eine Ausnahme vom Typ "System.StackOverflowException" wurde ausgelöst.

    Könnt Ihr mir evtl. helfen und mir die richtige Vorgehensweise nennen?

    Vielen Dank schon einmal im Voraus.

    Volker

    Deine NeueMSGBox Klasse hat halt keine Close Methode.
    Vielleicht sollte sie von Form erben. Denn ein Form hat eine Close Methode.

    Aber das ganze gleich als DLL? Warum fügst du deinem Projekt nicht einfach erstmal ein zweites Form hinzu, damit du weißt was du tust?

    Wenn nur drei Buttons brauchst, die alle auch noch das Form schließen, dann geht das mit der DialogResult Eigenschaft.
    Vielleicht brauchst nichmal selbst was basteln. Die MessageBox Klasse bietet sich selbst auch in einer drei Button Variante an: YesNoCancel

    Wenn die neue MessageBox von nix erbt, kennt sie auch keine Close-Methode. Dazu müsste sie also schon von Form erben. Das sehen wir hier aber nicht.

    Haudruferzappeltnoch schrieb:

    Vielleicht brauchst nichmal selbst was basteln. Die MessageBox Klasse bietet sich selbst auch in einer drei Button Variante an: YesNoCancel
    Ich hab mir auch ne eigene MessageBox gebastelt, die ich seit langem schon sehr zufriedenstellend nutze. Manchmal reicht eine MessageBox einfach nicht. Fiktive Beispiele:
    Welcher passende Vorgang soll aufgerufen werden? [1. vom 12.12.23] [2. vom 16.12.23] [3. vom 18.12.23] [(keiner)] - klassische Alternative: InputBox <X
    Das aktuelle Konto ist nicht gedeckt. Was soll vom Referenzkonto abgezogen werden? [Gesamtbetrag] [fehlender Betrag] [Vorgang abbrechen] - klassische Alternative: Frage umstellen: »Soll der Gesamtbetrag vom Referenzkonto abgezogen werden? Bei [Nein] wird nur der Differenzbetrag abgezogen.« - Macht es meines Erachtens komplizierter.

    ##########

    Bezüglich der Buttonrückgabe: Das ist ganz einfach.
    Eine Möglichkeit: Erstelle z.B. eine Property Result, mit Public Getter und Private Setter. Sobald ein Button gedrückt wird, weist Du dieser Property einen entsprechenden Wert zu. Das aufrufende Programm kann das Result auslesen (aber selber nicht verändern).
    Eine andere Variante: Deine Methoden, die Deine MessageBox aufrufen, geben ein entsprechendes Ergebnis zurück. So habe ich entweder klassisch DialogResult. Oder (abhängig vom Aufruf) einen Integer als Rückgabewert. Wenn also z.B. 5 Buttons erstellt werden sollen, bekomme ich abhängig davon, welcher Button gedrückt wurde, einen Zahl zwischen 0 und 4 zurück. Oder -1, wenn ich oben rechts auf das [X] klicke. Man kann das [X] natürlich auch wegmachen, wenn man den Auswahlabbruch lieber über einen eigenen, regulären Button machen will.
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

    Ich habe so was ähnliches in meine Anwendung (bopv.uno) integriert). Ist zwar eine Inputbox, aber kann man mit einer MsgBox ebenfalls so machen:


    Eine kleine Routine, die die Daten in eine Form schreibt und die Form dann ausliest.
    Die Form macht dann die Logik und schließt sich wieder.
    Das Ergebnis der Textbox aus der Form ist dann die Rückgabe der Inputbox.

    VB.NET-Quellcode

    1. My.Settings.License = InputBoxOwn("Enter activation code for " + HardwareID + " or plug in your hardware dongle:", "License", HardwareID)


    VB.NET-Quellcode

    1. Public Function InputBoxOwn(Haupttext As String, TitelText As String, Sollwert As String) As String
    2. FRM_Inputbox.Label_Title.Text = TitelText
    3. FRM_Inputbox.Label_Message.Text = Haupttext
    4. FRM_Inputbox.TextBoxInput.Text = Sollwert
    6. FRM_Inputbox.ShowDialog()
    7. Return FRM_Inputbox.TextBoxInput.Text
    8. End Function



    VB.NET-Quellcode

    1. Public Class FRM_Inputbox
    2. Private Sub ButtonContinue_Click(sender As Object, e As EventArgs) Handles ButtonContinue.Click
    3. TouchBeep()
    4. Me.Close()
    5. End Sub
    7. Private Sub ButtonOK_Click(sender As Object, e As EventArgs) Handles ButtonOK.Click
    8. TouchBeep()
    9. Me.Close()
    10. End Sub
    12. Private Sub FRM_Inputbox_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    13. Hauptform.RoundButton(ButtonOK)
    14. Hauptform.RoundButton(ButtonContinue)
    15. Hauptform.RoundTextBoxen(TextBoxInput)
    16. End Sub
    18. Private Sub ButtonContinue_Paint(sender As Object, e As PaintEventArgs) Handles ButtonContinue.Paint, ButtonOK.Paint
    19. Dim b = DirectCast(sender, Button)
    20. Hauptform.FarbVerlauf(b, e) 'Farbverlauf, Antialising und Haupttexterstellung ausgelagert
    21. End Sub
    23. End Class
    Bilder

    • 26112024103444.jpg

      137,94 kB, 969×596, 151 mal angesehen

    • 26112024103628.jpg

      151,76 kB, 906×563, 147 mal angesehen
    Liebe Grüße
    Roland Berghöfer

    Meine aktuellen und kostenlos verwendbaren Tools (mit VB.NET erstellt): freeremarkabletools.com | priconman.com | SimpleCalendar | AudibleTouch | BOComponent.com | bonit.at

    Volker Bunge schrieb:

    ich möchte mir eine eigene MSGBox erstellen, in der ich dann x beliebig viele Buttons einfügen kann.
    Wie viele Buttons sollen es denn maximal werden? Es gibt mehrer Möglichkeiten eine MessageBox zu erzeugen. Da wäre eine Form nur eine Möglichkeit. Dann gibt es in Windows vorhandene Messagebox-APIs die man nutzen könnte. z.B. mit der API SoftModalMessageBox kannst Du bis zu 11 Buttons auf eine Standard-Messagebox anzeigen lassen wobei die Buttonbeschriftung angepasst werden kann, inkl falls man es benötigt, ein Timeout so das sich die MessageBox von allein schließt wenn nach ablauf des Timeout kein Button gedrückt wurde. Einen sehr guten Einblick in diese API findest Du hier: github.com/imgdrive/SoftModalMessageBox

    VB.NET selbst nutzt für eine Standard Messagebox ebenfalls die in Windows vorhandenen APIs (MessageBox oder MessageBoxIndirect).
    Mfg -Franky-

    Ergänzend zu Messageboxes der API:

    Es gibt mehrere Funktionen Messagebox in der Windows-API. Die bekannteste ist die MessgeboxA.
    Mit weiteren API-Funktionen lässt sich diese manipulieren.
    Diese Messagebox handelt intern 5 Button-IDs, wovon aber mit den MB-Funktionen nur drei gleichzeitig sichtbar geschaltet werden können.
    Inklusive des Help-Buttons kann man hier also vier Buttons anzeigen lassen. Der Help-Button muss allerdings als Sonderfall anders als die anderen gemanagt werden.

    Wer mehr will, muss sich eine Form/Userform basteln oder gleich ein neues Fenster mit der Dlg-Klasse bauen. Das erfordert allerdings intensive API-Programmierkennnisse und ist m.E. zu aufwendig für diese einfache Nutzung.
    Das Einfügen weiterer Buttons in die Standard-Messagebox ist möglich, erfordert dann aber auch wieder das Extraverarbeiten.

    In den nachfolgenden Links habe ich mal ein paar Beispiele aufgezeigt. Hier nutze ich allerdings oft die Excelinterne Version, wobei allerdings nur das Einhooken in die MsgBox abweichend von der API-Version ist.
    Auf der Homepage sind noch viele Beispiele, wie man z.B. Radiobutton und Checkboxen zu einer Inputbox hinzufügt, Buttonbeschriftungen, Icons, Schriftart einer MsgBox ändert und so weiter.
    Es ist allerdings in VBA geschrieben. Die API-Programmierung ist allerdings fast überall ähnlich.

    clever-excel-forum.de/Thread-M…r-Button-und-eigenem-Icon
    clever-excel-forum.de/Thread-Projekt-Coole-MessageBox
    Gruß Karl-Heinz

    Oh, sorry Coldfire,

    das war mir jetzt gar nicht bewusst, dass zum Runterladen der Dateien eine Anmeldung erfolgt sein muss. :(

    Das Format xlsb ist ein gängiges Excelformat, das die Daten in binärer Form, so wie früher mal das xls-Format war, speichert. Ist platzsparender als die jetzt üblichen xlsx bzw. xlsm-Formate.
    Also nix gefährliches.

    Nun, die Beispiele enthalten sehr viel Code, die kann ich jetzt leider nicht hier alle zeigen. Und ich habe zig verschiedene Beispiele....

    Für das eine Beispiel mit den vier Buttons über die MessageBoxIndirect hier mal der Code unverbindlich zur Ansicht. Die Icons sind hier aber in der Tabelle deponiert und die fehlt ja jetzt.
    Der Code ist mittlerer Größe. Für drei Button wäre er mit MessageBoxA deutlich kleiner und für weitere Dinge eben mehr.

    Und, man kann alles immer auch anders machen :)

    Visual Basic-Quellcode

    1. ​Option Explicit
    3. #If Win64 Then
    4. Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" ( _
    5. ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    6. Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" ( _
    7. ByVal hwnd As LongPtr, ByVal nIndex As Long, _
    8. ByVal dwNewLong As LongPtr) As LongPtr
    9. #Else
    10. Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    11. ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    12. Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    13. ByVal hwnd As LongPtr, ByVal nIndex As Long, _
    14. ByVal dwNewLong As LongPtr) As LongPtr
    15. #End If
    16. Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    17. Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, _
    18. ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, _
    19. ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    20. Private Declare PtrSafe Function MessageBoxIndirectA Lib "user32" ( _
    21. lpMsgBoxParams As MSGBOXPARAMS) As Long
    22. Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
    23. ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    24. Private Declare PtrSafe Function SetDlgItemTextA Lib "user32" ( _
    25. ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
    26. Private Declare PtrSafe Function SendDlgItemMessageA Lib "user32" ( _
    27. ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
    28. ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    29. Private Declare PtrSafe Function PostMessageA Lib "user32" ( _
    30. ByVal hwnd As LongPtr, ByVal wMsg As Long, _
    31. ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    32. Private Declare PtrSafe Function GetSystemMetrics Lib "user32" ( _
    33. ByVal nIndex As Long) As Long
    34. Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
    35. ByVal hwnd As LongPtr, lpRect As RECT) As Long
    36. Private Declare PtrSafe Function SetTimer Lib "user32" ( _
    37. ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
    38. ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    39. Private Declare PtrSafe Function KillTimer Lib "user32" ( _
    40. ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    42. Private Type POINTAPI
    43. x As Long
    44. y As Long
    45. End Type
    46. Dim PtKreuz As POINTAPI
    48. Private Type RECT
    49. Left As Long
    50. Top As Long
    51. Right As Long
    52. Bottom As Long
    53. End Type
    55. Private Type MSGBOXPARAMS
    56. cbSize As Long
    57. hwndOwner As LongPtr
    58. hInstance As LongPtr
    59. sText As String
    60. sCaption As String
    61. dwStyle As Long
    62. hIcon As LongPtr ' lpszIcon
    63. hDlg As LongPtr ' dwContextHelpId
    64. lpMsgBoxCallback As LongPtr
    65. iBtn As Long ' dwLanguageId
    66. hTimer As LongPtr ' Neu
    67. tPt As POINTAPI ' Neu
    68. bNoSysMenu As Boolean ' Neu
    69. End Type
    71. Public Const vbNoSysMenu As Long = 2097152
    73. Private Const WS_SYSMENU As Long = &H80000
    74. Private Const SM_CXSCREEN As Long = 0
    75. Private Const SM_CYSCREEN As Long = 1
    77. Dim MB As MSGBOXPARAMS, msBtn() As String
    78. Const sIconSheet As String = "Tabelle1" ' <<<<Blatt ggf. anpassen>>>>
    80. Private Function MsgboxEx(sText As String, _
    81. Optional ByVal iStyle As Long = 64, _
    82. Optional sCaption As String = "Microsoft Excel", _
    83. Optional sBtnText As String = "OK", _
    84. Optional sIconname As String, _
    85. Optional x As Long, Optional y As Long) As String
    86. ' MsgBox mit Anpassungen für bis zu 4 Buttons, Icon, Position
    87. Dim iAnzBtn As Integer, Wsh As Worksheet
    89. Set Wsh = ThisWorkbook.Sheets("Tabelle1") ' Blatt mit den Icons <<<anpassen>>>
    90. msBtn = Split(",,," & sBtnText & ",,,,,,", ",") ' Buttontexte aufsplitten
    91. iAnzBtn = UBound(msBtn) - 8 ' Anzahl der Buttons incl. Pseudo
    92. msBtn(9) = msBtn(6): msBtn(7) = msBtn(4) ' Umsetzung einiger Btn-Texte
    93. msBtn(1) = msBtn(3): msBtn(6) = msBtn(3) ' 3, 4 und 5 schon beim Splitten gesetzt
    94. msBtn(2) = IIf(iAnzBtn = 4, msBtn(5), msBtn(4))
    96. With MB
    97. .cbSize = LenB(MB)
    98. .hwndOwner = Application.hwnd ' An Excel gebunden
    99. .hInstance = Application.HinstancePtr ' Instanz übernehmen
    100. .sText = Replace(sText, "¶", vbLf) ' MsgBox-Text ggf. mit Umbruch
    101. .sCaption = sCaption ' MsgBox Caption
    102. .tPt.x = x: .tPt.y = y ' MsgBox-Position
    103. .bNoSysMenu = iStyle And vbNoSysMenu ' Kein Schließenkreuz
    104. .dwStyle = (iStyle And &HFBFF8) Or (iAnzBtn - 1) ' Style-Parameter ohne Buttons
    105. If iAnzBtn > 3 Then .dwStyle = .dwStyle Or vbMsgBoxHelpButton
    107. On Error Resume Next
    108. .hIcon = 0 ' Handle des gefundenen Icons
    109. .hIcon = Wsh.OLEObjects(sIconname).Object.Picture.handle
    111. .lpMsgBoxCallback = GetAddressOf(AddressOf MsgBoxCallbackProc)
    113. .hTimer = SetTimer(0&, 0&, 25, AddressOf MsgBoxCallbackProc)
    114. MsgboxEx = Replace(msBtn(MessageBoxIndirectA(MB)), "&", "")
    116. ' Systemkreuz geklickt?
    117. GetCursorPos .tPt ' Mausposition holen
    118. If .tPt.y < PtKreuz.y Then MsgboxEx = "SystemAbbruch"
    119. End With
    120. End Function
    122. Private Function GetAddressOf(ByVal lpProcAddress As LongPtr) As LongPtr
    123. GetAddressOf = lpProcAddress
    124. End Function
    126. Private Sub MsgBoxCallbackProc()
    127. ' TYPE HELP_INFO abgeschaltet, wird nicht benötigt
    128. ' Setzt die Button-Texte und das Icon individuell
    129. Dim R As RECT, lPos As Long
    131. With MB
    132. If .hTimer <> 0 Then
    133. KillTimer 0&, .hTimer: .hTimer = 0 ' Timer löschen
    134. .hDlg = FindWindowA("#32770", .sCaption) ' MsgBox-Handle ermitteln
    135. ' Icon setzen &H170=STM_SETICON
    136. If .hIcon <> 0 Then SendDlgItemMessageA .hDlg, 20, &H170, .hIcon, 0
    137. For .iBtn = 1 To 9 ' Buttontexte setzen
    138. SetDlgItemTextA .hDlg, .iBtn, msBtn(.iBtn)
    139. Next .iBtn
    140. If .tPt.x < 0 Or .tPt.y < 0 Then ' MsgBox-Pos. auf Maus-Pos.
    141. GetCursorPos .tPt ' Mausposition holen
    142. End If
    144. If .tPt.x > 0 And .tPt.y > 0 Then ' MsgBox-Position setzen
    145. GetWindowRect .hDlg, R ' Koordinaten der MsgBox holen
    146. lPos = GetSystemMetrics(SM_CXSCREEN) - (R.Right - R.Left)
    147. If .tPt.x > lPos Then .tPt.x = lPos
    148. lPos = GetSystemMetrics(SM_CYSCREEN) - (R.Bottom - R.Top) - 50
    149. If .tPt.y > lPos Then .tPt.y = lPos
    150. SetWindowPos .hDlg, 0, .tPt.x, .tPt.y, 0, 0, &H1 ' &H1=SWP_NOSIZE
    151. End If
    153. GetWindowRect .hDlg, R ' Koordinaten der MsgBox holen
    154. PtKreuz.y = R.Top + 40 ' Position des
    155. PtKreuz.x = R.Right - 40 ' roten Systemkreuzes
    156. ' GWL_STYLE = (-16) ' System/Schließenkreuz auschalten
    157. If .bNoSysMenu Then _
    158. SetWindowLong .hDlg, -16, GetWindowLong(.hDlg, -16) And Not WS_SYSMENU
    160. Else ' Vierter Button (Help) wurde geklickt
    162. msBtn(2) = msBtn(9) ' Rückgabewert HelpBtn setzen
    163. PostMessageA .hDlg, &H10, 0&, 0& ' MsgBox schließen &H10=WM_CLOSE
    164. End If
    165. End With
    166. End Sub
    168. ' ########## Beispiele ##########
    169. ' Diese Sub's sind zum Testen
    170. ' Es können 1,2,3 oder 4 Buttons angezeigt werden => kommagetrennt angeben
    171. ' & vor einem Buchstaben stellt die Shortcut-Taste dar z.B. Alt-S usw.
    172. ' ¶ stellt einen Zeilenumbruch dar (vbLf)
    173. ' Über x und y kann die Position der MsgBox festgelegt oder an der Mausposition gestartet werden
    174. ' Zurückgegeben wird keine Nummer, sondern der Buttontext des geklickten Buttons
    176. Private Sub MeinMsgBoxTest1()
    177. Call MsgboxEx("ok")
    178. End Sub
    180. Private Sub Aufruftest1()
    181. MsgBox (MsgboxEx("Bitte wähle die Schlumpfaktion aus!", vbInformation, "Schlumpftest", _
    182. "Schlumpfe &aus,Schlumpfe &ein,Schlumpfe &um,My&Help", _
    183. "Image3", -1, -1))
    184. End Sub
    186. Private Sub MeinMsgBoxTest2()
    187. Select Case MsgboxEx("Bitte wähle eine Option aus!", vbExclamation, "Auswahl", _
    188. "Option &1,Option &2,Option &3,Option &4")
    189. Case "Option 1": MsgBox "Habe die Option 1 gewählt"
    190. Case "Option 2": MsgBox "Option 2 wurde gewählt"
    191. Case "Option 3": MsgBox "Option 3 ist gewählt worden"
    192. Case "Option 4": MsgBox "Du hast Option &4 gewählt"
    193. Case Else: MsgBox "Du hast abgebrochen"
    194. End Select
    195. End Sub


    Gruß
    Karl-Heinz

    Weil ich gerade etwas lange weile hatte, hier mal ein einfaches (unvollständiges) Beispiel mit der API SoftModalMessageBox (max. 11 Buttons). Ihr kennt mich ja, keine zusätzlichen Verweise oder Nuget-Pakete. ;)

    Eine Klasse MessageBoxEx
    Spoiler anzeigen
    ​

    VB.NET-Quellcode

    1. ​
    2. Imports System.Runtime.InteropServices
    4. Public Class MessageBoxEx
    6. #Region "APIs"
    7. <DllImport("User32.dll", EntryPoint:="MB_GetString")>
    8. Private Shared Function MB_GetString(<[In]> dwBtnId As MessageBoxCommandID) As IntPtr
    9. End Function
    11. <DllImport("User32.dll", EntryPoint:="SoftModalMessageBox")>
    12. Private Shared Function SoftModalMessageBox(<[In]> ByRef lpMbd As MSGBOXDATA) As MessageBoxCommandID
    13. End Function
    14. #End Region
    16. #Region "Enums"
    17. Public Enum MessageBoxCommandID As Integer
    18. ID_OK = 1
    19. ID_CANCEL = 2
    20. ID_ABORT = 3
    21. ID_RETRY = 4
    22. ID_IGNORE = 5
    23. ID_YES = 6
    24. ID_NO = 7
    25. ID_CLOSE = 8
    26. ID_HELP = 9
    27. ID_TRYAGAIN = 10
    28. ID_CONTINUE = 11
    29. ID_TIMEOUT = 32000
    30. End Enum
    32. Public Enum MessageBoxDefaultButton As Integer
    33. MB_DEFBUTTON1 = 0
    34. MB_DEFBUTTON2 = 1
    35. MB_DEFBUTTON3 = 2
    36. MB_DEFBUTTON4 = 3
    37. MB_DEFBUTTON5 = 4
    38. MB_DEFBUTTON6 = 5
    39. MB_DEFBUTTON7 = 6
    40. MB_DEFBUTTON8 = 7
    41. MB_DEFBUTTON9 = 8
    42. MB_DEFBUTTON10 = 9
    43. MB_DEFBUTTON11 = 10
    44. End Enum
    46. Public Enum MessageBoxButtons As Integer
    47. MB_OK = 0
    48. MB_OKCANCEL = 1
    49. MB_ABORTRETRYIGNORE = 2
    50. MB_YESNOCANCEL = 3
    51. MB_YESNO = 4
    52. MB_RETRYCANCEL = 5
    53. MB_CANCELTRYCONTINUE = 6
    55. MB_MyMessageBox = 7
    57. End Enum
    59. Private Enum MessageBoxFlags As Integer
    60. MB_APPLMODAL = &H0
    61. MB_SYSTEMMODAL = &H1000
    62. MB_TASKMODAL = &H2000
    63. MB_NOFOCUS = &H8000
    64. MB_SETFOREGROUND = &H10000
    65. MB_DEFAULT_DESKTOP_ONLY = &H20000
    66. MB_TOPMOST = &H40000
    67. MB_RIGHT = &H80000
    69. MB_RTLREADING = &H100000
    70. MB_SERVICE_NOTIFICATION = &H200000
    71. MB_SERVICE_NOTIFICATION_NT3X = &H40000
    73. MB_TYPEMASK = &HF
    74. MB_ICONMASK = &HF0
    75. MB_DEFMASK = &HF00
    76. MB_MODEMASK = &H3000
    77. MB_MISCMASK = &HC000
    78. End Enum
    80. Public Enum MessageBoxIcon As Integer
    81. MB_ICONNONE = &H0
    82. MB_ICONHAND = &H10
    83. MB_ICONSTOP = &H10
    84. MB_ICONERROR = &H10
    85. MB_ICONQUESTION = &H20
    86. MB_ICONWARNING = &H30
    87. MB_ICONEXCLAMATION = &H30
    88. MB_ICONASTERISK = &H40
    89. MB_ICONINFORMATION = &H40
    90. MB_USERICON = &H80
    91. End Enum
    93. #End Region
    95. #Region "Class"
    96. Public Sub New()
    97. For MBCommandID As MessageBoxCommandID = MessageBoxCommandID.ID_OK To MessageBoxCommandID.ID_CONTINUE
    98. m_DefaultMessageBoxButtonText.Add(MB_GetString(CType(MBCommandID - MessageBoxCommandID.ID_OK, MessageBoxCommandID)))
    99. Next
    100. End Sub
    101. #End Region
    103. #Region "Structures"
    105. ' https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-msgboxparamsw
    106. Private Structure MSGBOXPARAMS
    107. Dim cbSize As Integer
    108. Dim hWndOwner As IntPtr
    109. Dim hInstance As IntPtr
    110. <MarshalAs(UnmanagedType.LPWStr)> Dim lpszText As String
    111. <MarshalAs(UnmanagedType.LPWStr)> Dim lpszCaption As String
    112. Dim dwStyle As MessageBoxFlags
    113. <MarshalAs(UnmanagedType.LPWStr)> Dim lpszIcon As String
    114. Dim dwContextHelpId As Integer
    115. Dim lpfnMsgBoxCallback As IntPtr '-> MSGBOXCALLBACK -> struct HELPINFO
    116. Dim dwLanguageId As Integer
    117. End Structure
    119. Private Structure MSGBOXDATA
    120. Dim MBParams As MSGBOXPARAMS
    121. Dim pwndOwner As IntPtr
    122. Dim dwPadding As Integer
    123. Dim wLanguageId As Short
    124. Dim pidButton As IntPtr
    125. Dim ppszButtonText As IntPtr
    126. Dim cButtons As Integer
    127. Dim defButton As MessageBoxDefaultButton
    128. Dim cancelId As Integer
    129. Dim dwTimeout As Integer
    130. Dim phwndList As IntPtr
    131. <MarshalAs(UnmanagedType.ByValArray, SizeConst:=20)> Dim dwReserved As Integer()
    132. End Structure
    134. #End Region
    136. #Region "Variables"
    137. Private ReadOnly m_DefaultMessageBoxButtonText As New List(Of IntPtr)
    138. #End Region
    140. #Region "Functions"
    141. Public Function ShowDialog(Owner As IWin32Window,
    142. Caption As String,
    143. Text As String,
    144. Buttons As MessageBoxButtons,
    145. Icon As MessageBoxIcon,
    146. Optional DefaultButton As MessageBoxDefaultButton = MessageBoxDefaultButton.MB_DEFBUTTON1,
    147. Optional ShowHelpButton As Boolean = False,
    148. Optional TimeOut As Integer = -1) As MessageBoxCommandID
    150. Dim Ret As MessageBoxCommandID
    151. Dim IsCancelButton As Boolean
    152. Dim MBButtons As Integer() = Nothing
    153. Dim MBButtonsText As IntPtr() = Nothing
    155. Select Case Buttons
    156. Case MessageBoxButtons.MB_OK
    157. MBButtons = New Integer() {MessageBoxCommandID.ID_OK}
    158. MBButtonsText = New IntPtr() {m_DefaultMessageBoxButtonText(MBButtons(0) - MessageBoxCommandID.ID_OK)}
    159. Case MessageBoxButtons.MB_OKCANCEL
    160. IsCancelButton = True
    161. MBButtons = New Integer() {MessageBoxCommandID.ID_OK,
    162. MessageBoxCommandID.ID_CANCEL}
    163. MBButtonsText = New IntPtr() {m_DefaultMessageBoxButtonText(MBButtons(0) - MessageBoxCommandID.ID_OK),
    164. m_DefaultMessageBoxButtonText(MBButtons(1) - MessageBoxCommandID.ID_OK)}
    165. Case MessageBoxButtons.MB_ABORTRETRYIGNORE
    166. MBButtons = New Integer() {MessageBoxCommandID.ID_ABORT,
    167. MessageBoxCommandID.ID_RETRY,
    168. MessageBoxCommandID.ID_IGNORE}
    169. MBButtonsText = New IntPtr() {m_DefaultMessageBoxButtonText(MBButtons(0) - MessageBoxCommandID.ID_OK),
    170. m_DefaultMessageBoxButtonText(MBButtons(1) - MessageBoxCommandID.ID_OK),
    171. m_DefaultMessageBoxButtonText(MBButtons(2) - MessageBoxCommandID.ID_OK)}
    172. Case MessageBoxButtons.MB_YESNOCANCEL
    173. IsCancelButton = True
    174. MBButtons = New Integer() {MessageBoxCommandID.ID_YES,
    175. MessageBoxCommandID.ID_NO,
    176. MessageBoxCommandID.ID_CANCEL}
    177. MBButtonsText = New IntPtr() {m_DefaultMessageBoxButtonText(MBButtons(0) - MessageBoxCommandID.ID_OK),
    178. m_DefaultMessageBoxButtonText(MBButtons(1) - MessageBoxCommandID.ID_OK),
    179. m_DefaultMessageBoxButtonText(MBButtons(2) - MessageBoxCommandID.ID_OK)}
    180. Case MessageBoxButtons.MB_YESNO
    181. MBButtons = New Integer() {MessageBoxCommandID.ID_YES,
    182. MessageBoxCommandID.ID_NO}
    183. MBButtonsText = New IntPtr() {m_DefaultMessageBoxButtonText(MBButtons(0) - MessageBoxCommandID.ID_OK),
    184. m_DefaultMessageBoxButtonText(MBButtons(1) - MessageBoxCommandID.ID_OK)}
    185. Case MessageBoxButtons.MB_RETRYCANCEL
    186. IsCancelButton = True
    187. MBButtons = New Integer() {MessageBoxCommandID.ID_RETRY,
    188. MessageBoxCommandID.ID_CANCEL}
    189. MBButtonsText = New IntPtr() {m_DefaultMessageBoxButtonText(MBButtons(0) - MessageBoxCommandID.ID_OK),
    190. m_DefaultMessageBoxButtonText(MBButtons(1) - MessageBoxCommandID.ID_OK)}
    191. Case MessageBoxButtons.MB_CANCELTRYCONTINUE
    192. IsCancelButton = True
    193. MBButtons = New Integer() {MessageBoxCommandID.ID_CANCEL,
    194. MessageBoxCommandID.ID_TRYAGAIN,
    195. MessageBoxCommandID.ID_CONTINUE}
    196. MBButtonsText = New IntPtr() {m_DefaultMessageBoxButtonText(MBButtons(0) - MessageBoxCommandID.ID_OK),
    197. m_DefaultMessageBoxButtonText(MBButtons(1) - MessageBoxCommandID.ID_OK),
    198. m_DefaultMessageBoxButtonText(MBButtons(2) - MessageBoxCommandID.ID_OK)}
    199. Case MessageBoxButtons.MB_MyMessageBox
    200. IsCancelButton = True
    201. MBButtons = New Integer() {MessageBoxCommandID.ID_OK,
    202. MessageBoxCommandID.ID_CANCEL,
    203. MessageBoxCommandID.ID_ABORT,
    204. MessageBoxCommandID.ID_RETRY,
    205. MessageBoxCommandID.ID_IGNORE,
    206. MessageBoxCommandID.ID_YES,
    207. MessageBoxCommandID.ID_NO,
    208. MessageBoxCommandID.ID_CLOSE,
    209. MessageBoxCommandID.ID_TRYAGAIN,
    210. MessageBoxCommandID.ID_CONTINUE}
    211. MBButtonsText = New IntPtr() {Marshal.StringToHGlobalUni("1"),
    212. Marshal.StringToHGlobalUni("2"),
    213. Marshal.StringToHGlobalUni("3"),
    214. Marshal.StringToHGlobalUni("4"),
    215. Marshal.StringToHGlobalUni("5"),
    216. Marshal.StringToHGlobalUni("6"),
    217. Marshal.StringToHGlobalUni("7"),
    218. Marshal.StringToHGlobalUni("8"),
    219. Marshal.StringToHGlobalUni("9"),
    220. Marshal.StringToHGlobalUni("10")}
    221. End Select
    223. '-> MSGBOXCALLBACK -> struct HELPINFO
    224. If ShowHelpButton Then
    225. Array.Resize(MBButtons, MBButtons.Length + 1)
    226. Array.Resize(MBButtonsText, MBButtonsText.Length + 1)
    227. MBButtons(MBButtons.Length - 1) = MessageBoxCommandID.ID_HELP
    228. MBButtonsText(MBButtonsText.Length - 1) = m_DefaultMessageBoxButtonText(MBButtons(MBButtons.Length - 1) - MessageBoxCommandID.ID_OK)
    229. End If
    231. Dim hMBButtons As GCHandle = GCHandle.Alloc(MBButtons, GCHandleType.Pinned)
    232. Dim hMBButtonsText As GCHandle = GCHandle.Alloc(MBButtonsText, GCHandleType.Pinned)
    234. Dim MBData As New MSGBOXDATA
    235. MBData.MBParams.cbSize = Marshal.SizeOf(Of MSGBOXDATA)
    236. MBData.MBParams.hWndOwner = Owner.Handle
    237. MBData.MBParams.hInstance = Marshal.GetHINSTANCE(GetType(MessageBoxEx).Module)
    238. MBData.MBParams.lpszText = Text
    239. MBData.MBParams.lpszCaption = Caption
    240. MBData.MBParams.dwStyle = CType(MessageBoxFlags.MB_TYPEMASK Or Icon, MessageBoxFlags)
    241. MBData.MBParams.lpszIcon = Nothing
    242. MBData.MBParams.dwContextHelpId = 0
    243. MBData.MBParams.lpfnMsgBoxCallback = IntPtr.Zero '-> MSGBOXCALLBACK -> struct HELPINFO
    244. MBData.MBParams.dwLanguageId = 0
    246. MBData.pwndOwner = IntPtr.Zero
    247. MBData.dwPadding = 0
    248. MBData.wLanguageId = 0
    249. MBData.pidButton = hMBButtons.AddrOfPinnedObject
    250. MBData.ppszButtonText = hMBButtonsText.AddrOfPinnedObject
    251. MBData.cButtons = MBButtons.Length
    252. MBData.defButton = If(DefaultButton <= MBButtons.Length, DefaultButton, CType(MBButtons.Length, MessageBoxDefaultButton))
    253. MBData.cancelId = If(IsCancelButton, MessageBoxCommandID.ID_CANCEL, 0) 'geht nur wenn ein Cancel-Button im Dialog ist
    254. MBData.dwTimeout = If(TimeOut < -1, -1, TimeOut) 'in Millisekunden
    255. MBData.phwndList = IntPtr.Zero
    257. Ret = SoftModalMessageBox(MBData)
    259. hMBButtonsText.Free()
    260. hMBButtons.Free()
    262. If Buttons = MessageBoxButtons.MB_MyMessageBox Then
    263. For Index = 0 To If(ShowHelpButton, MBButtonsText.Length - 2, MBButtonsText.Length - 1)
    264. Marshal.FreeHGlobal(MBButtonsText(Index))
    265. Next
    266. End If
    268. Return Ret
    269. End Function
    270. #End Region
    272. End Class


    und zum testen in der Form

    VB.NET-Quellcode

    1. ​
    2. Public Class Form1
    3. Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    4. Dim MBEx As New MessageBoxEx
    5. Debug.Print(MBEx.ShowDialog(Me, "Caption", "Text",
    6. MessageBoxEx.MessageBoxButtons.MB_MyMessageBox,
    7. MessageBoxEx.MessageBoxIcon.MB_ICONWARNING,
    8. MessageBoxEx.MessageBoxDefaultButton.MB_DEFBUTTON1,
    9. True, -1).ToString)
    10. End Sub
    11. End Class
    Mfg -Franky-

    Hallo Franky,

    vielen Dank für Deinen Input zur Funktion SoftModalMessageBox. Finde ich sehr interessant. Sie fehlte noch in meinem API-Viewer, wo ich sie jetzt aufnehmen werde.

    Da ich zur Zeit mit VBA unterwegs bin, habe ich mich daran gemacht, das Ganze unter VBA zum Laufen zu bringen. Hierzu gibt es im Netz leider keine bzw. nur weinige widersprüchliche Beiträge.
    Und Dein Code bringt mich auch nicht weiter.

    Meine eigenen Interpretationen (s. Code) lassen leider Excel abstürzen.
    Vielleicht hast Du ja (auch wenn es nicht VB.Net ist) eine Idee, was da noch fehlerhaft sein könnte.

    M.E. könnte es an der Übergabe der Arrays liegen.

    Visual Basic-Quellcode

    1. ​Private Type MSGBOXPARAMS
    2. cbSize As Long
    3. hwndOwner As LongPtr
    4. hInstance As LongPtr
    5. lpszText As String
    6. lpszCaption As String
    7. dwStyle As Long
    8. lpszIcon As String
    9. dwContextHelpId As LongPtr
    10. lpfnMsgBoxCallback As LongPtr
    11. dwLanguageId As Long
    12. End Type
    14. Private Type MSGBOXDATA
    15. params As MSGBOXPARAMS
    16. pwndOwner As LongPtr ' Nur intern
    17. Padding As Long
    18. wLanguageId As Long
    19. pidButton As LongPtr ' Array (Button-IDs)
    20. ppszButtonText As LongPtr ' Array (Buttontext)
    21. cButtons As Long ' Anzahl der Buttons
    22. DefButton As Long ' Button-ID Default
    23. CancelId As Long ' Button-ID Abbruch
    24. Timeout As Long ' Timeout
    25. phwndList As LongPtr ' Nur intern
    26. Reserved As Long ' Reserviert
    27. End Type
    29. Private Declare PtrSafe Function SoftModalMessageBox Lib "user32" (pMsgBoxParams As MSGBOXDATA) As Long
    31. Function MsgboxEx()
    32. Dim md As MSGBOXDATA
    33. Dim lArrBtn() As Variant, sArrTxt() As String
    35. lArrBtn = Array(1, 2, 3, 4)
    36. sArrTxt = Split("Option 1,Option 2,Option 3,Option 4", ",")
    38. With md
    39. With .params
    40. .cbSize = LenB(md.params)
    41. .lpszText = "Mein Messagetext"
    42. .lpszCaption = "Mein MsgBox-Kopf"
    43. .dwStyle = vbQuestion Or vbYesNoCancel
    44. End With
    45. .DefButton = 0
    46. .CancelId = 2
    47. .cButtons = 4
    48. .pidButton = VarPtr(lArrBtn(0))
    49. .ppszButtonText = VarPtr(sArrTxt(0))
    50. .Timeout = -1
    51. End With
    52. MsgboxEx = sArrTxt(SoftModalMessageBox(md))
    53. End Function


    Gruß
    Karl-Heinz

    @volti VBA ist nicht meine favorisierte Programmiersprache. VB6 schon eher und VBA ist da ja sehr ähnlich. Den VB.Net Code habe ich von meinem VB6 Code übersetzt. Die lpszXXXX Member in MSGBOXPARAMS sind in VB6 ein Long und werden mit lpszXXXX = StrPtr("xxx") gefüttert. In VBA müssten dann wohl die lpszXXXX ein LongPtr sein. Ich könnte am Montag bei Bedarf auch noch meinen VB6 Code hier posten. Das lässt sich sicher leichter nach VBA übersetzen.

    Edit: wLanguageId müsste in VBA ein Integer sein. Ist in meinem VB6 Bsp. glaub auch so.
    Mfg -Franky-

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „-Franky-“ ()

    Super Franky,

    da bin ich mal gespannt.

    PS: Ich habe hier MS-Office 64 Bit.
    Die lpszXXXX = StrPtr("xxx") setze ich in anderen Beispielen bei mir auch als STRING ein, das funktioniert dann ohne StrPtr. Ich hatte es aber auch hier schon mit LongPtr und StrPtr("xxx") probiert.

    Gruß KH

    @volti Moin. Wie versprochen hier mein VB6 Code dazu.

    Alles in einer Klasse clsMessageBox
    Spoiler anzeigen
    ​

    Visual Basic-Quellcode

    1. ​
    2. Option Explicit
    4. ' ----==== Enums ====----
    5. Public Enum MessageBoxCommandID
    6. ID_OK = 1
    7. ID_CANCEL = 2
    8. ID_ABORT = 3
    9. ID_RETRY = 4
    10. ID_IGNORE = 5
    11. ID_YES = 6
    12. ID_NO = 7
    13. ID_CLOSE = 8
    14. ID_HELP = 9
    15. ID_TRYAGAIN = 10
    16. ID_CONTINUE = 11
    17. ID_TIMEOUT = 32000
    18. End Enum
    20. Public Enum MessageBoxButtons
    21. MB_OK = &H0&
    22. MB_OKCANCEL = &H1&
    23. MB_ABORTRETRYIGNORE = &H2&
    24. MB_YESNOCANCEL = &H3&
    25. MB_YESNO = &H4&
    26. MB_RETRYCANCEL = &H5&
    27. MB_CANCELTRYCONTINUE = &H6&
    28. End Enum
    30. Public Enum MessageBoxIcon
    31. MB_ICONNONE = &H0&
    32. MB_ICONHAND = &H10&
    33. MB_ICONSTOP = &H10&
    34. MB_ICONERROR = &H10&
    35. MB_ICONQUESTION = &H20&
    36. MB_ICONWARNING = &H30&
    37. MB_ICONEXCLAMATION = &H30&
    38. MB_ICONASTERISK = &H40&
    39. MB_ICONINFORMATION = &H40&
    40. MB_USERICON = &H80&
    41. End Enum
    43. Public Enum MessageBoxDefaultButton
    44. MB_DEFBUTTON1 = 0
    45. MB_DEFBUTTON2 = 1
    46. MB_DEFBUTTON3 = 2
    47. MB_DEFBUTTON4 = 3
    48. MB_DEFBUTTON5 = 4
    49. MB_DEFBUTTON6 = 5
    50. MB_DEFBUTTON7 = 6
    51. MB_DEFBUTTON8 = 7
    52. MB_DEFBUTTON9 = 8
    53. MB_DEFBUTTON10 = 9
    54. MB_DEFBUTTON11 = 10
    55. End Enum
    57. Private Enum MessageBoxFlags
    58. MB_APPLMODAL = &H0
    59. MB_SYSTEMMODAL = &H1000
    60. MB_TASKMODAL = &H2000
    61. MB_NOFOCUS = &H8000
    62. MB_SETFOREGROUND = &H10000
    63. MB_DEFAULT_DESKTOP_ONLY = &H20000
    64. MB_TOPMOST = &H40000
    65. MB_RIGHT = &H80000
    67. MB_RTLREADING = &H100000
    68. MB_SERVICE_NOTIFICATION = &H200000
    69. MB_SERVICE_NOTIFICATION_NT3X = &H40000
    71. MB_TYPEMASK = &HF
    72. MB_ICONMASK = &HF0
    73. MB_DEFMASK = &HF00
    74. MB_MODEMASK = &H3000
    75. MB_MISCMASK = &HC000
    76. End Enum
    78. ' ----==== Types ====----
    79. Private Type MSGBOXPARAMS
    80. cbSize As Long
    81. hWndOwner As Long
    82. hInstance As Long
    83. lpszText As Long
    84. lpszCaption As Long
    85. dwStyle As Long
    86. lpszIcon As Long
    87. dwContextHelpId As Long
    88. lpfnMsgBoxCallback As Long
    89. dwLanguageId As Long
    90. End Type
    92. Private Type MSGBOXDATA
    93. PARAMS As MSGBOXPARAMS
    94. pwndOwner As Long
    95. dwPadding As Long
    96. wLanguageId As Integer
    97. pidButton As Long
    98. ppszButtonText As Long
    99. cButtons As Long
    100. defButton As Long
    101. cancelId As Long
    102. dwTimeout As Long
    103. phwndList As Long
    104. dwReserved(19) As Long
    105. End Type
    107. ' ----==== User32.dll Declarations ====----
    108. Private Declare Function MB_GetString Lib "User32.dll" ( _
    109. ByVal wBtn As MessageBoxCommandID) As Long
    111. Private Declare Function SoftModalMessageBox Lib "User32.dll" ( _
    112. ByRef lpmb As MSGBOXDATA) As Long
    114. ' ----==== Kernel32 Declarations ====----
    115. Private Declare Function LoadLibraryW Lib "Kernel32.dll" ( _
    116. ByVal lpLibName As Long) As Long
    118. Private Declare Function FreeLibrary Lib "Kernel32.dll" ( _
    119. ByVal hModule As Long) As Long
    121. Private Declare Function GetProcAddress Lib "Kernel32.dll" ( _
    122. ByVal hModule As Long, _
    123. ByVal lpProcName As String) As Long
    125. ' ----==== Variables ====----
    126. Private m_DefaultDialogBoxCommandText(1 To 11) As Long
    128. ' ----==== Class ====----
    129. Private Sub Class_Initialize()
    130. Dim CommandID As MessageBoxCommandID
    131. For CommandID = ID_OK To ID_CONTINUE
    132. m_DefaultDialogBoxCommandText(CommandID) = MB_GetString(CommandID - ID_OK)
    133. Next
    134. End Sub
    136. Private Sub Class_Terminate()
    137. '
    138. End Sub
    140. ' ----==== Functions ====----
    141. Public Function MessageBox(ByVal hWndOwner As Long, _
    142. ByVal Caption As String, _
    143. ByVal Text As String, _
    144. ByVal Buttons As MessageBoxButtons, _
    145. ByVal Icon As MessageBoxIcon, _
    146. Optional ByVal ShowHelpButton As Boolean = False, _
    147. Optional ByVal DefaultButton As MessageBoxDefaultButton = MB_DEFBUTTON1, _
    148. Optional ByVal TimeOut As Long = -1&) As MessageBoxCommandID
    150. Dim MBButtons() As MessageBoxCommandID
    151. Dim MBButtonsText() As Long
    152. Dim IsCancelButton As Boolean
    153. Dim Ret As MessageBoxCommandID
    155. If IsSoftModalMessageBoxExists Then
    157. Select Case Buttons
    158. Case MessageBoxButtons.MB_OK
    159. ReDim MBButtons(0)
    160. ReDim MBButtonsText(0)
    161. MBButtons(0) = ID_OK
    162. MBButtonsText(0) = m_DefaultDialogBoxCommandText(MBButtons(0))
    164. Case MessageBoxButtons.MB_OKCANCEL
    165. IsCancelButton = True
    166. ReDim MBButtons(1)
    167. ReDim MBButtonsText(1)
    168. MBButtons(0) = ID_OK
    169. MBButtons(1) = ID_CANCEL
    170. MBButtonsText(0) = m_DefaultDialogBoxCommandText(MBButtons(0))
    171. MBButtonsText(1) = m_DefaultDialogBoxCommandText(MBButtons(1))
    173. Case MessageBoxButtons.MB_ABORTRETRYIGNORE
    174. ReDim MBButtons(2)
    175. ReDim MBButtonsText(2)
    176. MBButtons(0) = ID_ABORT
    177. MBButtons(1) = ID_RETRY
    178. MBButtons(2) = ID_IGNORE
    179. MBButtonsText(0) = m_DefaultDialogBoxCommandText(MBButtons(0))
    180. MBButtonsText(1) = m_DefaultDialogBoxCommandText(MBButtons(1))
    181. MBButtonsText(2) = m_DefaultDialogBoxCommandText(MBButtons(2))
    183. Case MessageBoxButtons.MB_YESNOCANCEL
    184. IsCancelButton = True
    185. ReDim MBButtons(2)
    186. ReDim MBButtonsText(2)
    187. MBButtons(0) = ID_YES
    188. MBButtons(1) = ID_NO
    189. MBButtons(2) = ID_CANCEL
    190. MBButtonsText(0) = m_DefaultDialogBoxCommandText(MBButtons(0))
    191. MBButtonsText(1) = m_DefaultDialogBoxCommandText(MBButtons(1))
    192. MBButtonsText(2) = m_DefaultDialogBoxCommandText(MBButtons(2))
    194. Case MessageBoxButtons.MB_YESNO
    195. ReDim MBButtons(1)
    196. ReDim MBButtonsText(1)
    197. MBButtons(0) = ID_YES
    198. MBButtons(1) = ID_NO
    199. MBButtonsText(0) = m_DefaultDialogBoxCommandText(MBButtons(0))
    200. MBButtonsText(1) = m_DefaultDialogBoxCommandText(MBButtons(1))
    202. Case MessageBoxButtons.MB_RETRYCANCEL
    203. IsCancelButton = True
    204. ReDim MBButtons(1)
    205. ReDim MBButtonsText(1)
    206. MBButtons(0) = ID_RETRY
    207. MBButtons(1) = ID_CANCEL
    208. MBButtonsText(0) = m_DefaultDialogBoxCommandText(MBButtons(0))
    209. MBButtonsText(1) = m_DefaultDialogBoxCommandText(MBButtons(1))
    211. Case MessageBoxButtons.MB_CANCELTRYCONTINUE
    212. IsCancelButton = True
    213. ReDim MBButtons(2)
    214. ReDim MBButtonsText(2)
    215. MBButtons(0) = ID_CANCEL
    216. MBButtons(1) = ID_TRYAGAIN
    217. MBButtons(2) = ID_CONTINUE
    218. MBButtonsText(0) = m_DefaultDialogBoxCommandText(MBButtons(0))
    219. MBButtonsText(1) = m_DefaultDialogBoxCommandText(MBButtons(1))
    220. MBButtonsText(2) = m_DefaultDialogBoxCommandText(MBButtons(2))
    222. End Select
    224. If ShowHelpButton Then
    225. ReDim Preserve MBButtons(UBound(MBButtons) + 1)
    226. ReDim Preserve MBButtonsText(UBound(MBButtons) + 1)
    227. MBButtons(UBound(MBButtons)) = MessageBoxCommandID.ID_HELP
    228. MBButtonsText(UBound(MBButtons)) = m_DefaultDialogBoxCommandText(MBButtons(UBound(MBButtons)))
    229. End If
    231. Dim MBDATA As MSGBOXDATA
    233. With MBDATA
    234. .PARAMS.cbSize = Len(MBDATA)
    235. .PARAMS.hWndOwner = hWndOwner
    236. .PARAMS.hInstance = App.hInstance
    237. .PARAMS.lpszText = StrPtr(Text)
    238. .PARAMS.lpszCaption = StrPtr(Caption)
    239. .PARAMS.dwStyle = MessageBoxFlags.MB_TYPEMASK Or Icon
    240. .PARAMS.lpszIcon = 0&
    241. .PARAMS.dwContextHelpId = 0&
    242. .PARAMS.lpfnMsgBoxCallback = 0&
    243. .PARAMS.dwLanguageId = 0&
    245. .pwndOwner = 0&
    246. .dwPadding = 0&
    247. .wLanguageId = 0&
    248. .pidButton = VarPtr(MBButtons(0))
    249. .ppszButtonText = VarPtr(MBButtonsText(0))
    250. .cButtons = UBound(MBButtons) + 1
    251. .defButton = DefaultButton
    252. .cancelId = IIf(IsCancelButton, MessageBoxCommandID.ID_CANCEL, 0&)
    253. .dwTimeout = TimeOut
    254. .phwndList = 0&
    255. End With
    257. Ret = SoftModalMessageBox(MBDATA)
    259. End If
    261. MessageBox = Ret
    263. End Function
    265. Private Function IsSoftModalMessageBoxExists() As Boolean
    266. Dim Ret As Boolean
    267. Dim hModule As Long
    268. hModule = LoadLibraryW(StrPtr("User32.dll"))
    269. If hModule <> 0& Then
    270. Ret = CBool(GetProcAddress(hModule, "SoftModalMessageBox"))
    271. Call FreeLibrary(hModule)
    272. End If
    273. IsSoftModalMessageBoxExists = Ret
    274. End Function


    und aus der Form heraus

    Visual Basic-Quellcode

    1. ​
    2. Option Explicit
    4. Private Sub Command1_Click()
    5. Dim cMessageBox As New clsMessageBox
    6. Debug.Print cMessageBox.MessageBox(Me.hWnd, "Caption", "Text", _
    7. MB_OKCANCEL, MB_ICONEXCLAMATION, _
    8. True, MB_DEFBUTTON1, -1)
    9. End Sub

    Du musst hier mit StrPtr arbeiten da zb. lpszText ein LPCWSTR ist. Also LongPointerConstantWideString. MB_GetString gibt Dir ebenfalls einen Pointer auf einen WideString zurück (LPCWSTR).
    Mfg -Franky-

    Hallo,

    ich habe es jetzt zum Laufen gebracht. Danke noch mal Franky, das hat mir sehr geholfen.

    Auch wenn meine Minimalversion deutlich von Deiner abweicht, u.a. auch weil ich keine Nummer sondern den Buttontext zurückgeben will usw. funktioniert jetzt diese Minimalversion unter VBA zu meiner vollste Zufriedenheit.
    Als nächstes werde ich mich mal an alternative Icons, die Schriftfarben-, größen usw. machen. Mal sehen, ob's klappt.
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Option Explicit
    3. Private Declare PtrSafe Function GetProcAddress Lib "kernel32" ( _
    4. ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
    5. Private Declare PtrSafe Function LoadLibraryA Lib "kernel32" ( _
    6. ByVal lpLibFileName As String) As LongPtr
    7. Private Declare PtrSafe Function FreeLibrary Lib "kernel32" ( _
    8. ByVal hLibModule As LongPtr) As Long
    10. Private Type MSGBOXPARAMS
    11. cbSize As Long
    12. hWndOwner As LongPtr
    13. hInstance As LongPtr
    14. lpszText As LongPtr
    15. lpszCaption As LongPtr
    16. dwStyle As Long
    17. lpszIcon As LongPtr
    18. dwContextHelpId As Long
    19. lpfnMsgBoxCallback As LongPtr
    20. dwLanguageId As Long
    21. End Type
    23. Private Type MSGBOXDATA
    24. PARAMS As MSGBOXPARAMS
    25. pwndOwner As LongPtr ' Nur intern
    26. dwPadding As Long
    27. wLanguageId As Long
    28. pidButton As LongPtr ' Array (Button-IDs)
    29. ppszButtonText As LongPtr ' Array (Buttontext)
    30. cButtons As Long ' Anzahl der Buttons
    31. defButton As Long ' Button-ID Default
    32. cancelId As Long ' Button-ID Abbruch
    33. Timeout As Long ' Timeout
    34. phwndList As LongPtr ' Nur intern
    35. dwReserved(19) As Long ' Reserviert
    36. End Type
    38. Private Declare PtrSafe Function SoftModalMessageBox Lib "user32" (pMsgBoxParams As MSGBOXDATA) As Long
    40. Function MsgboxEx(ByVal sText As String, _
    41. Optional ByVal sBtns As String = "OK", _
    42. Optional ByVal sCaption As String = "Microsoft Excel", _
    43. Optional ByVal iIcon As Long, _
    44. Optional ByVal iTimeOut As Long, _
    45. Optional ByVal iDefBtn As Long) As String
    46. Dim md As MSGBOXDATA
    47. Dim lArrBtn() As Long, sArrTxt() As String, i As Long
    48. Dim hModul As LongPtr, hRet As LongPtr
    50. hModul = LoadLibraryA("User32.dll") ' Bibliothek laden
    51. If hModul <> 0& Then
    52. hRet = GetProcAddress(hModul, "SoftModalMessageBox") ' Funktion vorhanden?
    53. FreeLibrary hModul ' Bibliothek schließen
    54. End If
    55. If hRet = 0 Then Exit Function ' Anzeige nicht möglich
    57. sArrTxt = Split(sBtns, ",") ' Buttontexte in Array
    58. ReDim lArrBtn(UBound(sArrTxt)) ' ID-Array dimensionieren
    59. For i = 0 To UBound(lArrBtn): lArrBtn(i) = i + 1: Next i ' IDs in Array setzen
    61. With md
    62. With .PARAMS
    63. .cbSize = LenB(md.PARAMS)
    64. .hWndOwner = Application.hwnd ' Excel-Handle
    65. .hInstance = Application.HinstancePtr ' Excel-Instance
    66. .lpszText = StrPtr(sText) ' Messagetext
    67. .lpszCaption = StrPtr(sCaption) ' Titel
    68. .dwStyle = iIcon ' Icon setzen
    69. End With
    70. .cancelId = 0
    71. .cButtons = UBound(lArrBtn) + 1 ' Anzahl der Buttons
    72. If iDefBtn = 0 Or iDefBtn > .cButtons Then iDefBtn = 1
    73. .defButton = (iDefBtn - 1) ' DefaultButtonID
    74. .pidButton = VarPtr(lArrBtn(0)) ' IDs übergeben
    75. .ppszButtonText = VarPtr(sArrTxt(0)) ' Buttontexte übergeben
    76. .Timeout = (iTimeOut - 1) ' Timeout setzen, 0=abgeschaltet
    77. End With
    79. i = SoftModalMessageBox(md) ' MsgBox anzeigen
    80. If i = 32000 Then
    81. MsgboxEx = "Timeout"
    82. Else
    83. MsgboxEx = sArrTxt(i - 1) ' Ergebnistext zurückgeben
    84. End If
    85. End Function
    87. Sub Test()
    88. MsgBox MsgboxEx("Bitte wähle eine Option aus!", "Option 1,Option 2,Option 3,Option 4", "Meine Auswahl", vbExclamation, 0, 1)
    89. End Sub


    Wie sicher ist diese nicht dokumentiert Funktion? Kann es sein, dass die mal weg ist oder nicht bei jedem User vorhanden ist?
    Ich habe auch eine Vorhandenseinprüfung über die User32-DLL gemacht. Aber brauche ich die überhaupt?

    Gruß
    Karl-Heinz

    volti schrieb:

    Wie sicher ist diese nicht dokumentiert Funktion? Kann es sein, dass die mal weg ist oder nicht bei jedem User vorhanden ist?
    Ich habe auch eine Vorhandenseinprüfung über die User32-DLL gemacht. Aber brauche ich die überhaupt?

    Die Funktion gibt es schon lange, der VB6 Code entstand unter Win7, und ja, die ist bei allen, die auf einem noch supporteten Windows unterwegs sind, vorhanden. Die Prüfung, ob eine bestimmte Funktion aus einer DLL exportiert wird, kannst Du auch weglassen wenn Du nicht noch für kleiner Win7 entwickelst. Es war schon immer so das viele Funktionen in Windows zuerst nicht dokumentiert sind, nicht mal über einen Namen, sonder nur über deren OrdinalNummer, aus der DLL angesprochen werden konnten. Irgendwann waren die Funktionen offiziell dokumentiert und konnten, wie jede andere DLL-Funktion angesprochen werden. Wenn ich mir das Diagram auf github.com/imgdrive/SoftModalMessageBox anschau, wird diese API sowieso von allen anderen MessageBox-APIs angesprochen. Da kann man auch direkt die API verwenden und hat nicht die Einschränkungen die die anderen MessageBox-APIs so mitbringen. Wenn MS diese API nur über die OrdinalNummer verfügbar gemacht hätte, würde ich auch sagen, Finger davon weg. Windows ist dafür bekannt abwärts kompatibel zu sein. Bedeutet viele Funktionen die schon lange als deprecated eingestuft wurden, gibt es heute noch und können immer noch verwendet werden. Intern wird dann meist auf die neueren Funktionen umgeleitet bzw die veraltete Funktion gibt halt einen Fehlercode zurück. Ansonsten kannst Du auch mal in den SourceCode von WinXP schauen der 2020, versehentlich (hust), geleakt wurde ob es da schon entsprechende Funktion gab. ;)
    Mfg -Franky-

    Danke für Deine umfangreichen Informationen.

    Es hat funktioniert. Aber jetzt liefert die Funktion plötzlich nur noch 1 als Rückgabe, egal welchen Button ich klicke und auch bei Klick auf das Systemkreuz kommt statt 32000 nur noch ein Rückgabewert 1.
    Ich habe, soweit wie ich weiß, nichts gegenüber der funktionierenden Version gemacht und krieg es nicht mehr hin.

    Ist Dir das auch schon untergekommen?

    Gruß KH

    volti schrieb:

    Ist Dir das auch schon untergekommen?
    Nope, funktioniert bei mir wie es soll. ID_TIMEOUT (32000) kommt wenn ein TimeOut > -1 ist. Ansonsten der ID_xxx von dem Button den ich anklicke. ID_HELP muss entweder über eine MSGBOXCALLBACK behandelt werden wenn lpfnMsgBoxCallback <> IntPtr.Zero (Pointer auf die CallBack-Funktion) ist. Bei lpfnMsgBoxCallback = IntPtr.Zero über den MessageLoop vom im hwndOwner angegebenen Fenster -> Message WM_HELP. cancelId sollte nur dann auf ID_CANCEL gesetzt werden, wenn es auch einen Button mit ID_CANCEL gibt, ansonsten = 0. Nur dann lässt sich der Dialog auch über das X scließen und dann gibt die API entsprechend auch ID_CANCEL zurück.
    Mfg -Franky-

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „-Franky-“ ()

    volti schrieb:

    plötzlich nur noch 1 als Rückgabe,
    Poste mal Deinen Code / Dein Projekt.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!