vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Brandneu! sevEingabe v3.0 - Das Eingabecontrol der Superlative!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Grafik und Font · Grafische Effekte   |   VB-Versionen: VB.NET13.09.06
PopUpPicturebox (VB 2005)

Klasse für eine PictureBox, bei der das enthaltene Bild "aufpoppt"

Autor:   Matthias ZürnBewertung:     [ Jetzt bewerten ]Views:  11.541 
ohne HomepageSystem:  WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Mit diesem Klassenmodul erstellen Sie ein "PopUp"-PictureBox-Control, bei dem das enthaltene Bild beim Überfahren mit der Maus "aufpoppt", d.h. weniger transparent und größer angezeigt wird.

Eigenschaften der PopUpPicturebox-Klasse:

PopUpImage(System.Drawing.Image)   Image (Bildsymbol), das angezeigt werden soll
StartAlpha(Integer)Alpa-Wert (Transparenz) des Images, das klein dargestellt wird (0 ist komplett durchsichtig - 255 komplett deckend).
PopUpSpeed(Integer)Geschindigkeit, mit der das Image vergrößert wird (z.B.: 150 für 150 Millisekunden)
SmallSize(System.Drawing.Size)Größe, mit der das Image zunächst dargestellt wird, wenn sich der Mauszeiger nicht über dem Symbol befindet (die Größe, wenn sich der Mauszeiger über dem Symbol befindet, entsprict der Größe der PictureBox auf dem Formular)

Erstellen Sie ein neues WindowsForm-Projekt und fügen nachfolgenden Code in ein neues Klassenmodul namens PopUpPictureBox ein:

Public Class PopUpPictureBox
  Inherits PictureBox
 
  Private AlphaBMPs As New List(Of Bitmap)
 
  Private _SmallSize As Size = New Size(18, 18)
  Private _image As Image = Nothing
  Private _StartAlpha As Integer = 100
  Private _PopUpSpeed As Integer = 50
 
  Private BMP As Bitmap
  Private Schritt As Integer
  Private AufPicture As Boolean
  Private DeltaX, DeltaY As Double
 
  Private WithEvents Ti As New System.Windows.Forms.Timer
  Public Sub SetAlpha()
    If IsNothing(BMP) Then Exit Sub
 
    Dim sw As New Stopwatch
    sw.Start()
    Dim c As Color
    Dim c1 As Color
    Me.AlphaBMPs.Clear()
    Dim value As Integer
 
    For z As Integer = 0 To 4
      value = _StartAlpha + ((255 - _StartAlpha) / 4 * z)
 
      Dim b As New Bitmap(BMP)
 
      For x As Integer = 0 To BMP.Width - 1
        For y As Integer = 0 To BMP.Height - 1
          c = BMP.GetPixel(x, y)
          If c.A > 0 Then
            c1 = Color.FromArgb(Math.Min(value, c.A), c.R, c.G, c.B)
            b.SetPixel(x, y, c1)
          End If
        Next
      Next
      AlphaBMPs.Add(b)
    Next z
    sw.Stop()
  End Sub
  Public Property PopUpSpeed() As Integer
    Get
      Return _PopUpSpeed
    End Get
    Set(ByVal value As Integer)
      _PopUpSpeed = value
    End Set
  End Property
  Public Property PopUpImage() As Image
    Get
      Return _image
    End Get
    Set(ByVal value As Image)
      _image = value
      value = Nothing
 
      If IsNothing(_image) Then Exit Property
 
      BMP = New Bitmap(_image)
      BMP.MakeTransparent()
      SetAlpha()
      Me.Refresh()
    End Set
  End Property
  Public Property StartAlpha() As Integer
    Get
      Return _StartAlpha
    End Get
    Set(ByVal value As Integer)
      _StartAlpha = value
      SetAlpha()
    End Set
  End Property
  Public Property SmallSize() As Size
    Get
      Return _SmallSize
    End Get
    Set(ByVal value As Size)
      If value.Height > Me.Size.Height Or value.Width > Me.Size.Width Then
        MessageBox.Show("SmallSize ist außerhalb des gültigen Bereiches", _
          "Achtung", MessageBoxButtons.OK, MessageBoxIcon.Warning)
        Exit Property
      End If
 
      _SmallSize = value
      DeltaX = Me.ClientRectangle.Width - value.Width
      DeltaY = Me.ClientRectangle.Height - value.Height
    End Set
  End Property
  Public Sub New()
    Ti.Interval = 30
  End Sub
  Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
    If Not AufPicture Then
      With Me.ClientRectangle
        If e.X > (.Width / 2 - Me.SmallSize.Width / 2) And _
          e.X < (.Width / 2 + Me.SmallSize.Width / 2) And _
          e.Y > (.Height / 2 - Me.SmallSize.Height / 2) And _
          e.Y < (.Height / 2 + Me.SmallSize.Height / 2) Then
 
          AufPicture = True
          Ti.Start()
        End If
      End With
    End If
    MyBase.OnMouseMove(e)
  End Sub
  Protected Overrides Sub OnMouseLeave(ByVal e As System.EventArgs)
    AufPicture = False
    Ti.Start()
    MyBase.OnMouseLeave(e)
  End Sub
  Protected Overrides Sub OnPaint(ByVal pe As System.Windows.Forms.PaintEventArgs)
    If Not IsNothing(BMP) Then
      With Me._SmallSize
        Dim Breite As Integer = CInt(.Width + (DeltaX / 5 * Schritt))
        Dim Höhe As Integer = CInt(.Height + (DeltaY / 5 * Schritt))
        With pe.ClipRectangle
          pe.Graphics.DrawImage(AlphaBMPs(Schritt), 0 + _
            CInt((.Width - Breite) / 2), CInt((.Height - Höhe) / 2), Breite, Höhe)
        End With
      End With
    End If
    MyBase.OnPaint(pe)
  End Sub
  Private Sub Ti_Tick(ByVal sender As Object, _
    ByVal e As System.EventArgs) Handles Ti.Tick
 
    Dim sw As New Stopwatch
    Dim Interval As Integer
 
    sw.Start()
    If AufPicture = True And Schritt < 4 Then
      Schritt += 1
    End If
 
    If AufPicture = False And Schritt > 0 Then
      Schritt -= 1
    End If
 
    Me.Refresh()
 
    If Schritt = 5 Or Schritt = 0 Then Ti.Stop()
    sw.Stop()
 
    Interval = CInt(PopUpSpeed / 5) - sw.ElapsedMilliseconds
    Interval = Math.Max(1, Interval)
    Ti.Interval = Interval
  End Sub
 
End Class

Und jetzt noch der Code für die Form1:

Public Class Form1
  Private Sub Form1_Load(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles MyBase.Load
 
    Dim PopUp As New PopUpPictureBox
 
    With PopUp
      .Location = New Point(64, 64)
      .Size = New Size(48, 48)
      .SmallSize = New Size(18, 18)
      .PopUpImage = New Bitmap(System.Drawing.SystemIcons.Question.ToBitmap)
      .PopUpSpeed = 100
      .StartAlpha = 100
    End With
 
    Me.Controls.Add(PopUp)
  End Sub
End Class

Selbstverständlich kann man die PopUpPictureBox auch im Designer aufziehen.
 

Dieser Tipp wurde bereits 11.541 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-2024 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