Laggy Image in visual basic
I have an image with 10,000px by 8,000px with a drag method. the problem is that whenever I zoom it in/out or drag it the image flickers. how can I avoid this problem?
I tried resizing into smaller one, but the image becomes pixelated and I cant read anymore the texts in it.
Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
'PictureBox1.CreateGraphics.DrawLine(Pens.Cyan, e.Location.X, e.Location.Y, e.X, e.Y + 100)
' PictureBox1.CreateGraphics.DrawEllipse(Pens.Cyan, New Rectangle(e.Location.X - 7.5, e.Location.Y - 7.5, 15, 15))
If e.Button = Windows.Forms.MouseButtons.Left Then
mouseDowns = e.Location
End If
LocalMousePosition = PictureBox1.PointToClient(Cursor.Position)
Label1.Text = TranslateImageCoordinate(LocalMousePosition).X.ToString
Label2.Text = TranslateImageCoordinate(LocalMousePosition).Y.ToString
Label3.Text = WhereIAm(TranslateImageCoordinate(LocalMousePosition))
If WhereIAm(TranslateImageCoordinate(LocalMousePosition)) = "" Then
TextBox1.Focus()
End If
End Sub
Private Function TranslateImageCoordinate(ByVal coordinate As Point) As Point
Dim ratioWidth, ratioHeigth As Double
ratioWidth = PictureBox1.Image.Size.Width / PictureBox1.Size.Width
ratioHeigth = PictureBox1.Image.Size.Height / PictureBox1.Size.Height
Dim newXc As Double
Dim newYc As Double
newXc = ratioWidth * coordinate.X
newYc = ratioHeigth * coordinate.Y
Return New Point(newXc, newYc)
End Function
Private Function reverseImageCoordinate(ByVal coordinate As Point) As Point
Dim ratioWidth, ratioHeigth As Double
ratioWidth = PictureBox1.Image.Size.Width / PictureBox1.Size.Width
ratioHeigth = PictureBox1.Image.Size.Height / PictureBox1.Size.Height
Dim newXc As Double
Dim newYc As Double
newXc = coordinate.X / ratioWidth
newYc = coordinate.Y / ratioHeigth
Return New Point(newXc, newYc)
End Function
Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Pict开发者_如何转开发ureBox1.MouseMove
LocalMousePosition = PictureBox1.PointToClient(Cursor.Position)
'========================PRINT IMAGE COORDINATE=======================================
' Label1.Text = TranslateImageCoordinate(LocalMousePosition).X
' Label2.Text = TranslateImageCoordinate(LocalMousePosition).Y
'=====================================================================================
Dim mouse As MouseEventArgs = e
If (mouse.Button = Windows.Forms.MouseButtons.Left) Then
Dim mousePosNow As Point = mouse.Location
Dim deltaX As Integer = mousePosNow.X - mouseDowns.X
Dim deltaY As Integer = mousePosNow.Y - mouseDowns.Y
Dim newX As Integer = Clamp(PictureBox1.Location.X + deltaX, PictureBox1.Width, Panel1.Width)
Dim newY As Integer = Clamp(PictureBox1.Location.Y + deltaY, PictureBox1.Height, Panel1.Height)
PictureBox1.Location = New Point(newX, newY)
End If
End Sub
Private Function Clamp(ByVal val As Integer, ByVal outerBound As Integer, ByVal innerBound As Integer) As Integer
Dim newVal As Integer = val
If newVal > 0 Then
newVal = 0
End If
If newVal + outerBound < innerBound Then
newVal = innerBound - outerBound
End If
Return newVal
End Function
Private Sub Form1_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel
Dim newWidth As Integer = PictureBox1.Image.Size.Width, _
newHeight = PictureBox1.Image.Size.Height, _
newX = PictureBox1.Location.X, _
newY = PictureBox1.Location.Y
If e.Delta > 0 Then
newWidth = PictureBox1.Size.Width + (PictureBox1.Size.Width / 10)
newHeight = PictureBox1.Size.Width + (PictureBox1.Size.Height / 10)
newX = PictureBox1.Location.X - ((PictureBox1.Size.Width / 10) / 2)
newY = PictureBox1.Location.Y - ((PictureBox1.Size.Height / 10) / 2)
ElseIf e.Delta < 0 Then
newWidth = PictureBox1.Size.Width - (PictureBox1.Size.Width / 10)
newHeight = PictureBox1.Size.Width - (PictureBox1.Size.Height / 10)
newX = PictureBox1.Location.X + ((PictureBox1.Size.Width / 10) / 2)
newY = PictureBox1.Location.Y + ((PictureBox1.Size.Height / 10) / 2)
If (newWidth < Panel1.Width Or newHeight < Panel1.Height) Then
newWidth = Panel1.Width
newHeight = Panel1.Height
newX = Panel1.Location.X
newY = Panel1.Location.Y
End If
If newX > Panel1.Location.X Then
newX = 0
End If
If newY > Panel1.Location.Y Then
newY = 0
End If
If (newX + newWidth) < (Panel1.Location.X + Panel1.Width) Then
newX = (Panel1.Location.X + Panel1.Width) - PictureBox1.Width
End If
If (newY + newHeight) < (Panel1.Location.Y + Panel1.Height) Then
newY = (Panel1.Location.Y + Panel1.Height) - PictureBox1.Height
End If
End If
PictureBox1.Hide()
PictureBox1.Size = New Size(newWidth, newHeight)
PictureBox1.Location = New Point(newX, newY)
PictureBox1.Show()
Label3.Text = zoomCounter
End Sub
the code up there is the zoom in/zoom out and panning.
精彩评论