Передвижение объектов с помощью мыши
Вопрос в принципе в следующем. На форме есть Label при щелчке на нее она выделяется , а при нажатой левой кнопки мыши она двигается за ней. Как выделить я знаю, а вот как заставить двигаться за мышью я не могу сделать. По этому ЛЮДИ помогите. :confused:
Олгоритом:
0)В обработчике щелчка сохраняешь координаты мыши
1)В обработчике перемещения мыши смотришь,если нажата левая кнопка,то перемещаешь Label на величину разницы сохранённых координат и текущих
???
2)PROFIT!!!
0)В обработчике щелчка сохраняешь координаты мыши
1)В обработчике перемещения мыши смотришь,если нажата левая кнопка,то перемещаешь Label на величину разницы сохранённых координат и текущих
???
2)PROFIT!!!
Цитата: @pixo $oft
Олгоритом:
0)В обработчике щелчка сохраняешь координаты мыши
1)В обработчике перемещения мыши смотришь,если нажата левая кнопка,то перемещаешь Label на величину разницы сохранённых координат и текущих
???
2)PROFIT!!!
0)В обработчике щелчка сохраняешь координаты мыши
1)В обработчике перемещения мыши смотришь,если нажата левая кнопка,то перемещаешь Label на величину разницы сохранённых координат и текущих
???
2)PROFIT!!!
Ты бы не лурковал, а вызвался модером в этот раздел. Ибо без присмотра.
Я нашел простой ответ
Option Explicit
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 Declare Function ReleaseCapture Lib "USER32" () As Long
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Picture2.MousePointer = 15
Call ReleaseCapture
Call SendMessage(Picture2.hWnd, &HA1, 2, 0&)
Picture2.MousePointer = 1
End If
End Sub
только с Label он не работает но с другими контролами легко
Option Explicit
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 Declare Function ReleaseCapture Lib "USER32" () As Long
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Picture2.MousePointer = 15
Call ReleaseCapture
Call SendMessage(Picture2.hWnd, &HA1, 2, 0&)
Picture2.MousePointer = 1
End If
End Sub
только с Label он не работает но с другими контролами легко
Вы можете предоставить пользователям своего приложения возможность изменять размеры элемента управления с помощью мыши — аналогично тому, как вы это делаете в режиме разработки. Для этого необходимо только вызвать две простые функции Windows API — ReleaseCapture и SendMessage. Если задать диапазоны, в которых может двигаться мышь (например, X > 0 и X < 100)(За сколько мышь активизируется и способствует к раздвиженпию , событие MouseDown активизирует эти функции и меняет размеры элемента управления при перемещении мыши.
Предположим, что вы поместили на форму картинку (PictureBox). Теперь напишите для нее следующий код:
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 WM_NCLBUTTONDOWN = &HA1
' В API Viewer есть и другие константы
' Заданные здесь константы используются
' только для изменения правой и левой границ
Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Sub Picture1_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Dim nParam As Long
With Picture1
' Здесь вы можете задать любые координаты
If (X > 0 And X < 100) Then
nParam = HTLEFT
' и здесь тоже
ElseIf (X > .Width - 100 And X < .Width) Then
nParam = HTRIGHT
End If
If nParam Then
Call ReleaseCapture
Call SendMessage(.hWnd, WM_NCLBUTTONDOWN, nParam, 0)
End If
End With
End Sub
Private Sub Picture1_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Dim NewPointer As MousePointerConstants
' Здесь вы можете задать любые координаты
If (X > 0 And X < 100) Then
NewPointer = vbSizeWE
' и здесь тоже
ElseIf (X > Picture1.Width - 100 And X < Picture1.Width) Then
NewPointer = vbSizeWE
Else
NewPointer = vbDefault
End If
If NewPointer <> Picture1.MousePointer Then
Picture1.MousePointer = NewPointer
End If
End Sub
Предположим, что вы поместили на форму картинку (PictureBox). Теперь напишите для нее следующий код:
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 WM_NCLBUTTONDOWN = &HA1
' В API Viewer есть и другие константы
' Заданные здесь константы используются
' только для изменения правой и левой границ
Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Sub Picture1_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Dim nParam As Long
With Picture1
' Здесь вы можете задать любые координаты
If (X > 0 And X < 100) Then
nParam = HTLEFT
' и здесь тоже
ElseIf (X > .Width - 100 And X < .Width) Then
nParam = HTRIGHT
End If
If nParam Then
Call ReleaseCapture
Call SendMessage(.hWnd, WM_NCLBUTTONDOWN, nParam, 0)
End If
End With
End Sub
Private Sub Picture1_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Dim NewPointer As MousePointerConstants
' Здесь вы можете задать любые координаты
If (X > 0 And X < 100) Then
NewPointer = vbSizeWE
' и здесь тоже
ElseIf (X > Picture1.Width - 100 And X < Picture1.Width) Then
NewPointer = vbSizeWE
Else
NewPointer = vbDefault
End If
If NewPointer <> Picture1.MousePointer Then
Picture1.MousePointer = NewPointer
End If
End Sub