title image


Smiley Re: Geht doch
In Form:

Private Sub Command1_Click()

Dim nButton As Long



nButton = CoolBox(Me.Hwnd, _

"Treffen Sie eine Wahl", "Frage", _

"Neu", "Anfügen", "Löschen", _

CoolBoxIcon.Question)



If nButton = 1 Then

MsgBox "Neu wurde gedrückt"

End If



If nButton = 2 Then

MsgBox "Anfügen wurde gedrückt"

End If



If nButton = 3 Then

MsgBox "Löschen wurde gedrückt"

End If



End Sub











In Modul:

Option Explicit



' Benötigte API's für die Timer-Steuerung

Private Declare Function SetTimer Lib "user32" ( _

ByVal Hwnd As Long, _

ByVal nIDEvent As Long, _

ByVal uElapse As Long, _

ByVal lpTimer As Long) As Long



Private Declare Function KillTimer Lib "user32" ( _

ByVal Hwnd As Long, _

ByVal nIDEvent As Long) As Long



Private Const MY_NID = 88

Private Const MY_ELAPSE = 25 ' Wartezeit: 25 MSek.



' Benötigte API's für das Manipulieren der MsgBox

Private Declare Function MessageBox Lib "user32" _

Alias "MessageBoxA" ( _

ByVal Hwnd As Long, _

ByVal lpText As String, _

ByVal lpCaption As String, _

ByVal wType As Long) As Long



Private Declare Function GetActiveWindow _

Lib "user32" () As Long



Private Declare Function SendDlgItemMessage Lib "USER32.DLL" _

Alias "SendDlgItemMessageA" ( _

ByVal hDlg As Long, _

ByVal nIDDlgItem As Long, _

ByVal wMsg As Long, _

ByVal wParam As Long, _

ByVal lParam As String) As Long



' Benötigte Konstanten

Private Const WM_SETTEXT = &HC



' MsgBox-Bildsymbole

Public Enum CoolBoxIcon

Critical = 16

Question = 32

Exclamation = 48

Information = 64

End Enum



' Variablen zur Speicherung der gewünschten

' Buttonbeschriftung

Private m_Caption1 As String

Private m_Caption2 As String

Private m_Caption3 As String



' WindowHandle

Private m_hWnd As Long



' MsgBox anzeigen

Public Function CoolBox(ByVal Hwnd As Long, _

ByVal Text As String, _

ByVal Title As String, _

ByVal Button1 As String, _

Optional ByVal Button2 As String, _

Optional ByVal Button3 As String, _

Optional ByVal Symbol As CoolBoxIcon) As Long



Dim nResult As Long



' Fensterhandle

m_hWnd = Hwnd



' Beschriftung der Buttons

m_Caption1 = Button1

m_Caption2 = Button2

m_Caption3 = Button3



' API-Timer starten

nResult = SetTimer(m_hWnd, MY_NID, MY_ELAPSE, _

AddressOf Coolbox_TimerEvent)



' API Message-Box mit gewünschter Buttonalzahl aufrufen

If Button2 = "" And Button3 = "" Then

'Ein Button

nResult = MessageBox(m_hWnd, Text, Title, _

Symbol Or vbOKOnly)



ElseIf Button2 "" And Button3 = "" Then

' Zwei Buttons

nResult = MessageBox(m_hWnd, Text, Title, _

Symbol Or vbYesNo)



Else

' Drei Buttons

nResult = MessageBox(m_hWnd, Text, Title, _

Symbol Or vbAbortRetryIgnore)

End If



' Antwort auswerten und Rückgabewert festlegen

If nResult = 1 Or nResult = 3 Or nResult = 6 Then

' erster Button wurde gedrückt

CoolBox = 1



ElseIf nResult = 4 Or nResult = 7 Then

' zweiter Button wurde gedrückt

CoolBox = 2



Else

' dritter Button wurde gedrückt

CoolBox = 3

End If

End Function



' Timer-Event!

Sub Coolbox_TimerEvent()

Dim nWnd As Long



' API-Timer wieder deaktivieren

KillTimer m_hWnd, MY_NID



' Fensterhandle der MsgBox

nWnd = GetActiveWindow()



' Buttons neu beschriften

If m_Caption2 = "" And m_Caption3 = "" Then

' nur ein Button

SendDlgItemMessage nWnd, vbCancel, WM_SETTEXT, 0, m_Caption1



ElseIf m_Caption2 "" And m_Caption3 = "" Then

' Zwei Buttons

SendDlgItemMessage nWnd, vbYes, WM_SETTEXT, 0, m_Caption1

SendDlgItemMessage nWnd, vbNo, WM_SETTEXT, 0, m_Caption2



Else

' Drei Buttons

SendDlgItemMessage nWnd, vbAbort, WM_SETTEXT, 0, m_Caption1

SendDlgItemMessage nWnd, vbRetry, WM_SETTEXT, 0, m_Caption2

SendDlgItemMessage nWnd, vbIgnore, WM_SETTEXT, 0, m_Caption3

End If

End Sub



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: