vb中picturebox控件中的图片如何实现放大缩小漫游

Question

请问谁有这方面的代码没啊！急用
用按钮控制放大缩小漫游

Answer 1

picture上放一个image，通过控制image的大小控制图片大小，我觉得这个最简单

Answer 2

完美的图片浏览保存图像的放大缩小，拖动，滚动条移动 等等，是个比较复杂的工程的。通过picture上放一个image对于拖动很容易实现，放大就不行了，特别是无限制的放大。

Answer 3

Option ExplicitPrivate m_pic As IPictureDisp
Private m_rate As DoublePrivate Sub Draw()
    Picture1.Cls
    Picture1.PaintPicture m_pic, 0, 0, 800 * m_rate, 600 * m_rate, 0, 0, 800, 600
End SubPrivate Sub Command1_Click()
    m_rate = m_rate * 2
    Draw
End SubPrivate Sub Command2_Click()
    m_rate = m_rate / 2
    Draw
End SubPrivate Sub Form_Load()
    Set m_pic = LoadPicture("C:\WINDOWS\Web\Wallpaper\Bliss.bmp")
    m_rate = 1
    Picture1.AutoRedraw = True
    Picture1.ScaleMode = vbPixels
    Draw
End Sub

Answer 4

API StretchBlt 专干这勾当！

Answer 5

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Picture1.Move X, YEnd SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Picture1.Drag   ' 拖标签轮廓。
End Sub

Answer 6

这个对你应该有用：图形放大/修改後的存档
来源:cwwVB中图存档使用 SavePicture 指令，而它的叁数是
   picture       产生图形档案的 PictureBox 控制项或 Image 控制项。
   stringexpression   储存的图形档案名称而我的作法是：在PictureBox的Image属性上作动作，因为PictureBox上的Picture经设
定後，它就固定下来，我们在其上的绘图等动作，基本上没有动到Picture属性所指的图
，而想改变到图，就只能从Image上着手。所以了，一定得设定PictureBox的AutoRedraw
为True，这才会使绘图的动作在Image上发生，最後再使用SavePicture的指令，传Image
当第一个叁数来存档。这里有另一个重要的问题，如果PictureBox的大小是100*100，
而实际进来的图是50*50，那麽，PictureBox.Image其大小范围仍是100*100，因而我一开
始设定PictureBox的长宽各为1，等後来图放大後，PictureBox Image的大小也随之变大。
也正因我们使用的是PictureBox的Image物件，所以存档的结果只能是Bitmap图，这点要
特别注意。'需一个PictureBox, 一个Command button
Option Explicit
Dim pic As New StdPicture
Private Sub Command1_Click()
Set pic = LoadPicture("e:\girl.bmp") '请输入想放大/缩小的图
Call setScope(pic, 0.5, 0.5, Picture1) '缩小0.5倍，将之放入Picture1
SavePicture Picture1.Image, "e:\t2.bmp"  '存档
Picture1.Visible = True
End Sub
Private Sub Form_Load()
Me.ScaleMode = 3
Picture1.AutoRedraw = True
Picture1.ScaleMode = 3Picture1.BorderStyle = 0
Picture1.Visible = FalsePicture1.Width = 1 '设定PictureBox为最小
Picture1.Height = 1End SubPrivate Sub setScope(pic As StdPicture, ByVal xRate As Double, _
ByVal yRate As Double, pic2 As PictureBox)
 Dim dstWidth As Long, dstHeight As Long
 Dim srcWidth As Long, srcHeight As Long
 Dim x As Long, y As Long
 Dim i As Long srcHeight = pic2.ScaleY(pic.Height, vbHimetric, vbPixels)
 srcWidth = pic2.ScaleX(pic.Width, vbHimetric, vbPixels) dstHeight = CLng(srcHeight * yRate)
 If dstHeight < 0 Then
    y = -1 * dstHeight
 Else
    y = 0
 End If
 dstWidth = CLng(srcWidth * xRate)
 If dstWidth < 0 Then
    x = -1 * dstWidth
 Else
    x = 0
 End If
 pic2.Width = Abs(dstWidth) '改变PictureBox的大小
 pic2.Height = Abs(dstHeight)
 pic2.PaintPicture pic, x, y, dstWidth, dstHeight, 0, 0, srcWidth, srcHeightEnd Sub这个是我在：http://download.csdn.net/source/1627065中找到的

Answer 7

Option ExplicitPrivate m_pic As IPictureDisp
Private m_rate As Double
Private m_OnDrag As Boolean
Private m_MoveX As Single
Private m_MoveY As Single
Private m_LastMouseX As Single
Private m_LastMouseY As SinglePrivate Sub Draw()
    Picture1.Cls
    Picture1.PaintPicture m_pic, m_MoveX, m_MoveY, 800 * m_rate, 600 * m_rate, 0, 0, 800, 600
End SubPrivate Sub Command1_Click()
    m_rate = m_rate * 2
    m_MoveX = m_MoveX * 2
    m_MoveY = m_MoveY * 2
    Draw
End SubPrivate Sub Command2_Click()
    m_rate = m_rate / 2
    m_MoveX = m_MoveX / 2
    m_MoveY = m_MoveY / 2
    Draw
End SubPrivate Sub Form_Load()
    Set m_pic = LoadPicture("C:\WINDOWS\Web\Wallpaper\Bliss.bmp")
    m_rate = 1
    Picture1.AutoRedraw = True
    Picture1.ScaleMode = vbPixels
    Draw
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        m_OnDrag = True
        m_LastMouseX = X
        m_LastMouseY = Y
    End If
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If m_OnDrag Then
        m_MoveX = m_MoveX + (X - m_LastMouseX)
        m_MoveY = m_MoveY + (Y - m_LastMouseY)
        m_LastMouseX = X
        m_LastMouseY = Y
        Draw
    End If
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button = vbLeftButton) And m_OnDrag Then
        m_OnDrag = False
        m_MoveX = m_MoveX + (X - m_LastMouseX)
        m_MoveY = m_MoveY + (Y - m_LastMouseY)
        m_LastMouseX = X
        m_LastMouseY = Y
        Draw
    End If
End Sub