Move scrollbars automatically when doing a rectangle selection for cropping an image in the picture box with panel's Autoscroll = True

StackOverflow https://stackoverflow.com/questions/23496078

Domanda

I have a picturebox on top of a panel..I have a rectangle selection which can be used to select a portion of the image for cropping..Since I have set the Panel's Autoscroll property = True, and since the image in picture box is big, I get the scroll bars. But for selecting a portion of image for cropping, I need to drag the rectangle beyond what is visible to me. I cannot do so when the mouse reaches the extreme right of the picturebox.. I would like to design it in a way that when mouse reaches the extreme right my scroll bars should automatically move right.. But with Autoscroll property I cannot get the scrollbar values. Any workaround available for this problem??

È stato utile?

Soluzione

This probably works a little smoother with a Timer to move the AutoScrollPosition property:

Private horzMove As ArrowDirection = -1
Private vertMove As ArrowDirection = -1

Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
  If e.Button = MouseButtons.Left Then
    If Panel1.AutoScrollPosition.X + e.Location.X > Panel1.ClientSize.Width Then
      horzMove = ArrowDirection.Right
    ElseIf Panel1.AutoScrollPosition.X + e.Location.X < 0 Then
      horzMove = ArrowDirection.Left
    Else
      horzMove = -1
    End If
    If Panel1.AutoScrollPosition.Y + e.Location.Y > Panel1.ClientSize.Height Then
      vertMove = ArrowDirection.Down
    ElseIf Panel1.AutoScrollPosition.Y + e.Location.Y < 0 Then
      vertMove = ArrowDirection.Up
    Else
      vertMove = -1
    End If
  End If
End Sub

Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
  horzMove = -1
  vertMove = -1
End Sub

Make sure the timer is enabled:

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
  If horzMove > -1 Or vertMove > -1 Then
    Dim newLeft As Integer = -Panel1.AutoScrollPosition.X
    Dim newTop As Integer = -Panel1.AutoScrollPosition.Y
    Select Case horzMove
      Case ArrowDirection.Left
        newLeft = -Panel1.AutoScrollPosition.X - 32
      Case ArrowDirection.Right
        newLeft = -Panel1.AutoScrollPosition.X + 32
    End Select
    Select Case vertMove
      Case ArrowDirection.Down
        newTop = -Panel1.AutoScrollPosition.Y + 32
      Case ArrowDirection.Up
        newTop = -Panel1.AutoScrollPosition.Y - 32
    End Select
    Panel1.AutoScrollPosition = New Point(newLeft, newTop)
  End If
End Sub
Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow
scroll top