如何将一个图片加入到picturebox中后实现对其放大、缩小和移图的功能？

[zhffh]

最好给出代码

[TclWangjq]

用两个picturebox, 一个作外框，另一个装图片的放在外框的里面，很简单就实现了。

[zhffh]

我想象一般的看图软件那样，用鼠标移图，请指教，实现后分数马上给：）

[zhffh]

还有为什么缩小后就失真，很难看，请指教

[sureli]

用鼠标移图
Two pictureBox:picture1,picture2

Private Sub picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
picture1.Drag vbBeginDrag

End If
End Sub
Private Sub picture2_DragDrop(Source As Control, X As Single, Y As Single)
'注意把Source.FileName，即picture1的图片的文件名 传递进来
picture2.Picture = LoadPicture(Source.FileName)
picture2.PaintPicture picture2.Picture, 0, 0, picture2.ScaleWidth, picture2.ScaleHeight

End Sub

Private Sub picture2_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
Select Case State
Case vbEnter
' 装载图标。
Source.DragIcon = ？'这里装入拖放时显示的图标
Case vbLeave
Source.DragIcon = LoadPicture() ' 卸载图标.
End Select

End Sub

[bluecc]

显示效果怎么样,会不会跳啊跳的

[zhffh]

不会跳啊跳的，就是失去很多色彩

[zhffh]

多谢sureli()，但我所指的是在一个pictureBox里有一个很大的图片，需要按住鼠标后拖动后以显示该图的其余部分，就象acdsee一样，我就需要acdsee中的放大、缩小和漫游（我前面叫移图）。
解答好者，另加100分，多谢！

[smilejiangjun]

将图片加入PICTUREBOX进行操作

这是别人的代码，很不错
StretchBlt 其定义如下：
Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, _
ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hSrcdc As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long

hdc 待绘图的hDc
x, y 待绘图目标的起点座标
nWidth, nHeight 绘图的长宽(by Pixels)
hSrcDc 来源Dc
xSrc, ySrc 来源图的起点座标
nSrcWidth, nSrcHeight 来源图的长宽
dwRop 绘图的方式

由以上的叁数，我们知道事实上可以取来源图的一部份(方形区域)来缩放，而目的绘图
区呢，它可以指定从某个起始座标开始画(不一定 (0,0) )，而nWidth与nHeight控制图
的缩放，例如说nWidth = CLng(1.5 * nSrcWidth), nHeight = CLng(nSrcHeight * 1.5)
那代表比原图放大1.5倍，如果nWidth = -1 * nSrcWidth 表该图会左右相反，而
nHeight = -1 * nSrcHeight 时则会有上正颠倒的图出现。以下提供一个副程式，该副
程式简化了StretchBlt，允许我们画一个图於Form/PictureBox的左上角，并可以放大
缩小或翻转。

DrawBitMap(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)

该副程式中
hDst 是待绘图的物件(可以为Form或PictureBox)
xRate 宽度缩放比例
rRate 长度缩放比例
FileName 图形档名


'以下在.Bas
Option Explicit
Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Const SRCCOPY = &HCC0020

Public Sub DrawBitMap(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As StdPicture
Dim hDc5 As Long, i As Long

Set pic = LoadPicture(FileName) '读取图形档

hDc5 = CreateCompatibleDC(0) '建立Memory DC
i = SelectObject(hDc5, pic.Handle) '在该memoryDC上放上bitmap图

srcHeight = Dst.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Dst.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
Call StretchBlt(Dst.hdc, x, y, dstWidth, dstHeight, hDc5, 0, 0, srcWidth, srcHeight, SRCCOPY)
Call DeleteDC(hDc5)
End Sub


Public Sub DrawPicture(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As StdPicture
Dim i As Long

Set pic = LoadPicture(FileName) '读取图形档

srcHeight = Dst.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Dst.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
Dst.ScaleMode = 3
Dst.PaintPicture pic, x, y, dstWidth, dstHeight, 0, 0, srcWidth, srcHeight

End Sub


'以下在Form需两个command button一个PictureBox
Private Sub Command1_Click()
Call DrawBitMap(Me, 1.5, -1.5, "c:\windows\circles.bmp") '放大1.5倍并上下翻转
End Sub

Private Sub Command2_Click()
Call DrawBitMap(Picture1, 1.5, -1.5, "c:\windows\client.ico") '放大1.5倍并上下翻转
End Sub

[wealth]

用到这么多API函数啊，注意是用VB，不是用VC！

其实如果注意一下那个打印预览，就可以了，只要将相对坐标设成不同的值就可以了！

[sureli]

module1:

Option Explicit

Public Type typMousePos
x As Single
y As Single
End Type

form1:picview在picbox里

Option Explicit
Private mP As typMousePos

Private Sub Form_Activate()
picView.BackColor = picBox.BackColor
If (picView.Width > picBox.Width) Or (picView.Height > picBox.Height) Then
picView.MousePointer = 5
Else
picView.MousePointer = 0
End If
End Sub

Private Sub Form_Deactivate()
Unload Me
End Sub

Private Sub Form_Load()
picView.Picture = LoadPicture("f:\picture\1.jpg")
picView.Left = 0
picView.Top = 0
picView.AutoSize = True
picView.Appearance = 0
End Sub

Private Sub picView_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
mP.x = x
mP.y = y
End If
End Sub

Private Sub picView_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim tmpX As Single, tmpY As Single
If Button = 1 Then
tmpX = picView.Left + x - mP.x
tmpY = picView.Top + y - mP.y
If tmpX > 0 Then tmpX = 0
If tmpX + picView.Width < picBox.Width Then tmpX = picBox.Width - picView.Width
If tmpY > 0 Then tmpY = 0
If tmpY + picView.Height < picBox.Height Then tmpY = picBox.Height - picView.Height
picView.Left = tmpX
picView.Top = tmpY
End If
End Sub

[vc_tapi]

up