Самоучитель VBA
       

Перемещение элемента управления при помощи операции drag-and-drop


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

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

  • Если расположить указатель мыши на Колобке и нажать правую кнопку становится печальным Если далее перемещать указатель мыши при нажатой правой кнопке по поверхности диалогового окна, то колобок будет передвигаться вслед за указателем мыши. Настроение колобка запрограммировано в процедурах веселыйКолобок и печальныйколобок. Изменение настроения колобка при нажатии и отпускании правой клавиши мыши запрограммировано в процедурах Image1_MouseDown и Image1_MouseUp, а перемещение — в Imagel_MouseMove.

  • Если расположить указатель мыши на надписи колобок и переместить указатель мыши при нажатой правой кнопке в область второй надписи, обведенной рамкой, а там уже отпустить правую клавишу мыши, то во вторую надпись будет скопирован текст колобок. Процедура Labeli_MouseMove копирует заголовок первой надписи в объект Dataobject, играющий роль буфера обмена, процедура Label2_BeforeDragOver контролирует операции drag-and-drop во время перемещения указателя мыши, a Label2_BeforeDropOrPaste в момент отпускания правой кнопки мыши.

    '

    ' Определение переменной уровня модуля

    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




    Содержание раздела