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:
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.607 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
Neu! sevEingabe 3.0 Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. Tipp des Monats Mai 2024 Hermann Röttger Wochentage eines Datumsbereichs ermitteln Wochentage eines Datumsbereichs ermitteln, optional mit Feiertagsberechnung TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||||||||||||||
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. |