vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
DTA-Dateien erstellen inkl. BLZ-/Kontonummernpr?fung  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2017
 
zurück
Rubrik: Oberfläche · Fenster   |   VB-Versionen: VB2010 - VB201521.09.16
Überblenden von Form oder Control mit einer transparenten Farbe

Der Tipp vermittelt die Anwendung einer Klasse, die zum Überblenden einer gewählten Form oder eines oder mehrerer Controls innerhalb einer Form mittels einer transparenten Farbe realisiert.

Autor:   Dietrich HerrmannBewertung:     [ Jetzt bewerten ]Views:  2.286 
ohne HomepageSystem:  Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise bis zu 120,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 479,20 EUR statt 599,- EUR
  • sevDTA 3.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 20,00 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 55,20 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    Die Klasse heißt clsBlending und der Code wird im Folgenden gezeigt:

    Imports System.Drawing.Imaging
     
    Public Class clsBlending
      ' Für Ein-/Ausblend-Effekte
      Public Shared WithEvents timerFadeIn As New Timer
      Public Shared WithEvents timerFadeOut As New Timer
     
      ' Ein-/Ausblend-Einstellungen
      Public Enum blendOpacity
        ' Beginn-Transparenz der Überdeckungsfarbe
        blendBegin = 0
        ' Schrittweite für Ein/Ausblenden
        blendStep = 4
        ' Ende-Transparenz der Überdeckungsfarbe
        blendEnd = 64
        ' Timer-Intervall für das Einblenden (Geschwindigkeitsregulierung)
        blendIntervalIn = 20
        ' Timer-Intervall für das Ausblenden
        blendIntervalOut = 10
      End Enum
     
      ' aktuelle Transparenzstufe
      Shared blendActual As Short = blendOpacity.blendBegin
      ' Farbe für die Überdeckung
      Shared iTimer As Short
      ' PictureBox für die Aufnahme des Screenshots
      Public Shared pbBlend As PictureBox
      Dim tabWidth As Short   ' Tabellenbreite
      Dim rhdWidth As Short   ' Rowheaderbreite
     
      Public Shared Property theForm As Form
      Public Shared Property theControl As Control
      Public Shared Property blendColor As Color = Color.Black
      Public Shared Property cutTop As Short = 0
      Public Shared Property cutLeft As Short = 0
      Public Shared Property cutBottom As Short = 0
      Public Shared Property cutRight As Short = 0
      Public Shared Property ioTrigger As Boolean = False
      Public Sub endBlending()
        ' Einblend-Effekt starten
        timerFadeOut.Enabled = True
      End Sub
      Public Shared Sub startBlendingForm()
        ' Ausblend-Effekt starten (Form abdunkeln)
        ioTrigger = False
        createPB(True)
        CaptClient(theForm, pbBlend, cutTop, cutBottom, cutLeft, cutRight)
        iTimer = 0
        pbBlend.Visible = True
        timerFadeIn.Enabled = True
      End Sub
      Public Shared Sub startBlendingControl()
        ' Ausblend-Effekt starten (Control abdunkeln)
        ioTrigger = False
        createPB()
        CaptureCtrlAsBitmap(theControl, pbBlend)
        iTimer = 0
        pbBlend.Visible = True
        timerFadeIn.Enabled = True
      End Sub
      Private Shared Sub createPB(Optional art As Boolean = False)
        ' erzeugen der Picturebox für die Überblendung
        pbBlend = New PictureBox
        With pbBlend
          .Name = "Blend"
          .SizeMode = PictureBoxSizeMode.AutoSize
          .Visible = False
          If art Then ' Form
            .Left = theForm.Left
            .Top = theForm.Top
          Else  ' Control
            .Left = theControl.Left
            .Top = theControl.Top
          End If
          AddHandler .Paint, AddressOf pbPaint
          AddHandler .Click, AddressOf pbClick
          theForm.Controls.Add(pbBlend)
          ' Wichtig!
          .BringToFront()   ' bei Verwendung von Form
        End With
      End Sub
      Private Shared Sub pbPaint(sender As Object, ByVal e As PaintEventArgs)
        ' Größe des Rechtecks
        Dim re As Rectangle
        With pbBlend
          re = New Rectangle(.ClientRectangle.Left, .ClientRectangle.Top,
                 .ClientSize.Width, .ClientSize.Height)
        End With
        ' Brush der Überblendung
        Dim theBrush As SolidBrush = New SolidBrush(Color.FromArgb(blendActual, blendColor))
        ' Rechteck füllen
        e.Graphics.FillRectangle(theBrush, re)
      End Sub
      Private Shared Sub pbClick(sender As Object, e As EventArgs)
        ' Ausblenden bei Klick
        timerFadeIn.Enabled = False
        timerFadeOut.Enabled = True
        ioTrigger = False
      End Sub
      Private Shared Sub timerFadeIn_Tick(sender As Object, e As EventArgs) _
      Handles timerFadeIn.Tick
        ' Fade in Effekt
        iTimer += blendOpacity.blendStep
        If iTimer >= blendOpacity.blendEnd Then
          blendActual = blendOpacity.blendEnd
          timerFadeIn.Enabled = False
        End If
        If timerFadeIn.Enabled Then
          blendActual = iTimer
          pbBlend.Refresh()
        Else
          pbBlend.Visible = True
        End If
      End Sub
      Private Shared Sub timerFadeOut_Tick(sender As Object, e As EventArgs) _
      Handles timerFadeOut.Tick
        ' Fade out Effekt
        iTimer -= blendOpacity.blendStep
        If iTimer <= blendOpacity.blendBegin Then
          blendActual = blendOpacity.blendBegin
          timerFadeOut.Enabled = False
        End If
        If timerFadeOut.Enabled Then
          blendActual = iTimer
          pbBlend.Refresh()
        Else
          pbBlend.Visible = False
          theForm.Controls.RemoveByKey("Blend")
          iTimer = 0
          blendActual = blendOpacity.blendBegin
        End If
      End Sub
      ''' <summary>
      ''' Erstellt einen Screenshot der Clientarea einer Form
      ''' </summary>
      ''' <param name="fo">die Form</param>
      ''' <param name="pb">die Picturebox für den Screenshot</param>
      ''' <param name="cutTop">Korrekturpunkt von oben</param>
      ''' <param name="cutBottom">Korrekturpunkt von unten</param>
      ''' <param name="cutLeft">Korrekturpunkt von links</param>
      ''' <param name="cutRight">Korrekturpunkt von rechts</param>
      ''' <param name="doGray">Screenshot als Graustufenbild oder nicht</param>
      Private Shared Sub CaptClient(fo As Form, pb As PictureBox,
       cutTop As Short, cutBottom As Short,
       cutLeft As Short, cutRight As Short,
       Optional doGray As Boolean = False)
        Dim w As Integer = fo.Width
        Dim cw As Integer = fo.ClientSize.Width
        Dim h As Integer = fo.Height
        Dim ch As Integer = fo.ClientSize.Height
        Dim dw As Integer = w - cw
        Dim dh As Integer = h - ch
        Dim bm As New Bitmap(w, h)
     
        ' ganze Form in die Bitmap zeichnen
        fo.DrawToBitmap(bm, New Rectangle(0, 0, w, h))
        Dim bmc As New Bitmap(CInt(dw / 2), ch - cutTop)
        bmc = CropBitmap(bm,
          New Rectangle(dw / 2, dh - dw / 2 + cutTop,
          cw - cutLeft - cutRight, ch - cutTop - cutBottom))
        With pb
          .Left = cutLeft
          .Top = cutTop
          If doGray Then
            .Image = GetGrayScaleImage(bmc)
          Else
            .Image = bmc
          End If
        End With
      End Sub
      ''' <summary>
      ''' Screenshot eines Controls
      ''' </summary>
      ''' <param name="theCtrl">das Control</param>
      ''' <param name="pb">eine Picturebox</param>
      ''' <returns>Picturebox mit Control-Abbild</returns>
      Private Shared Function CaptureCtrlAsBitmap(theCtrl As Control, _
        pb As PictureBox) As PictureBox
        Dim bmp As New Bitmap(theCtrl.Width, theCtrl.Height)
        ' Control in die Bitmap zeichnen
        theCtrl.DrawToBitmap(bmp, New Rectangle(0, 0, _
          theCtrl.Width, theCtrl.Height))
        pb.Image = bmp
        Return pb
      End Function
      ''' <summary>
      ''' beschneidet eine Bitmap
      ''' </summary>
      ''' <param name="bmp">die Bitmap</param>
      ''' <param name="rect">die Rechteck-Koordinaten des Bildausschnitts</param>
      ''' <param name="pixf">das Pixelformat der Bitmap</param>
      ''' <returns>Bitmap-Object beschnitten</returns>
      Private Shared Function CropBitmap(ByRef bmp As Bitmap, _
        rect As Rectangle, _
        Optional pixf As PixelFormat = PixelFormat.Format24bppRgb) As Bitmap
        Dim croppedBmp As New Bitmap(rect.Width, rect.Height)
        croppedBmp = bmp.Clone(rect, pixf)
        Return croppedBmp
      End Function
      ''' <summary>
      '''  This method draws a grayscale image from a given Image-instance
      ''' </summary>
      ''' <param name="img">the source-image</param>
      ''' <returns>Bitmap-Object with grayscale image</returns>
      Private Shared Function GetGrayScaleImage(img As Image) As Bitmap
        Dim grayBitmap As New Bitmap(img.Width, img.Height)
        Dim imgAttributes As New ImageAttributes()
        Dim gray As New ColorMatrix(New Single()() {New Single() {0.299F, 0.299F, 0.299F, 0, 0}, _
        New Single() {0.588F, 0.588F, 0.588F, 0, 0}, _
        New Single() {0.111F, 0.111F, 0.111F, 0, 0}, _
        New Single() {0, 0, 0, 1, 0}, _
        New Single() {0, 0, 0, 0, 1}})
        imgAttributes.SetColorMatrix(gray)
        Dim g As Graphics = Graphics.FromImage(grayBitmap)
        g.DrawImage(img, New Rectangle(0, 0, img.Width, img.Height), _
         0, 0, img.Width, img.Height, GraphicsUnit.Pixel, imgAttributes)
        Return grayBitmap
      End Function
    End Class

    Die Arbeitsweise der Klasse ist so, dass beim Ausführen eines Ereignisses im rufenden Programm bestimmte Parameter der Klasse eingestellt werden können, mit denen dann die Klasse ausgeführt wird. Man muss als im aufrufenden Programm ein geeignetes Ereignis finden, durch das das Überblenden ausgelöst wird, aber auch ein weiteres Ereignis, durch das die Übeblendung wieder aufgehoben wird. Das Überblenden wird mit 'Darüberlegen' eines mit der gewünschten Farbe mit einer gewünschten Transparenz ausgefüllten Rechtecks (Picturebox) realisiert, das als Hintergrund den Screenshot des vorgegebenen Bereichs der Form oder Controls hat. Das Ein/Ausblenden wird zeitgesteuert durchgeführt.

    Anwendungsbeispiele:

    · Control überblenden bspw. mittels ButtonClick:

    Private Sub Button1_Click(sender As Object, e As EventArgs) _
      Handles Button1.Click
     
      InOutFadingC(myControl)
    End Sub
     
    Sub InOutFadingC(ctrl As Control)
      clsBlending.theControl = ctrl
      If clsBlending.ioTrigger Then
        clsBlending.timerFadeIn.Enabled = False
        clsBlending.timerFadeOut.Enabled = True
        clsBlending.ioTrigger = False
      Else
        clsBlending.theForm = Me
        clsBlending.startBlendingControl()
        clsBlending.ioTrigger = True
      End If
    End Sub

    Mit 'myControl' als gewünschtem zu überblendenen Control.

    · Eine Form überblenden mittels ButtonClick:

    Private Sub Button3_Click(sender As Object, e As EventArgs) _
      Handles Button3.Click
     
      clsBlending.theForm = Me
      clsBlending.blendColor = Color.MidnightBlue
      clsBlending.startBlendingForm()
      clsBlending.ioTrigger = True
    End Sub

    und Überblendung der Form beseitigen

    Private Sub Form1_Click(sender As Object, e As EventArgs) _
      Handles Me.Click
     
      If clsBlending.ioTrigger Then
        clsBlending.timerFadeIn.Enabled = False
        clsBlending.timerFadeOut.Enabled = True
        clsBlending.ioTrigger = False
      End If
    End Sub

    Ganz sicher gibt es noch mehrere Ereignisse und Möglichkeiten der Anwendung. Nebeneffekt des Überblendens ist gewissermaßen das "Unenablen" der Form oder des Controls.

    Viel Spaß beim Experimentieren!

    Dieser Tipp wurde bereits 2.286 mal aufgerufen.

    Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

    Über diesen Tipp im Forum diskutieren
    Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

    Neue Diskussion eröffnen

    nach obenzurück


    Anzeige

    Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
    (einschl. Beispielprojekt!)

    Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
    - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
    - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
    Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
     
       

    Druckansicht Druckansicht Copyright ©2000-2017 vb@rchiv Dieter Otter
    Alle Rechte vorbehalten.
    Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

    Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel