(-hg)

Wenn Sie eigene Alternativen zur eingebauten MessageBox erstellen möchten, um mehr Flexibilität bei der Beschriftung und den Schaltflächen erhalten wollen, werden Sie die System-Symbole der Message-Box benötigen. Die entsprechenden Icons werden zwar als Icon-Dateien mit Visual Basic mitgeliefert, doch wozu diese extra als Icons in Ihre alternative MessageBox einbauen und damit zusätzliche Ressourcen belegen, wenn das System Ihnen die Symbole jederzeit selbst liefern kann?

	Eine alternative MessageBox mit systemeigenen Symbolen

So können Sie mit der API-Funktion LoadIcon das gewünschte Symbol aus den System-Ressourcen laden und mit DrawIcon etwa in einer PictureBox, auf einem Form oder in einem UserControl darstellen.

Wenn Sie das dann in ein kleines UserControl verpacken, brauchen Sie sich nicht weiter um das Laden und Darstellen kümmern, sondern einfach nur noch das gewünschte Symbol über eine Eigenschaft festlegen. Und genau das haben wir für Sie bereits erledigt - mit dem hier vorgestellten UserControl SysIcon. Sie können es, wenn Sie wollen, als eigenständiges OCX kompilieren oder es als Modul beispielsweise direkt in das Projekt aufnehmen, das Ihre alternative MessageBox erzeugt.

Da diese System-Symbole zwar Icon-Größe haben (32x32 Pixels), aber nicht die ganze Fläche bedecken, müssten sie eigentlich transparent dargestellt werden. Da die transparente Darstellung eines per API-Funktion gezeichnet Icons in einem transparenten UserControl nicht so einfach ist, haben wir darauf verzichtet. Es genügt wohl vollauf, dass Sie einerseits die Hintergundfarbe des UserControls jederzeit frei festlegen können und dass sich die Hintergrundfarbe andererseits auch auf Wunsch automatisch der Hintergrundfarbe des Containers (z.B. Form) anpasst - auch wenn diese sich zur Laufzeit ändert. Für die letztere Automatik sorgt die Eigenschaft AutoAmbientBackColor, wenn Sie sie auf True setzen.

In der Eigenschaft Icon legen Sie über die Enumeration SysIconConstants das gewünschte Symbol fest (siInformation bis siApplication) - oder auch gar keines (siNone).

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 Long) As Long

Private Const IDI_APPLICATION = 32512&
Private Const IDI_ASTERIK = 32516&
Private Const IDI_EXCLAMATION = 32515&
Private Const IDI_QUESTION = 32514&
Private Const IDI_HAND = 32513&

Public Enum SysIconConstants
  siNone
  siInformation
  siExclamation
  siQuestion
  siStop
  siApplication
End Enum

Public Event Click()
Public Event DblClick()
Public Event MouseDown(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)

Private pAutoAmbientBackColor As Boolean
Private pBackColor As OLE_COLOR
Private pIcon As SysIconConstants

Public Property Get AutoAmbientBackColor() As Boolean
  AutoAmbientBackColor = pAutoAmbientBackColor
End Property

Public Property Let AutoAmbientBackColor_
 (ByVal New_AutoAmbientBackColor As Boolean)

  If pAutoAmbientBackColor <> New_AutoAmbientBackColor Then
    pAutoAmbientBackColor = New_AutoAmbientBackColor
    zSetBackColor
  End If
  PropertyChanged "AutoAmbientBackColor"
End Property

Public Property Get BackColor() As OLE_COLOR
  BackColor = pBackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  If UserControl.BackColor <> New_BackColor Then
    pBackColor = New_BackColor
    zSetBackColor
  End If
  PropertyChanged "BackColor"
End Property

Public Property Get Enabled() As Boolean
  Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
  UserControl.Enabled = New_Enabled
  PropertyChanged "Enabled"
End Property

Public Property Get Icon() As SysIconConstants
  Icon = pIcon
End Property

Public Property Let Icon(ByVal New_Icon As SysIconConstants)
  Select Case New_Icon
    Case pIcon
      Exit Property
    Case siNone To siApplication
      pIcon = New_Icon
      zPaint
    Case Else
      Err.Raise 380
  End Select
  PropertyChanged "Icon"
End Property

Private Sub UserControl_AmbientChanged(PropertyName As String)
  If pAutoAmbientBackColor Then
    zSetBackColor
  End If
End Sub

Private Sub UserControl_Click()
  RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
  RaiseEvent DblClick
End Sub

Private Sub UserControl_MouseDown(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_Resize()
  Static sInProc As Boolean
  
  If sInProc Then
    Exit Sub
  Else
    sInProc = True
  End If
  UserControl.Size 32 * Screen.TwipsPerPixelX, _
   32 * Screen.TwipsPerPixelY
  sInProc = False
End Sub

Private Sub UserControl_Show()
  zSetBackColor
End Sub

Private Sub UserControl_Initialize()
  pAutoAmbientBackColor = True
  pIcon = siInformation
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  pAutoAmbientBackColor = _
   PropBag.ReadProperty("AutoAmbientBackColor", True)
  pBackColor = _
   PropBag.ReadProperty("BackColor", Ambient.BackColor)
  UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  pIcon = PropBag.ReadProperty("Icon", siInformation)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  PropBag.WriteProperty "AutoAmbientBackColor", _
   pAutoAmbientBackColor, True
  PropBag.WriteProperty "BackColor", UserControl.BackColor, _
   Ambient.BackColor
  PropBag.WriteProperty "Enabled", UserControl.Enabled, True
  PropBag.WriteProperty "Icon", pIcon, siInformation
End Sub

Private Sub zPaint()
  Dim nIcon As Long

  With UserControl
    .Cls
    Select Case pIcon
      Case siNone
        Exit Sub
      Case siApplication
        nIcon = IDI_APPLICATION
      Case siInformation
        nIcon = IDI_ASTERIK
      Case siExclamation
        nIcon = IDI_EXCLAMATION
      Case siQuestion
        nIcon = IDI_QUESTION
      Case siStop
        nIcon = IDI_HAND
    End Select
    DrawIcon .hdc, 0, 0, LoadIcon(0, nIcon)
  End With
End Sub

Private Sub zSetBackColor()
  If pAutoAmbientBackColor Then
    UserControl.BackColor = Ambient.BackColor
  Else
    UserControl.BackColor = pBackColor
  End If
  zPaint
End Sub

Copyright © 1999 - 2023 Harald M. Genauck, ip-pro gmbh  /  Impressum