主题:如何实现图片放大缩小功能?
魅力人生
[专家分:60] 发布于 2004-04-02 22:42:00
我用IMAGE BOX放大IMAGE BOX 然后再拉申图片 但是怎么实现控件移动?我的想法是捕捉鼠标坐标 然后对比 做个MOVE事件 不停地移动控件
但是怎么捕捉坐标我不会 希望大家指导
另外有更好地方法吗?
回复列表 (共11个回复)
沙发
szl8211b [专家分:850] 发布于 2004-04-02 21:56:00
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.Move X, Y
End Sub
试一下,是不是这个效果?
[em1]
板凳
魅力人生 [专家分:60] 发布于 2004-04-02 22:22:00
效果不好~~~~~~但是给了我灵感!!!!谢谢!!!
3 楼
魅力人生 [专家分:60] 发布于 2004-04-02 22:24:00
我想鼠标点下去后开始移动 鼠标弹起来后结束移动 但是不能MOUSEDOWN里套MOUSEMOVE~~~~怎么解决请问?
4 楼
偷猫 [专家分:15960] 发布于 2004-04-03 07:34:00
点下去开始移动,弹起来结束移动,
那不就是拖动吗?
就drag方法和dragdrop事件就可以罗。
5 楼
偷猫 [专家分:15960] 发布于 2004-04-03 07:53:00
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 楼
魅力人生 [专家分:60] 发布于 2004-04-03 09:02:00
谢谢
7 楼
魅力人生 [专家分:60] 发布于 2004-04-03 10:35:00
Source.Move X - xx, Y - yy
source 是代表当前对象吗?
8 楼
偷猫 [专家分:15960] 发布于 2004-04-03 11:50:00
你当它是一个对像就是了,
既然函数传递了一个参数给你,
你就用呗,别客气。
9 楼
svnson [专家分:870] 发布于 2004-04-03 12:23:00
运行以下程序你也许就有灵感了。
联系: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 楼
魅力人生 [专家分:60] 发布于 2004-04-03 12:30:00
艾~~~~~~小弟看不懂楼上的~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
我来回复