VB在picture控件里，用鼠标点中的图片区域，实现区域的放缩

Question

下位机上传的数据在picture控件里描点后，怎么样编程一个放缩按钮使之实现：鼠标点击放大按钮后，再点击picture控件里的图像的一处，就可以使包括该点在内的小块区域放大，使这个功能就像MATLAB里面图像上面的那个放缩按钮一样的功能，请教高手，非常感谢！

Answer 1

你好，我只是想把picturebox控件里面的绘制出来的图像放大，能不能不用API函数？谢谢！

Answer 2

也可不用api,你把picture那个原图像保存了备用
然后每次点击,从picture里面获得的位置左右上下定好框,把需要的部分保存成临时文件用来缩放

Answer 3

你也可以再加一个PictureBox，控制其尺寸和位置，然后载入图像，简单说就是两个PictureBox交替。
这个效率肯定比API差很多。

Answer 4

libralibra ，您好，我的picturebox里面的图像是实时接收下位机数据描点划线形成的，是在变化的，我只是想能够在想看更加精确的效果时想把picturebox里面选定的或者鼠标所在的一块区域放大，并且不影响下位机实时上传在原来的pinturebox里面描点，我要是按照您说的先保存在缩放那是不是要每次都要重新保存重新缩放？刚开始接触VB时间不长，请多多指教，谢谢！

Answer 5

我可以提供一个思路，我经常会用到试验仪器曲线绘制，显示的曲线实际上是自己定义的一个区间内的曲线，比如10分钟内的描点，那么10分钟内比如说可以取到600个点，也就是说1秒钟一个点，那么设置Timer控件用来刷新整个图像；需要放缩，实际上是坐标轴的放缩，就是Picture控件的ScaleHeight和Scalewidth属性的应用而已，时间有限，不能给你详细的程序了，你可以自己查询学习下。

Answer 6

我简要列一下可能需要用到的方法，函数
PictureBox.Scale设定坐标
PictureBox.Line绘制直线
PictureBox.PSet绘制点（注：这个方法VB没有提供智能提示，语法是Picture1.PSet(x1,y1)
首先绘制出坐标系，然后绘制两个假定的函数f(x),g(x),可以增加一个比较两个函数绝对值的函数，或者借鉴最小二乘法，希望能帮上你。

Answer 7

'程序有点错误，时间不够，你先参考下，左划放大，右划还原
Private mX As Single, mY As Single
Private Sub DrawScale(x1, y1, x2, y2)
Picture1.Cls
xx = (x2 - x1) / 20: yy = (y2 - y1) / 20
If xx < 5 Then xx = 5: If yy < 5 Then yy = 5
Picture1.Scale (x1 - xx, y1 - yy)-(x2 + xx, y2 + yy)
Picture1.Line (x1, y1)-(x1, y2)
Picture1.Line (x1, y2)-(x2, y2)
Picture1.CurrentY = y1
For X = x1 To x2 Step (x2 - x1) / 10
    Picture1.CurrentX = X
    Picture1.Print X
Next
Picture1.CurrentX = x2
For Y = y1 To y2 Step (y2 - y1) / 10
    Picture1.CurrentY = Y
    Picture1.Print Y
Next
End Sub
Private Sub Form_Load()
DrawScale 0, 10, 100, 0
DrawFunc 0, 100
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
mX = X: mY = Y
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Caption = CInt(X) & "," & CInt(Y)
End Sub
Private Sub DrawFunc(x1, x2)
Picture1.PSet (x1, Sin(x1))
For X = x1 To x2 Step (x2 - x1) / 500
    Picture1.Line -(X, Sin(X)), vbGreen
Next
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X > mX Then
    DrawScale mX, mY, X, Y
    DrawFunc mX, X
Else
    DrawScale 0, 10, 100, 0
    DrawFunc 0, 100
End IfEnd Sub