Вопросы с перетаскиванием ToolBar'а

[Ruslan Demidow]

Есть форма и тулбар на ней.
Хочу сделать возможность перетаскивать тулбар (если свойство Align=vbAlignNone) куда захочет пользователь.
Для этого в модуле формы завёл переменную bToolBarMove as Boolean
И написал следующие процедуры обработки событий

Код: Выделить всё

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
    x As Long
    y As Long
End Type

Private bToolbarMove As Boolean

Option Explicit


Private Sub Toolbar1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Toolbar1.Align = vbAlignNone Then
        If Button = vbRightButton Then
            Dim mousePoint As POINTAPI
            GetCursorPos mousePoint
            Toolbar1.Top = (mousePoint.y * Screen.TwipsPerPixelY)
            Toolbar1.Left = (mousePoint.x * Screen.TwipsPerPixelX)
            bToolbarMove = True
        End If
    End If
End Sub

Private Sub Toolbar1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        If bToolbarMove = True Then
            Dim mousePoint As POINTAPI
            GetCursorPos mousePoint
            Toolbar1.Top = (mousePoint.y * Screen.TwipsPerPixelY)
            Toolbar1.Left = (mousePoint.x * Screen.TwipsPerPixelX)
        End If
    End If
End Sub

Private Sub Toolbar1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Toolbar1.Align = vbAlignNone Then
        If Button = vbRightButton Then
            bToolbarMove = False
        End If
    End If
End Sub

Но при нажатии правой кнопкой мыши и перетаскивании панели - она у меня съезжает вправо-вниз на растояние почти ширины тулбара. Хотя вроде бы в коде указал, что верхний левый угол панели должен быть под курсором.
Подскажите плиз - где моя ошибка.

[alibek]

Form.ScaleMode какой?

[Ruslan Demidow]

Form.ScaleMode какой?

Твипы.

[alibek]

Координаты курсора даются относительно экрана, а Toolbar позиционируется относительно координатной системы окна. Т.е. ты не учитываешь высоту границ окна, заголовка и строки меню.
Кроме того, когда ты смещаешь Toolbar (не двигая мышку), у тебя рекурсивно вызывается _MouseMove, это тоже способствует.
Я бы делал по другому. При MouseDown запоминаешь координаты X и Y в Private-переменные формы X0, Y0 и делаешь bToolbarMove = True. При MouseMove вычисляешь то расстояние, на которое была сдвинута мышка, устанавливаешь флаговую переменную fToolbarMoveBusy в True (чтобы избежать рекурсии) и сдвигаешь Toolbar куда надо. После чего обновляешь X0 и Y0 и сбрасываешь fToolbarMoveBosy. У меня такая схема работала.

[Ruslan Demidow]

alibek, спасибо.
Уточню.
Как перевести экранные координаты курсора в координаты формы?
Т.е. в MouseMove я проверяю fToolBarMoveBusy и если True то выход из процедуры, если нет - то двигаю панель, обновляю Х0 и Y0 и сбрасываю fToolBarMoveBusy?

[alibek]

Да.
Переводить координаты можно API ClientToScreen. Но в том варианте, который написал я, это не потребуется; там используются координаты X,Y, передаваемые при событии, а не GetCursorPos.

[Ruslan Demidow]

Да.
Переводить координаты можно API ClientToScreen. Но в том варианте, который написал я, это не потребуется; там используются координаты X,Y, передаваемые при событии, а не GetCursorPos.

Ясно. Спасибо.

[alibek]

Вот как я реализовывал таскание окна за самодельный заголовок:

Код: Выделить всё

Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
X0 = X: Y0 = Y
End Sub

Private Sub picTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim DX As Single, DY As Single
If Button <> 1 Then Exit Sub
DX = X0 - X: DY = Y0 - Y
X = Left - DX * Screen.TwipsPerPixelX
Y = Top - DY * Screen.TwipsPerPixelY
Move X, Y
End Sub

Private Sub picTitle_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
X0 = 0: Y0 = 0
End Sub


В этом примере X0, Y0 не сбрасываются на X,Y т.к. форма двигается вместе с мышкой. Тут я даже рекурсии не избегал.


А еще лучше, приложу файлы из того проекта.

Код: Выделить всё

'вызов
Sub ShowSticker(TimeStamp As String, From As String, Recipients As String, Message As String)
Dim F As Form, msg As String, I As Integer
msg = "От: '" & From & "'" & vbCrLf & "Кому: "
For I = LBound(Split(Recipients, ";")) To UBound(Split(Recipients, ";"))
  msg = msg & "'" & Trim$(Split(Recipients, ";")(I)) & "'; "
Next I
If Right$(msg, 2) = "; " Then msg = Left$(msg, Len(msg) - 2)
msg = msg & vbCrLf
msg = msg & Message
I = 0
For Each F In Forms
  If F.Name = "frmSticker" Then I = I + 1
Next F
Set F = New frmSticker
Load F
F.Left = Screen.Width - F.Width
F.Top = ((20 * I) Mod (Screen.Height / Screen.TwipsPerPixelY)) * Screen.TwipsPerPixelY
F.SetBackColor 2
F.Tag = TimeStamp
F.lbl.Caption = msg
F.Show
Set F = Nothing
End Sub


[Ruslan Demidow]

Спасибо. Я сделал - работает.

[tyomitch]

Ruslan, вот тебе метод alibek-а, применённый к твоему тулбару:

Код: Выделить всё

Private bToolbarMove As Boolean
Private dx As Single, dy As Single
Option Explicit


Private Sub Toolbar1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Toolbar1.Align = vbAlignNone Then
        If Button = vbRightButton Then
            dx = x: dy = y
            bToolbarMove = True
        End If
    End If
End Sub

Private Sub Toolbar1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        If bToolbarMove Then
            With Toolbar1
                .Move .Left + x - dx, .Top + y - dy: DoEvents
            End With
        End If
    End If
End Sub

Private Sub Toolbar1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Toolbar1.Align = vbAlignNone Then
        If Button = vbRightButton Then
            bToolbarMove = False
        End If
    End If
End Sub


[edit]вот, опять на меньше минуты не успел [/edit]

[Ruslan Demidow]

Ruslan, вот тебе метод alibek-а, применённый к твоему тулбару:

Код: Выделить всё

Private bToolbarMove As Boolean
====== Сгрызено моей собакой =======
    End If
End Sub


[edit]вот, опять на меньше минуты не успел [/edit]

Артём не расстраивайся, Я благодарен за помощь всем вам. По крайней мере я убедился, что свой кусок кода я написал правильно.

Код: Выделить всё

Private bToolbarMove As Boolean
Private bToolBarMoveBusy As Boolean
Private X0 As Integer, Y0 As Integer

Option Explicit

Private Sub Toolbar1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        If Button = vbRightButton Then
              gToolBarAlign = vbAlignNone
                With Toolbar1
                    .Align = gToolBarAlign
                    .Width = (.ButtonWidth * .Buttons.Count)
                    .Height = .ButtonHeight + 200
                    .BorderStyle = ccFixedSingle
                    .ZOrder 0
                End With
            X0 = Toolbar1.Left
            Y0 = Toolbar1.Top
            bToolbarMove = True
        End If
End Sub

Private Sub Toolbar1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bToolBarMoveBusy Then Exit Sub
    If Button = vbRightButton Then
        If bToolbarMove = True Then
            bToolBarMoveBusy = True
            Toolbar1.Left = X0 + X
            Toolbar1.Top = Y0 + Y
            X0 = Toolbar1.Left
            Y0 = Toolbar1.Top
            bToolBarMoveBusy = False
        End If
    End If
End Sub

Private Sub Toolbar1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
        If Button = vbRightButton Then
            bToolbarMove = False
            With Toolbar1
                If X0 < 100 Then
                    gToolBarAlign = vbAlignLeft
                ElseIf X0 > 100 And X0 > Me.Width - Toolbar1.Width Then
                    gToolBarAlign = vbAlignRight
                ElseIf Y0 < 100 Then
                    gToolBarAlign = vbAlignTop
                ElseIf Y0 > 100 And Y0 > sbrStatus.Top - Toolbar1.Height Then
                    gToolBarAlign = vbAlignBottom
                Else
                    gToolBarAlign = vbAlignNone
                    .Align = gToolBarAlign
                    .Width = (.ButtonWidth * .Buttons.Count)
                    .Height = .ButtonHeight + 200
                    .BorderStyle = ccFixedSingle
                    .ZOrder 0
                    Form_Resize
                    Exit Sub
                End If
                .Align = gToolBarAlign
                .BorderStyle = ccNone
            End With
            Form_Resize
        End If
End Sub


Может быть мой код покажется неуклюжим и не рациональным, но он позволяет прилеплять панель к любому краю формы. Нужно только подтащить панель поближе к краю и отпустить кнопку мыши. Если не прилеплять, то панель остаётся плавающей. Или же наоборот, панель инструментов можно "отодрать" от края формы и сделать плавающей.

Ещё раз Всем большое спасибо!