开发者

Laggy Image in visual basic

开发者 https://www.devze.com 2023-03-22 11:17 出处:网络
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 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.

0

精彩评论

暂无评论...
验证码 换一张
取 消