Перемещение элемента управления при помощи операции drag-and-drop
Рассмотрим диалоговое окно новые похождения колобка (рис. У6.5), с которым связана ниже приведенная программа, дающая два простых примера программирования операций drag-and-drop.

Рис. У6.5. Диалоговое окно Новые похождения Колобка
'
' Определение переменной уровня модуля
Dim Kono6oкDataObject As DataObject
'
Private Sub imagel_MouseDown(ByVal Button As Integer,
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
'ПечальныйКолобок
End If
End Sub
Private Sub Imagel_MouseUp(ByVal Button As Integer,
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then ВеселыйКолобок
End If
End Sub
Private Sub Imagel_MouseMove(ByVal Button As Integer,
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
IfX^2+Y^2 = 0 Then A = 0 В = 0
Else
A = X / Sqr(X л 2 + Y л 2) В = Y / SqrtX л 2 + Y л 2)
End if With Imagel
.Top = Imagel.Top + В
.Left = Imagel.Left + A
End With
End If
End Sub
'
Private Sub Labell_MouseMove(ByVal Button As Integer,
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
Set КoлoбoкDataObject = New DataObject
Dim ТипПеремещения As Integer
Kono6oKDataObject.SetText Labell.Caption
ТипПеремещения = КoлoбoкDataObject.StartDrag
End If
End Sub
Private Sub Label2_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean,
ByVal Data As MSForms.DataObject,
ByVal X As Single, ByVal Y As Single,
ByVal DragState As Long,
ByVal Effect As MSForms.ReturnEffeet,
ByVal Shift As Integer)
Cancel = True
Effect = fmDropEffectCopy
End Sub
Private Sub Label2_BeforeDropOrPaste(ByVal Cancel
As MSForms.ReturnBoolean,
ByVal Action As Long,
ByVal Data As MSForms.DataObject,
ByVal X As Single,
ByVal Y As Single,
ByVal Effect As MSForms.ReturnEffeet,
ByVal Shift As Integer)
Cancel = True
Effect = fmDropEffectCopy
Label2. Caption = KолoбoкDataObject .GetText
End Sub
Private Sub UserForm_Initialize()
'
Labell.BorderStyle = fmBorderStyleSingle
Label2.BorderStyle = fmBorderStyleSingle
With Imagel
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeZoom
.BorderStyle = fmBorderStyleNone End With
'ВеселыйКолобок
End Sub
Sub ВесельйКолобок()
Imagel.Picture = LoadPicture("Dot_a.bmp")
End Sub
'
Sub ПечальныйКолобок()
Image1.. Picture = LoadPicture ("Dotl_a.bmp"
) End Sub