Таскание формы по экрану

[GluKoBuG]

У меня вопрос.
У формы свойство BorderStyle стоит в None.
Имеется надпись Label, которая должна исполнять роль панели для таскания окна по экрану.
Ничего подробного ни в поиске, ни в ApiViewer'e не нашёл.

[RayShade]

Никак не пойму. Отчего, у меня дергается левый глаз, а?

[BV]

Рэй, приляг, поспи. Говорят, помогает

По теме: поиск по WM_NCLBUTTONDOWN

[Dangerous]

Я конечно незнаю есть или нет такие темы уже на форуме, но рекомендую перед созданием темы воспользоваться поиском по форуму(правила читать надо!!!).
Ну ладно вот код:

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

' Объявляем пару функций API и пару констант(Это должно быть в модуле)
Public Declare Function SendMessage Lib "user32"  Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long,  ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub ReleaseCapture Lib "user32" ()
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2

' а это уже процедура перемещения указателя над элементом Text1(т.е. это уже код формы)

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long
    If Button = 1 Then
        Call ReleaseCapture
        lngReturnValue = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub


И усё!

[ALX_2002]

Никак не пойму. Отчего, у меня дергается левый глаз, а?

2 RayShade:

Ничего подробного ни в поиске, ни в ApiViewer'e не нашёл.

А меня улыбнуло и вообще на ржач пробивает.
Себя вспоминаю

[GluKoBuG]

Откудаж я знал, что надо искать какой-то "WM_NCLBUTTONDOWN", а не "тащим форму по экрану без тормозов"

[Конь]

"тащим форму по экрану без тормозов"

Ржунимагу!

[IIIypuk]

Люди, будьте проще . В данном случае можно так:

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

Option Explicit
Dim Mouse_Lock As Boolean
Dim cx As Integer, cy As Integer

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
   If Button = vbLeftButton Then
      Mouse_Lock = True ' Если нажата кнопка мыши, то начинаем двигать
      cx = X ' Записываем, где курсор относительно формы
      cy = Y
   End If
   
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
   If Mouse_Lock Then ' Если мышь опущена на форму, то двигаем форму
      DoEvents
      Me.Top = Me.Top + Y - cy
      Me.Left = Me.Left + X - cx
   End If
   
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

   Mouse_Lock = False ' Соответственно, если мышь отпустить, то форма освобождается
   
End Sub

Это, чтоб таскать за форму. Для лейбла сам исправь

[Lumen]

Кстати интересный вариант для любителей чистого VB.

[Конь]

Lumen
Особенно для тех, кто не любит API:)

[Lumen]

Конь
И не только для них. Вообще для тех, кому нравится решать задачи, используя внутренние возможности языка.

И чем им только API не угодил???

[Конь]

Ты прав.

И правда, чем?!

[Конь]

Воть. Для смеха.

[vvs_adm]

Люди, будьте проще

Это называется проще? Мало того, что с твоим кодом форма дергается, как припадошная, так еще и при даблклике событие MouseDown "проглатывается", т.е. если по твоей форме кликнуть быстро два раза и после второго клика мышку не отпускать, то никуда она не поедет. Хотя конечно это несмертельно...

[Lumen]

Неплохо. Правда боянисто, но прикольно.

[Конь]

Lumen
Ты про что?

[Lumen]

Конь
Про твою прогу "для смеха". Сам такие писал, когда учился программировать, но всё равно прикольно.

[Конь]

Lumen
Оригинальностью особой не отличаюсь:)

Просто показал, как этот код работает:)

Но спасибо;)

[IIIypuk]

Насчет дергается - это потомуу, что у тебя первый пень, наверное.
Насчет даблклика - просто нужно доработать.

И еще:

...Это называется проще? Мало того, чт.....

это именно самый простой, на мой взгляд пример (хоть и работает чуть коряво). Никаких API и т.п. Попробуй придумай проще

[Конь]

Ничего не дергается! Все ОК!

ЗЫ если мой пример дергается, то это лишь потому, что я был вынужден изменять положение в любую сторону на 20, а то бы двигалось слишком медленно.

[vvs_adm]

IIIypuk Дергается не при перетаскивании, а после остановки мыши форма еще летает туда сюда, как буд-то у нее масса есть и она на пружинке

[Хакер]

IIIypuk, ентот самый код хоть и правилен и любим мной, но в твоём варианте он ужасен.

Я опять, с грустью, где-то там, в сердце, наблюдаю MouseMove-ное перетаксивание без всякого предусмотрения рекурсивного вызова события. И это уже который раз (помните за что мне дали звание?)

Наверное придётся мне статью что-ли написать про это дело

[IIIypuk]

Хорошо, тогда если чуть чуть изменить, то уже не дергается:

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

Option Explicit
Dim Mouse_Lock As Boolean
Dim cx As Integer, cy As Integer

Dim temp As Boolean

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
   If Button = vbLeftButton Then
      Mouse_Lock = True ' Если нажата кнопка мыши, то начинаем двигать
      cx = X ' Записываем, где курсор относительно формы
      cy = Y
   End If
   
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
   If temp Then Exit Sub
   temp = True
   If Mouse_Lock Then ' Если мышь опущена на форму, то двигаем форму
      DoEvents
      Me.Top = Me.Top + Y - cy
      Me.Left = Me.Left + X - cx
   End If
   temp = False

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

   Mouse_Lock = False ' Соответственно, если мышь отпустить, то форма освобождается
   
End Sub

[Хакер]

temp должна быть static
MouseLock.... ? А не одно и тоже ли это что и Button <> 0

[Naked]

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

Option Explicit
Dim cx As Single, cy As Single

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 1 Then
      cx = X
      cy = Y
   End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
      Top = Top + Y - cy
      Left = Left + X - cx
   End If
End Sub


без лишних строк типа If temp Then Exit Sub temp = True doevents
при даблклике не проглатывается и не дергается

[Хакер]

Я опять, с грустью, где-то там, в сердце, наблюдаю MouseMove-ное перетаскивание безо всякого предусмотрения рекурсивного вызова события. И это уже который раз (помните за что мне дали звание?)

Naked - ещё один умник...

[XPAHuTEJIb]

Naked
В общем самый правильный код.
Но, по крайней мере в ХРшке, таскается не форма а силуэт формы.
Да, и стоит событие применять не к форме а к лэйблу.

[Oxygen]

2 XPAHuTEJIb Теме месяц... Вернее, месяц в нее никто не писал... Это не наводит на мысли соответствующие? И притом, это не первый случай подымания тобой старых тем. Может не стоит заниматься некрофилией, притом неоправданной?

[Twister]

Наводит на мысли о том, что XPAHuTEJIb просто набивает количество постов. Интересно, а его не посещала мысль о том, что некрофилия на форуме не безнаказана?

[XPAHuTEJIb]

2Twister:
меня твой пост наводит на теже мысли...или ты боишься, что я обгоню тебя по количеству постов?

2Oxygen:
Новое-хорошо забытое старое...возможно этот пост и не оправдан - удалите его
А насчёт остальных - я не согласен.