VB.NET-Tipp 0081: Picture-Viewer mit Autoscroll
von Spatzenkanonier
Beschreibung
Scrollable Controls (Panel, Form, weitere) nehmen uns die Arbeit ab, Scrollbars einzurichten und permanent nachzujustieren, wenn das Anzeigefenster oder der angezeigte Inhalt sich ändert. Hier ist der angezeigte Inhalt eine Picturebox, die ein Bild proportionsgerecht darstellt. Überragt sie das Panel, auf dem sie aufsitzt, aktiviert dieses seine Scroll-Funktionalität.
Damit ist man mit dem Scrollen schon fertig, aber hier wird noch zusätzlich beim Zoomen die Bildmitte reorganisiert, da ansonsten der Bildausschnitt nach unten rechts / oben links "davonläuft". Bei gehaltener Maustaste kann man wie mit einer Lupe die Bitmap absuchen.
Zum Verständnis des Tipps ist es wichtig die Voreinstellung der Steuerelemente zu beachten!
Schwierigkeitsgrad: | Framework-Version(en): .NET Framework 1.0, .NET Framework 1.1, .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5 | .NET-Version(en): Visual Basic 2002, Visual Basic 2003, Visual Basic 2005, Visual Basic 2008 | Download: |
' Dieser Quellcode stammt von http://www.activevb.de ' und kann frei verwendet werden. Für eventuelle Schäden ' wird nicht gehaftet. ' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. ' Ansonsten viel Spaß und Erfolg mit diesem Source! ' Projektversion: Visual Studio 2005 ' Option Strict: An ' ' Referenzen: ' - System ' - System.Data ' - System.Drawing ' - System.Windows.Forms ' - System.Xml ' ' Imports: ' - Microsoft.VisualBasic ' - Microsoft.VisualBasic.ControlChars ' - System ' - System.Collections ' - System.Collections.Generic ' - System.Data ' - System.Drawing ' - System.Diagnostics ' - System.Windows.Forms ' ' ############################################################################## ' ############################ frmPictureViewer.vb ############################# ' ############################################################################## 'Steuerelemente - Einstellungen: 'Panel "ScrollContainer", mit .AutoScroll = True 'Picturebox "DisplayControl", mit .BackgroundImageLayout.Zoom Public Class frmPictureViewer Private _GrabOffs As SizeF Private Sub frmPictureViewer_Load(ByVal sender As Object, _ ByVal e As EventArgs) Handles MyBase.Load Me.DisplayControl.BackgroundImage = New Bitmap(1, 1) ExchangePicSource("Bild 023.jpg") End Sub Private Sub ExchangePicSource(ByVal path As String) Dim bmpNew As Bitmap Dim FileName As String = IO.Path.GetFileName(path) Try bmpNew = New Bitmap(path) Catch ex As Exception MsgBox(String.Concat("""", FileName, """ einlesen gescheitert.", _ Lf, Lf, "Fehlermeldung: ", Lf, ex.ToString), _ MsgBoxStyle.Information) Return End Try DisplayControl.BackgroundImage.Dispose() DisplayControl.BackgroundImage = bmpNew ' Der spezifische Control-Typ - hier: Picturebox - ist gänzlich ' unerheblich, denn über die BackgroundImage - Property verfügen ' alle Controls lbBitmapSize.Text = SizeToString(bmpNew.Size) MyBase.Text = String.Concat(Application.ProductName, " - ", FileName) ApplyZoom() End Sub Private Sub ApplyZoom() Dim Msg As String = "" Dim ZoomVal As Double = GetZoom() Static OldZoom As Double = 1 Dim NewSize As Size = _ Mult(DisplayControl.BackgroundImage.Size, ZoomVal).ToSize ' Zu viele Bildpunkte erzeugen einen Pufferfehler im Control Const MaxPixCount As Long = 160000000 If MaxPixCount > CLng(NewSize.Width) * NewSize.Height Then ' Zoomen ist damit getan Me.DisplayControl.Size = NewSize ' Aber die Bildmitte reorganisieren... KeepMiddle(ZoomVal / OldZoom) lbZoom.Text = ZoomVal.ToString("0.0000") OldZoom = ZoomVal Else Msg = "Zu groß! " End If Msg &= SizeToString(NewSize) lbDisplayerSize.Text = Msg End Sub Private Function GetZoom() As Double ' Gezoomt wird exponentiell, von 2^-7 bis 2^+7 Return 2 ^ (Me.trkZoom.Value / 100) End Function ''' <summary>bisherige Bildmitte beibehalten</summary> ''' <remarks> ''' AutoScrollPosition bezeichnet die Position der Picbox. Da ''' diese beim Scrollen über pnlScroll hinausragt, ergeben sich ''' negative XY-Werte ''' </remarks> Private Sub KeepMiddle(ByVal deltaZoom As Double) Dim ContainerMid As Size = HalfSz(ScrollContainer.Size) '(AutoScrollPosition invertiert adden) Dim Middle As Size = ContainerMid - _ New Size(ScrollContainer.AutoScrollPosition) Middle = Mult(Middle, deltaZoom).ToSize ' Verrückt: die neue AutoScrollPosition muß als positiver Wert ' zugewiesen werden! Ruft man sie wieder ab, ist sie negativ?!? ScrollContainer.AutoScrollPosition = New Point(Middle) - ContainerMid End Sub Private Sub frmPictureViewer_Disposed(ByVal sender As Object, _ ByVal e As EventArgs) Handles Me.Disposed DisplayControl.BackgroundImage.Dispose() End Sub Private Sub pnlScroll_SizeChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles ScrollContainer.SizeChanged lbContainerSize.Text = SizeToString(ScrollContainer.Size) End Sub Private Sub DisplayControl_MouseDown(ByVal sender As Object, _ ByVal e As MouseEventArgs) Handles DisplayControl.MouseDown _GrabOffs = New SizeF(Container2Display(MouseLocation)) + _ New Size(Me.ScrollContainer.AutoScrollPosition) End Sub ''' <summary> ''' Lupe: bei gehaltenem Button **beide** Scrollbars bedienen ''' </summary> Private Sub DisplayControl_MouseMove(ByVal sender As Object, _ ByVal e As MouseEventArgs) Handles DisplayControl.MouseMove If e.Button = Windows.Forms.MouseButtons.Left Then Me.ScrollContainer.AutoScrollPosition = _ Point.Round(Container2Display(MouseLocation) - _GrabOffs) End If lbMouseOnBitmap.Text = e.Location.ToString End Sub Private Sub DisplayControl_Move(ByVal sender As Object, _ ByVal e As EventArgs) _ Handles DisplayControl.Move, DisplayControl.SizeChanged lbScrollPos.Text = Me.ScrollContainer.AutoScrollPosition.ToString End Sub Private Sub trkZoom_ValueChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles trkZoom.ValueChanged ApplyZoom() End Sub Private Sub btDatei_Click(ByVal sender As Object, _ ByVal e As EventArgs) Handles btDatei.Click With Me.OpenFileDialog1 If .ShowDialog = Windows.Forms.DialogResult.OK Then _ ExchangePicSource(.FileName) End With End Sub Private Function Container2Display(ByVal pointOnContainer As PointF) _ As PointF ' Ermittelt den zu ptContainer proportionalen Punkt auf dem ' Display-Control. Erforderlich für die Bewegungen der "Lupe". Eine ' Mausbewegung quer über den Container soll ja das Display-Control ' komplett durchscrollen. Dim Sz As New SizeF(DisplayControl.Size) Return modHelpers.Scale(pointOnContainer, _ Sz.Width / MyBase.ClientSize.Width, _ Sz.Height / MyBase.ClientSize.Height) End Function Private Function MouseLocation() As Point ' Die Mausposition relativ zum Container Return Me.ScrollContainer.PointToClient(Control.MousePosition) End Function Private Function SizeToString(ByVal sz As Size) As String Return String.Concat(sz.Width, " / ", sz.Height) End Function Private Sub btBugTest_Click(ByVal sender As Object, _ ByVal e As EventArgs) Handles btBugTest.Click ' Bug-Demo: Die Eigenschaft Control.AutoScrollposition negiert sich ' selbst, d.h. bei einer Scrollposition von { -5, -5 } bewirkt die ' folgende (eigentlich idiotische) Zuweisung eine Änderung der ' Scrollposition auf { 5, 5 }. Da es positive Scrollpositionen nicht ' gibt, springt die Scrollposition auf { 0, 0 }. ScrollContainer.AutoScrollPosition = ScrollContainer.AutoScrollPosition End Sub End Class ' ############################################################################## ' ################################ Helpers.vb ################################## ' ############################################################################## Module modHelpers Public Function Mult(ByVal sz As SizeF, ByVal zoomValue As Double) As SizeF With sz Return New SizeF(CInt(.Width * zoomValue), _ CInt(.Height * zoomValue)) End With End Function Public Function Mult(ByVal pt As PointF, _ ByVal zoomValue As Double) As PointF With pt Return New PointF(CInt(.X * zoomValue), CInt(.Y * zoomValue)) End With End Function Public Function HalfSz(ByVal sz As Size) As Size With sz Return New Size(.Width \ 2, .Height \ 2) End With End Function Public Function Scale(ByVal pt As PointF, ByVal x As Single, _ ByVal y As Single) As PointF With pt Return New PointF(.X * x, .Y * y) End With End Function End Module
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von Andre am 28.06.2010 um 21:28
ScrollContainer.AutoScrollPosition = New Point(Middle) - ContainerMid
Diese Zuweisung erzeugt im Prog je nach Zoomrichtung ein starkes diagonales "Wackeln".
Ich habe bis jetzt die Ursache nicht finden können.
Sonst gefällt mir der Tipp.
Kommentar von vb-nerd am 17.05.2009 um 23:21
Das mit der negativen Rückgabe der Autoscrollposition habe ich zu meinem Leidwesen auch schon bei einer Zuweisung über
Control.AutoScrollPosition =New Point(X,Y)