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.541 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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevCoolbar 3.0 Professionelle Toolbars im modernen Design! Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access |
||||||||||||||||||||||||||||
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. |