如何放大vb中的滚动面板内的图像

Question

我有一个可滚动的面板，其中图像/图片框位于之内。

我想放大和缩小图像，而不会让按钮消失在面板的左下方。顺便说一下，图像是在它的实际大小。

如果我让它成为一个可以放大和缩小的可滚动面板，我还能通过不使用屏幕坐标而是使用实际图像坐标来获取图像坐标吗？

请帮助我

Answer 1

我不知道你所说的

放大的意思和缩小图像而不按钮消失

但是你可以使用创造了这个控制鲍勃鲍威尔。他的网站似乎已经离线了，但是我发现这个代码：

Imports System 
Imports System.Collections 
Imports System.ComponentModel 
Imports System.Drawing 
Imports System.Drawing.Drawing2D 
Imports System.Windows.Forms 


Namespace bobpowell.net 
    '/ <summary> 
    '/ ZoomPicBox does what it says on the wrapper. 
    '/ </summary> 
    '/ <remarks> 
    '/ PictureBox doesn't lend itself well to overriding. Why not start with something basic and do the job properly? 
    '/ </remarks> 

    Public Class ZoomPicBox 
    Inherits ScrollableControl 

    Private _image As Image 

    <Category("Appearance"), Description("The image to be displayed")> _ 
    Public Property Image() As Image 
    Get 
     Return _image 
    End Get 
    Set 
     _image = value 
     UpdateScaleFactor() 
     Invalidate() 
    End Set 
    End Property 

    Private _zoom As Single = 1F 

    <Category("Appearance"), Description("The zoom factor. Less than 1 to reduce. More than 1 to magnify.")> _ 
    Public Property Zoom() As Single 
    Get 
     Return _zoom 
    End Get 
    Set 
     If value < 0 OrElse value < 1E-05 Then 
     value = 1E-05F 
     End If 
     _zoom = value 
     UpdateScaleFactor() 
     Invalidate() 
    End Set 
    End Property 


    Private Sub UpdateScaleFactor() 
    If _image Is Nothing Then 
     Me.AutoScrollMargin = Me.Size 
    Else 
     Me.AutoScrollMinSize = New Size(CInt(Me._image.Width * _zoom + 0.5F), CInt(Me._image.Height * _zoom + 0.5F)) 
    End If 
    End Sub 'UpdateScaleFactor 

    Private _interpolationMode As InterpolationMode = InterpolationMode.High 

    <Category("Appearance"), Description("The interpolation mode used to smooth the drawing")> _ 
    Public Property InterpolationMode() As InterpolationMode 
    Get 
     Return _interpolationMode 
    End Get 
    Set 
     _interpolationMode = value 
    End Set 
    End Property 


    Protected Overrides Sub OnPaintBackground(pevent As PaintEventArgs) 
    End Sub 'OnPaintBackground 

    ' do nothing. 

    Protected Overrides Sub OnPaint(e As PaintEventArgs) 
    'if no image, don't bother 
    If _image Is Nothing Then 
     MyBase.OnPaintBackground(e) 
     Return 
    End If 
    'Set up a zoom matrix 
    Dim mx As New Matrix(_zoom, 0, 0, _zoom, 0, 0) 
    mx.Translate(Me.AutoScrollPosition.X/_zoom, Me.AutoScrollPosition.Y/_zoom) 
    e.Graphics.Transform = mx 
    e.Graphics.InterpolationMode = _interpolationMode 
    e.Graphics.DrawImage(_image, New Rectangle(0, 0, Me._image.Width, Me._image.Height), 0, 0, _image.Width, _image.Height, GraphicsUnit.Pixel) 
    MyBase.OnPaint(e) 
    End Sub 'OnPaint 


    Public Sub New() 
    'Double buffer the control 
    Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.UserPaint Or ControlStyles.ResizeRedraw Or ControlStyles.UserPaint Or ControlStyles.DoubleBuffer, True) 

    Me.AutoScroll = True 
    End Sub 'New 
    End Class 'ZoomPicBox 
End Namespace 'bobpowell.net