Search code examples
vb.netzooming

How to zoom in a Picturebox with Buttons instead of scrollwheel in vb.net?


I am using the below code to zoom in\out image in picturebox1 with scrollwheel, but now I want to use buttons instead zoom in button and zoom out button

thanks advance This code from: How to zoom in a Picturebox with scrollwheel in vb.net

Public Class Form1




    Private _originalSize As Size = Nothing
    Private _scale As Single = 1
    Private _scaleDelta As Single = 0.0005

    Private Sub Form_MouseWheel(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel

        'if very sensitive mouse, change 0.00005 to something even smaller   
        _scaleDelta = Math.Sqrt(PictureBox1.Width * PictureBox1.Height) * 0.00005

        If e.Delta < 0 Then
            _scale -= _scaleDelta
        ElseIf e.Delta > 0 Then
            _scale += _scaleDelta
        End If

        If e.Delta <> 0 Then _
        PictureBox1.Size = New Size(CInt(Math.Round(_originalSize.Width * _scale)), _
                                    CInt(Math.Round(_originalSize.Height * _scale)))

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage

        'init this from here or a method depending on your needs
        If PictureBox1.Image IsNot Nothing Then
            PictureBox1.Size = Panel1.Size
            _originalSize = Panel1.Size
        End If

    End Sub

End Class


Solution

  • The code below should do what you need. While the mouse is down on button1, the picturebox will be scaled down. You may of course need to add checks to set a minimum size. People may frown on the use of Application.DoEvents, but in this case, it may well be ok for you if you as the user is occupied with holding down the mouse button and not doing anything else that could cause problems.

    Basically what is happening is .. when the user clicks on the button1, the program sets the variable mouseIsDown to True and executes the code in ShrinkPictureBox This loop will keep running until mouseIsDown is set to false.

    Application.Doevents in the loop enables the system to listen for the MouseUp event. When this happens, mouseIsDown is set to false, and the loop will end.

    Same thing for button2, except the EnlargeBox code is executed.

    I would add here that Application.DoEvents is not to be used lightly. Most of the time it is a bad idea as it allows the user to click on things you might not want them clicking on if a program is busy doing something.

    Private _originalSize As Size = Nothing
    Private _scale As Single = 1
    Private _scaleDelta As Single = 0.00005
    Dim mouseIsDown As Boolean = False
    
    
    
    Private Sub ShrinkPictureBox()
        Do While mouseIsDown
            Application.DoEvents()
            If PictureBox1.Size.Width > 2 Then
                _scale -= _scaleDelta
                PictureBox1.Size = New Size(CInt(Math.Round(_originalSize.Width * _scale)),
                                    CInt(Math.Round(_originalSize.Height * _scale)))
                PictureBox1.Refresh()
            End If
        Loop
    End Sub
    
    Private Sub EnlargePictureBox()
        Do While mouseIsDown
            Application.DoEvents()
            _scale += _scaleDelta
            PictureBox1.Size = New Size(CInt(Math.Round(_originalSize.Width * _scale)),
                                        CInt(Math.Round(_originalSize.Height * _scale)))
            PictureBox1.Refresh()
        Loop
    End Sub
    
    Private Sub Button1_MouseDown(sender As Object, e As MouseEventArgs) Handles Button1.MouseDown
        mouseIsDown = True
        ShrinkPictureBox()
    End Sub
    
    Private Sub Button1_MouseUp(sender As Object, e As MouseEventArgs) Handles Button1.MouseUp
        mouseIsDown = False
    End Sub
    
    Private Sub Button2_MouseDown(sender As Object, e As MouseEventArgs) Handles Button2.MouseDown
        mouseIsDown = True
        EnlargePictureBox()
    End Sub
    
    Private Sub Button2_MouseUp(sender As Object, e As MouseEventArgs) Handles Button2.MouseUp
        mouseIsDown = False
    End Sub