Автоматическое перемещение полос прокрутки при выборе прямоугольника для обрезки изображения в графическом блоке с помощью панели Autoscroll = True

У меня есть окно с картинками наверху панели ... У меня есть выбор прямоугольника, который можно использовать для выбора части изображения для обрезки ... Так как я установил свойство Autoscroll панели = True, и поскольку изображение в поле изображения является большой, я получаю полосы прокрутки. Но чтобы выбрать часть изображения для обрезки, мне нужно перетащить прямоугольник за пределы того, что я вижу. Я не могу этого сделать, когда указатель мыши достигает крайнего правого угла окна изображения. Я хотел бы спроектировать его таким образом, чтобы при достижении указателем мыши крайнего правого угла мои полосы прокрутки автоматически перемещались вправо. Но со свойством Autoscroll я не могу получить полосу прокрутки ценности. Есть ли обходной путь для этой проблемы ??


vb.net autoscroll picturebox scrollbars
person Shiva    schedule 06.05.2014    source источник
comment
Вы получаете их из свойства панели AutoScrollPosition. И вы можете назначить его для принудительной прокрутки панели.   -  person Hans Passant    schedule 06.05.2014

Ответы (1)


arrow_upward
1
arrow_downward

Это, вероятно, работает немного более плавно с таймером для перемещения свойства AutoScrollPosition:

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

Убедитесь, что таймер включен:

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
person LarsTech    schedule 06.05.2014