ABOUT Visual Basic - das Webmagazin: Maskenball (ActiveX-Control)

ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE

(-hg)

Rechteckige, quadratische, kreisrunde oder ovale Bildausschnitte, abgerundete Ecken? Das ist an sich eine Aufgabe der Bildbearbeitung in Grafikprogrammen. Was aber, wenn Sie nicht von vornherein festlegen, sondern die sichtbare Form, Position und Größe des Bildausschnitts erst per Code bestimmen oder gar animieren möchten? Leider bietet keines der Bilddarstellungs-Steuerelemente in Visual Basic eine derartige Option zur Festlegung der äußeren Form, wie sie etwa das Shape-Steuerelement bietet. Natürlich können Sie mit Hilfe eines transparenten UserControls und diversen Zeichenfunktionen das Gewünschte erreichen - doch das ist recht mühsam. Es gibt allerdings einen recht simplen Weg zum Ziel, der ohne jegliche Mal- und Bildbearbeitungstechniken auskommt.



	Maskierung eines Bildelements auf einem transparenten Container-UserControl

Wir nutzen einen an sich unwillkommenen Effekt eines transparenten UserControls, dessen Eigenschaft ControlContainer auf True gesetzt ist. Wenn Sie nämlich auf einem solchen Container-UserControl andere Steuerelemente platzieren, werden sie unsichtbar - es sei denn, es befindet sich auf dem UserControl selbst ein nicht durchsichtiges Shape-Steuerelement. Denn dann stanzt dieses Shape-Steuerelement gewissermaßen ein Loch in die Durchsichtigkeit, und in diesem "Loch" werden auf dem Container-UserControl platzierte Steuerelemente wieder sichtbar (siehe: "Transparente Container").

Sie brauchen nun nur noch dafür zu sorgen, dass das Shape-Steuerelement die Fläche des UserControls immer vollständig ausfüllt, und dass seine Kontur über eine Eigenschaft festgelegt werden kann. Platzieren Sie nun später ein Image-Steuerelement, eine PictureBox oder welches (grafische) Steuerelement auch immer auf diesem Container-UserControl, so erscheint dieses nur noch innerhalb der Stanzform des Shape-Steuerelements - in Kreis- oder Ovalform, mit abgerundeten Ecken usw.

Fügen Sie noch ein paar weitere nützliche Eigenschaften hinzu, wie etwa AutoSize zur Anpassung eines solchen Masken-Containers an das darauf platzierte Steuerelement, oder zur Positionierung dieses Steuerelements (ContainedControlPos zum Ausrichten oder Zentrieren), und vielleicht noch BorderStyle.

Eine einfache Animation erhalten Sie, indem Sie das darauf platzierte Steuerelement beispielsweise immer zentriert halten und das Masken-Steuerelement von einem zentralen Punkt aus wachsen lassen (Blenden-Effekt). Wie das im einzelnen geht, sehen Sie im herunterladbaren Beispielprojekt zu dem nun folgenden Masken-Steuerelement MaskedContainer.

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Declare Function GetClientRect Lib "user32" _
 (ByVal hwnd As Long, lpRect As RECT) As Long

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

Public Enum scBorderStyleConstants
  scBSNone
  scBS3D
End Enum

Public Enum scContainedControlPosConstants
  scCCPosNone
  scCCPosCenter
  scCCPosLeftTop
  scCCPosTopCenter
  scCCPosRightTop
  scCCPosRightCenter
  scCCPosRightBottom
  scCCPosBottomCenter
  scCCPosLeftBottom
  scCCPosLeftCenter
End Enum

Public Enum scShapeConstants
  scShapeRectangle
  scShapeSquare
  scShapeOval
  scShapeCircle
  scShapeRoundedRectangle
  scShapeRoundedSquare
End Enum

Private pAutoSize As Boolean
Private pBorderStyle As scBorderStyleConstants
Private pContainedControlPos As scContainedControlPosConstants

Public Property Get AutoSize() As Boolean
  AutoSize = pAutoSize
End Property

Public Property Let AutoSize(New_AutoSize As Boolean)
  pAutoSize = New_AutoSize
  UserControl_Resize
  PropertyChanged "AutoSize"
End Property

Public Property Get BackColor() As OLE_COLOR
  BackColor = shp.BackColor
End Property

Public Property Let BackColor(New_BackColor As OLE_COLOR)
  With shp
    .BackColor = New_BackColor
    .BorderColor = New_BackColor
  End With
  PropertyChanged "BackColor"
End Property

Public Property Get BorderStyle() As scBorderStyleConstants
  BorderStyle = pBorderStyle
End Property

Public Property Let BorderStyle(New_BorderStyle _
 As scBorderStyleConstants)

  Select Case New_BorderStyle
    Case pBorderStyle
    Case scBSNone
      UserControl.BorderStyle = 0
    Case scBS3D
      UserControl.BorderStyle = 1
    Case Else
      Err.Raise 380
  End Select
  pBorderStyle = New_BorderStyle
  PropertyChanged "BorderStyle "
End Property

Public Property Get ContainedControlPos() _
 As scContainedControlPosConstants

  ContainedControlPos = pContainedControlPos
End Property

Public Property Let ContainedControlPos(New_ContainedControlPos _
 As scContainedControlPosConstants)

  Select Case New_ContainedControlPos
    Case pContainedControlPos
    Case scCCPosNone To scCCPosLeftCenter
      pContainedControlPos = New_ContainedControlPos
      UserControl_Resize
    Case Else
      Err.Raise 380
  End Select
  PropertyChanged "ContainedControlPos"
End Property

Public Property Get Shape() As scShapeConstants
  Shape = shp.Shape
End Property

Public Property Let Shape(New_Shape As scShapeConstants)
  With shp
    Select Case New_Shape
      Case scShapeRectangle To scShapeRoundedSquare
        .Shape = New_Shape
        UserControl_Resize
      Case Else
        Err.Raise 380
    End Select
  End With
  PropertyChanged "Shape"
End Property

Private Sub UserControl_Click()
  RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
  RaiseEvent DblClick
End Sub

Private Sub UserControl_InitProperties()
  Me.BackColor = Ambient.BackColor
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_ReadProperties(PropBag As PropertyBag)
  With PropBag
    pAutoSize = .ReadProperty("AutoSize", False)
    Me.BackColor = .ReadProperty("BackColor", Ambient.BackColor)
    Me.BorderStyle = .ReadProperty("BorderStyle", scBSNone)
    pContainedControlPos = .ReadProperty("ContainedControlPos", _
     scCCPosNone)
    Me.Shape = .ReadProperty("Shape", scShapeRectangle)
  End With
End Sub

Private Sub UserControl_Resize()
  Dim nRect As RECT
  Dim nWidth As Single
  Dim nHeight As Single
  Dim nContainedControl As Control
  Dim nLeft As Single
  Dim nTop As Single
  
  Static sInProc
    
  If sInProc Then
    Exit Sub
  Else
    sInProc = True
  End If
  With shp
    If .Shape = scShapeSquare Then
      .BorderStyle = 1
    Else
      .BorderStyle = 0
    End If
  End With
  On Error Resume Next
  With UserControl
    If pAutoSize Then
      GetClientRect .hwnd, nRect
      If .ContainedControls.Count Then
        Set nContainedControl = .ContainedControls(0)
        nWidth = nContainedControl.Width + _
         (.Width - nRect.Right * Screen.TwipsPerPixelX)
        nHeight = nContainedControl.Height + _
         (.Height - nRect.Bottom * Screen.TwipsPerPixelY)
        UserControl.Size nWidth, nHeight
        nContainedControl.Move 0, 0
      End If
    End If
    If .ContainedControls.Count Then
      If pContainedControlPos Then
        Set nContainedControl = .ContainedControls(0)
        Select Case pContainedControlPos
          Case scCCPosCenter
            nLeft = (.ScaleWidth - nContainedControl.Width) \ 2
            nTop = (.ScaleHeight - nContainedControl.Height) \ 2
          Case scCCPosLeftTop
          Case scCCPosTopCenter
            nLeft = (.ScaleWidth - nContainedControl.Width) \ 2
          Case scCCPosRightTop
            nLeft = .ScaleWidth - nContainedControl.Width
          Case scCCPosRightCenter
            nTop = (.ScaleHeight - nContainedControl.Height) \ 2
            nLeft = .ScaleWidth - nContainedControl.Width
          Case scCCPosRightBottom
            nLeft = .ScaleWidth - nContainedControl.Width
            nTop = .ScaleHeight - nContainedControl.Height
          Case scCCPosBottomCenter
            nLeft = (.ScaleWidth - nContainedControl.Width) \ 2
            nTop = .ScaleHeight - nContainedControl.Height
          Case scCCPosLeftBottom
            nTop = .ScaleHeight - nContainedControl.Height
          Case scCCPosLeftCenter
            nTop = (.ScaleHeight - nContainedControl.Height) \ 2
        End Select
        nContainedControl.Move nLeft, nTop
      End If
    End If
    shp.Move 0, 0, .ScaleWidth + Screen.TwipsPerPixelX, _
     .ScaleHeight + Screen.TwipsPerPixelY
    UserControl.Refresh
  End With
  sInProc = False
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  With PropBag
    .WriteProperty "AutoSize", False
    .WriteProperty "BackColor", shp.BackColor, Ambient.BackColor
    .WriteProperty "BorderStyle", pBorderStyle, scBSNone
    .WriteProperty "ContainedControlPos", pContainedControlPos, _
     scCCPosNone
    .WriteProperty "Shape", shp.Shape, scShapeRectangle
  End With
End Sub

Das Projekt avbMaskedContainer (maskedcontainer.zip- ca. 11 KB)