На этом шаге мы рассмотрим реализацию механизма drag-and-drop.

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

Рис.1. Диалоговое окно Новые похождения Колобка

Если расположить указатель мыши на Колобке и нажать правую кнопку мыши, то веселый Колобок становится печальным . Если далее перемещать указатель мыши при нажатой правой кнопке по поверхности диалогового окна, то колобок будет передвигаться вслед за указателем мыши. Настроение колобка запрограммировано в процедурах ВеселыйКолобок и ПечальныйКолобок. Изменение настроения колобка прк нажатии и отпускании правой клавиши мыши запрограммировано в процедурах Image1_MouseDown и Image1_MouseUp, а перемещение - в Image1_MouseMove.
Если расположить указатель мыши на надписи Колобок и переместить указатель мыши при нажатой правой кнопке в область второй надписи, обведенной рамкой, а там уже отпустить правую клавишу мыши, то во вторую надпись будет скопирован текст Колобок. Процедура Label1_MouseMove копирует заголовок первой надписи в объект DataObject, играющий роль буфера обмена, процедура Label2_BeforeDragOver контролирует операции drag-and-drop во время перемещения указателя мыши, a Label2_BefbreDropOrPaste в момент отпускания правой кнопки мыши.

Приведем полный текст приложения.

' Определение переменной уровня модуля
Dim КолобокDataObject As DataObject
Private Sub Image1_MouseDown(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Button = 2 Then
    ПечальныйКолобок
  End If
End Sub
Private Sub Image1_MouseUp(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Button = 2 Then
    ВеселыйКолобок
  End If
End Sub
Private Sub Image1_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Button = 2 Then
    If X ^ 2 + Y ^ 2 = 0 Then
      A = 0
      В = 0
    Else
      A = X / Sqr(X ^ 2 + Y ^ 2)
      В = Y / Sqr(X ^ 2 + Y ^ 2)
    End If
    With Image1
      .Top = Image1.Top + В
      .Left = Image1.Left + A
    End With
  End If
End Sub
Private Sub Label1_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Button = 2 Then
    Set КолобокDataObject = New DataObject
    Dim ТипПеремещения As Integer
    КолобокDataObject.SetText Label1.Caption
    ТипПеремещения = Колобок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.ReturnEffect, 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.ReturnEffect, _
   ByVal Shift As Integer)
  Cancel = True
  Effect = fmDropEffectCopy
  Label2.Caption = КолобокDataObject.GetText
End Sub
Private Sub UserForm_Initialize()
  Label1.BorderStyle = fmBorderStyleSingle
  Label2.BorderStyle = fmBorderStyleSingle
  With Image1
    .PictureAlignment = fmPictureAlignmentTopLeft
    .PictureSizeMode = fmPictureSizeModeZoom
    .BorderStyle = fmBorderStyleNone
  End With
  ВеселыйКолобок
End Sub
Sub ВеселыйКолобок()
  Image1.Picture = LoadPicture("Dot_a.bmp")
End Sub
Sub ПечальныйКолобок()
  Image1.Picture = LoadPicture("Dot1_a.bmp")
End Sub

Текст этого примера вместе с рисунками можно взять здесь.

На следующем шаге мы продолжим разработку приложений.

Предыдущий шаг Содержание Следующий шаг