如何移动picture控件
如题所说
窗口中有两个picture控件,我想让一个picture控件可以在另一个picture中移动。
请问怎么弄?
先谢了。
[解决办法]
方法1
在Picture1内拖动Picture2的代码设置picture1的dragmode为0(手动):
Option Explicit
Dim cX As Long
Dim cY As Long
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture2.Drag 1
cX = X: cY = Y
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture2.Drag 1
End Sub
Private Sub Picture1_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move X - cX, Y - cY
End Sub
方法2
在Picture1内用滚动条移动Picture2:
用两个PictureBox控件,首先在窗体添加1个PictureBox控件Picture1,然后在Picture1中间用鼠标加载另1个PictureBox控件Picture2.
在穿体添加剂个HScroll控件于窗体或Picture1内,调整Picture2的Height.
垂直滚动条建议不要与水平滚动条同时使用,会报错或当机.
代码如下:
Private Sub Form_Load()
Me.Height = 11295
Me.Width = 15360
Picture1.Width = Me.Width - 400
'Picture2.Height = Picture1.Height
Picture2.Width = Picture1.Width * 2.1 '倍率可调整
End Sub
Private Sub HScroll1_Change()
Picture2.Left = -HScroll1 * 0.5倍率需调整
End Sub
[解决办法]
Private Declare Function ReleaseCapture Lib "user32 " () As Long
Private Declare Function SendMessage Lib "user32 " Alias "SendMessageA " (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Picture2.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
End Sub