Die Community zu .NET und Classic VB.
Menü

VB.NET-Tipp 0081: Picture-Viewer mit Autoscroll

 von 

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:

Schwierigkeitsgrad 1

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:

Download des Beispielprojektes [103,35 KB]

' 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)