在线等,急~~~

Question

用paintpicture的方法加载图片后,为什么就没办法用下面的方法对图片进行拖动呢?
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
gX = x
gY = y
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Not Button = vbLeftButton Then Exit Sub
Dim dx As Long, dy As Long, ax As Long, ay As Long, t As Long, l As Long, tt As Long, ll As Long
With Picture1
dy = y - gY
dx = x - gX
ll = .Left
tt = .Top
l = Abs(ll)
t = Abs(tt)
ax = (.Width - l - ScaleWidth)
ay = (.Height - t - ScaleHeight)
If ll > 0 Then
dx = 0
Else
If dx < 0 Then
If Abs(dx) > ax Then dx = -ax
Else
If dx > l Then dx = l
End If
End If
If tt > 0 Then
dy = 0
Else
If dy < 0 Then
If Abs(dy) > ay Then dy = -ay
Else
If dy > t Then dy = t
End If
End If
.Move ll + dx, tt + dy
End With
End Sub那该怎么办呢?

Answer 1

你移动的是PICTURE控件,而不是里面的图片,这是你的本来意思么?如果需要移动里面的图片,控件不动,可以使用PICTURE控件的PAINTPICTURE方法.如果要移动控件,可以用RELEASECAPTURE这个API

Answer 2

me.Picture1.OLEDragMode = 0 恐怕你需要这方面的知识！

Answer 3

喂，老大，怎么会用move方法的？？？？这可是移动picturebox的位置而不是里面的图形。

Answer 4

'唉，看来不装回vb6真的很难在这里混下去'模块中：
Public 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
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Type BITMAP '14 bytes
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type'程序中：
Dim xnow As Long
Dim ynow As Long
Dim xtemp As Long
Dim ytemp As Long
Dim xchange As Long
Dim ychange As Long
Dim w As Long
Dim h As Long
Dim hBitmap As Long
Dim hmemDC As Long
Private Sub Form_Load()
Picture1.AutoRedraw = True
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Dim bm As BITMAP
Dim pic As Picture
Set pic = LoadPicture("c:\abc.bmp")
GetObject pic.Handle, LenB(bm), bm
w = bm.bmWidth
h = bm.bmHeight
hmemDC = CreateCompatibleDC(Picture1.hDC)
SelectObject hmemDC, pic.Handle
StretchBlt Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, hmemDC, 0, 0, Picture1.Width, Picture1.Height, vbSrcCopy
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
xnow = X
ynow = Y
xchange = 0
ychange = 0
Picture1.AutoRedraw = False
End If
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
xchange = xtemp + xnow - X
ychange = ytemp + ynow - Y
If xchange > w - Picture1.Width Then xchange = w - Picture1.Width
If ychange > h - Picture1.Height Then ychange = h - Picture1.Height
If xchange < 0 Then xchange = 0
If ychange < 0 Then ychange = 0
If xchange > w Or ychange > h Or xchange < 0 Or ychange < 0 Then Exit Sub
StretchBlt Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, hmemDC, xchange, ychange, Picture1.Width, Picture1.Height, vbSrcCopy
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.AutoRedraw = True
xtemp = xchange
ytemp = ychange
End Sub'上面的代码里使用StretchBlt而不用bitblt，是因为考虑到你说还要进行缩放等操作
'不过建议楼主还是先搞清楚基本的图形语句和api再想其他事吧

Answer 5

If xchange > w Or ychange > h Or xchange < 0 Or ychange < 0 Then Exit Sub
是调试时候加上去的，没用，去掉。

Answer 6

谢谢lsftest()
如果我想让图片居中并根据所要缩放的倍数fold进行改变,
StretchBlt Picture1.hDC, Picture1.Width / 2 - pic.Width * fold / 2, Picture1.Height / 2 - pic.Height * fold / 2, pic.Width * fold, pic.Height * fold, hmemDC, 0, 0, Picture1.Width, Picture1.Height, vbSrcCopy
这样画不居中,而且会先出现个很大的马赛克,鼠标点一下大小又恢复没缩放的大小

Answer 7

居中应该只是简单的坐标问题，算准了就应该可以了但马赛克就比较麻烦用StretchBlt的放大效果很粗糙，可以说仅仅是聊胜于无，如果要好一点的效果就要自己做插值计算。。这可不是一两句话能说清的。。但我记得这里的多媒体版里有很多朋友都做过，应该有现成的源码，可以过去搜索一下以前的帖子或问问人。。至于恢复大小，从原dc里复制相应区域的图形在画回去就是了。