Tipp 0312 Grafik scrollen
Autor/Einsender:
Datum:
  Angie
12.02.2003
Entwicklungsumgebung:   VB 5
Folgendes Beispiel zeigt eine der Möglichkeiten, wie eine Grafik, die nicht vollständig in den sichtbaren Bereich passt, gescrollt werden kann.
Formaufbau:
Hier werden zunächst zwei PictureBoxen auf der Form platziert, um die Form in zwei Bereiche zu teilen (linker und rechter Bereich). Mit der Align-Eigenschaft werden die PictureBoxen links bzw. rechts ausgerichtet, die Höhe wird dabei automatisch an die Formhöhe angepasst.
Die rechte PictureBox ist hier ein "feststehender" Bereich, in dem die darin befindlichen Steuerelemente (hier ein Frame mit zwei CommandButtons) immer sichtbar bleiben und nur bei Größenänderung der Form unten ausgerichtet werden.
In der linken PictureBox, die je nach Bedarf gescrollt werden kann, werden eine PictureBox (für die Grafikanzeige), je eine vertikale und horizontale ScrollBar und noch eine kleine PictureBox (dient als Abdeckung für die "offene Ecke", wenn beide ScrollBars angezeigt werden) platziert.
Bei jeder Veränderung der Fenstergröße wird zunächst überprüft, ob die Grafik in einer und/oder in beiden Richtungen vollständig angezeigt werden kann. Die ScrollBars werden dann entsprechend angeordnet bzw., wenn die eine oder andere ScrollBar nicht benötigt wird, wird diese ausgeblendet.
 
Option Explicit

Private Const c_GAP As Integer = 40
Private Const c_HGHTWDTH As Integer = 255

Private m_blnFrmLoading As Boolean
Private m_sngImageWidth As Single
Private m_sngImageHeight As Single

Private Sub Form_Load()
  m_blnFrmLoading = True

  With Me
    .Width = 6000
    .Height = 4000
  End With

  picBoxFrmRight.Align = vbAlignRight
  picBoxFrmRight.Width = 1600

  With fraButtons
    .BorderStyle = 0
    .Left = (picBoxFrmRight.ScaleWidth - .Width) / 2
  End With

  imgGrip.Left = picBoxFrmRight.ScaleWidth - imgGrip.Width

  picBoxFrmLeft.Align = vbAlignLeft
  picBoxFrmLeft.Width = Me.ScaleWidth - picBoxFrmRight.Width - c_GAP

  With picBoxImage
    .AutoSize = True
    .BorderStyle = 0
    .Move 0, 0
  End With

  With picScroll
    .Height = c_HGHTWDTH
    .Width = c_HGHTWDTH
    .BorderStyle = 0
    .ZOrder 0
  End With

  With HScroll1
    .Left = 0
    .Height = c_HGHTWDTH
    .TabStop = False
    .ZOrder 0
  End With

  With VScroll1
    .Top = 0
    .Width = c_HGHTWDTH
    .TabStop = False
    .ZOrder 0
  End With

  On Error Resume Next
  With picBoxImage
    .Picture = LoadPicture(App.Path & "\" & "Grafik1.wmf")
    m_sngImageWidth = .Width
    m_sngImageHeight = .Height
  End With
  On Error GoTo 0

  m_blnFrmLoading = False
End Sub

Private Sub Form_Resize()
  If m_blnFrmLoading Or WindowState = vbMinimized Then Exit Sub
  GetScrollBars
End Sub

Private Sub GetScrollBars()
  Dim sngHeight As Single
  Dim sngWidth As Single
  
  Dim boolHScroll As Boolean
  Dim boolVScroll As Boolean

  On Error Resume Next
  picBoxFrmLeft.Width = Me.ScaleWidth - picBoxFrmRight.Width - c_GAP

  sngWidth = picBoxFrmLeft.ScaleWidth
  sngHeight = Me.ScaleHeight - c_GAP

  boolHScroll = CBool(sngWidth < m_sngImageWidth)
  If boolHScroll Then
    sngHeight = sngHeight - c_HGHTWDTH
  End If

  boolVScroll = CBool(sngHeight < m_sngImageHeight)
  If boolVScroll Then
    sngWidth = sngWidth - c_HGHTWDTH

    If Not boolHScroll Then
      boolHScroll = CBool(sngWidth < m_sngImageWidth)
      If boolHScroll Then
        sngHeight = sngHeight - c_HGHTWDTH
      End If
    End If
  End If

  If boolHScroll Then
    With HScroll1
      .Top = sngHeight
      .Width = sngWidth

      .Min = 0
      .Max = m_sngImageWidth - sngWidth
      .LargeChange = picBoxImage.Width * 0.1
      .SmallChange = .LargeChange / 4

      .Visible = True
    End With

  Else
    With HScroll1
      .Value = 0
      .Visible = False
    End With
  End If

  If boolVScroll Then
    With VScroll1
      .Left = sngWidth
      .Height = sngHeight

      .Min = 0
      .Max = m_sngImageHeight - sngHeight
      .LargeChange = picBoxImage.Width * 0.1
      .SmallChange = .LargeChange / 4

      .Visible = True
    End With

  Else
    With VScroll1
      .Value = 0
      .Visible = False
    End With
  End If

  If HScroll1.Visible And VScroll1.Visible Then
    With picScroll
      .Move VScroll1.Left, HScroll1.Top
      .Visible = True
    End With
  Else
    picScroll.Visible = False
  End If

  fraButtons.Top = Me.ScaleHeight - fraButtons.Height - _
       imgGrip.Height

  If Me.WindowState = vbMaximized Then
    imgGrip.Visible = False
  Else
    With imgGrip
      .Visible = True
      .Top = Me.ScaleHeight - .Height - c_GAP
    End With
  End If
End Sub

Private Sub HScroll1_Change()
  picBoxImage.Left = -HScroll1.Value
End Sub

Private Sub HScroll1_Scroll()
  HScroll1_Change
End Sub

Private Sub VScroll1_Change()
  picBoxImage.Top = -VScroll1.Value
End Sub

Private Sub VScroll1_Scroll()
  VScroll1_Change
End Sub

Private Sub cmdGrafikLaden_Click()
  Dim strFilter As String

  CommonDialog1.CancelError = True

  On Error GoTo ErrHandler

  strFilter = "Alle Grafiken (*.gif;*.jpg;*.ico;*.bmp;*.wmf)" & _
                            "|*.gif;*.jpg;*.ico;*.bmp;*.wmf|"
  strFilter = strFilter & "GIF Files (*.gif)|*.gif|"
  strFilter = strFilter & "JPEG Files (*.jpg)|*.jpg|"
  strFilter = strFilter & "Icon Files (*.ico)|*.ico|"
  strFilter = strFilter & "Windows Bitmap (*.bmp)|*.bmp|"
  strFilter = strFilter & "Windows Meta File (*.wmf)|.wmf"

  With CommonDialog1
    .Filter = strFilter
    .DialogTitle = "Grafik laden"
    .InitDir = App.Path
    .ShowOpen

    If Len(.FileName) <> 0 Then
      With picBoxImage
        .Picture = LoadPicture(CommonDialog1.FileName)

        m_sngImageWidth = .Width
        m_sngImageHeight = .Height
      End With

      HScroll1.Value = 0
      VScroll1.Value = 0
      GetScrollBars
    End If
  End With
  On Error GoTo 0

  Exit Sub
ErrHandler:
End Sub
 
Weitere Links zum Thema
Form scrollen
Grafik an PictureBox anpassen und zentrieren
Teilbereich einer Form scrollen

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (8 kB) Downloads bisher: [ 1507 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 21. August 2011