回 帖 发 新 帖 刷新版面

主题:如何实现图片放大缩小功能?

我用IMAGE BOX放大IMAGE BOX 然后再拉申图片   但是怎么实现控件移动?我的想法是捕捉鼠标坐标 然后对比  做个MOVE事件    不停地移动控件   

但是怎么捕捉坐标我不会   希望大家指导
另外有更好地方法吗?

回复列表 (共11个回复)

沙发

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Image1.Move X, Y
End Sub

试一下,是不是这个效果?
[em1]

板凳

效果不好~~~~~~但是给了我灵感!!!!谢谢!!!

3 楼

我想鼠标点下去后开始移动   鼠标弹起来后结束移动   但是不能MOUSEDOWN里套MOUSEMOVE~~~~怎么解决请问?

4 楼

点下去开始移动,弹起来结束移动,
那不就是拖动吗?
就drag方法和dragdrop事件就可以罗。

5 楼

Option Explicit
Dim xx As Single, yy As Single '当鼠标开始拖动时,它所拖的究竟是该控件的哪一个点,在最后定位时要修正
Dim preX As Single, preY As Single '拖它之前控件所处的位置,当拖完后鼠标还在该控件内,就要用此值来修正

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    preX = Image1.Left
    preY = Image1.Top
    xx = X
    yy = Y '以上四行是记录初始值
    Image1.Drag 1 '开始拖动
End Sub

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
    '如果鼠标拖动image1到另一个位置,鼠标已经处在image1的老位置之外,
    '则激发form_DragDrop事件
    Source.Move X - xx, Y - yy '因为鼠标不一定会点住控件的最左上角(0,0)拖动,所以要用xx,yy修正
End Sub

Private Sub Image1_DragDrop(Source As Control, X As Single, Y As Single)
    '如果鼠标拖动image1的距离太小,以至于鼠标仍在image1上
    '则激发Image1_DragDrop事件
    Source.Move preX + X - xx, preY + Y - yy '(X-xx,Y-yy)是相对位移
End Sub

6 楼

谢谢

7 楼

Source.Move X - xx, Y - yy

source 是代表当前对象吗?

8 楼

你当它是一个对像就是了,
既然函数传递了一个参数给你,
你就用呗,别客气。

9 楼

运行以下程序你也许就有灵感了。
联系:QQ:48699227

'模块module1
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Function ReleaseCapture Lib "user32" () As Long

Public Const HTLEFT = 10
Public Const HTRIGHT = 11
Public Const HTTOP = 12
Public Const HTBOTTOM = 15
Public Const WM_NCLBUTTONDOWN = &HA1


'窗体,加入一个Command Button就可以了。
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim nParam As Long
If Y > 0 And Y < 100 Then
    nParam = HTTOP
End If
If Y > Command1.Height - 100 And Y < Command1.Height Then
    nParam = HTBOTTOM
End If

If X > 0 And X < 100 Then
    nParam = HTLEFT
End If
If X > Command1.Width - 100 And X < Command1.Width Then
    nParam = HTRIGHT
End If
If nParam Then
    Call ReleaseCapture
    Call SendMessage(Command1.hwnd, WM_NCLBUTTONDOWN, nParam, 0)
End If

End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim NewPointer As MousePointerConstants
If Y > 0 And Y < 100 Then
    NewPointer = vbSizeNS
End If
If Y > Command1.Height - 100 And Y < Command1.Height Then
    NewPointer = vbSizeNS
End If
If X > 0 And X < 100 Then
    NewPointer = vbSizeWE
End If
If X > Command1.Width - 100 And X < Command1.Width Then
    NewPointer = vbSizeWE
End If
If NewPointer <> Command1.MousePointer Then
    Command1.MousePointer = NewPointer
End If


End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim nParam As Long
If Y > 0 And Y < 100 Then
    nParam = HTTOP
End If
If Y > Me.Height - 100 And Y < Me.Height Then
    nParam = HTBOTTOM
End If
If X > 0 And X < 100 Then
    nParam = HTLEFT
End If
If X > Me.Width - 100 And X < Me.Width Then
    nParam = HTRIGHT
End If
If nParam Then
    Call ReleaseCapture
    Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, nParam, 0)
End If

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim NewPointer As MousePointerConstants
If Y > 0 And Y < 100 Then
    NewPointer = vbSizeNS
End If
If Y > Me.Height - 100 And Y < Me.Height Then
    NewPointer = vbSizeNS
End If
If X > 0 And X < 100 Then
    NewPointer = vbSizeWE
End If
If X > Me.Width - 100 And X < Me.Width Then
    NewPointer = vbSizeWE
End If
If NewPointer <> Me.MousePointer Then
    Me.MousePointer = NewPointer
End If

End Sub

10 楼

艾~~~~~~小弟看不懂楼上的~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

我来回复

您尚未登录,请登录后再回复。点此登录或注册