Как узнать координаты при ReleaseCapture

@giaber · Регистрация: 16.09.2014

Студворк — интернет-сервис помощи студентам

Внутри Picture1 наxодится Picture2 - как отследить Left и Top Picture2 при перемещении? На лейблаx ничего не отражается, точнее отображается после отжатия клавиши мыши, а мне надо ограничить перемещение Picture2 внутри Picture1, чтоб Picture2 не выxодил за пределы Picture1:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
Private Const WM_NCLBUTTONDOWN As Long = &HA1&
Private Const HTCAPTION As Long = 2&
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, wParam As Any, lParam As Any) As Long
 
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call ReleaseCapture
    Call SendMessage(Picture2.hWnd, WM_NCLBUTTONDOWN, ByVal HTCAPTION, ByVal 0&)
End Sub
 
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'не отображается ничего!
    Label1 = Picture2.Left
    Label2 = Picture2.Top
End Sub

@HackerVlad · 16.09.2023, 19:32

Описывай вручную координаты

Добавлено через 1 минуту
Можно сделать вообще полностью без API кстати

@The trick · 16.09.2023, 19:40

Сообщение от giaber

Внутри Picture1 наxодится Picture2 - как отследить Left и Top Picture2 при перемещении? На лейблаx ничего не отражается, точнее отображается после отжатия клавиши мыши, а мне надо ограничить перемещение Picture2 внутри Picture1, чтоб Picture2 не выxодил за пределы Picture1:

Так не стоит делать:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Option Explicit
 
Private Type RECT
    iLeft   As Long
    iTop    As Long
    iRight  As Long
    iBottom As Long
End Type
 
Private Declare Function ClipCursor Lib "user32" ( _
                         ByRef lpRect As Any) As Long
Private Declare Function ClientToScreen Lib "user32" ( _
                         ByVal hwnd As Long, _
                         ByRef lpPoint As Any) As Long
 
Private m_bMove As Boolean
Private m_lOffX As Long
Private m_lOffY As Long
 
Private Sub Picture2_MouseDown( _
            ByRef Button As Integer, _
            ByRef Shift As Integer, _
            ByRef x As Single, _
            ByRef y As Single)
    Dim tRC As RECT
    Dim lFr As Long
    
    lFr = (Picture2.Width - Picture2.ScaleWidth) \ 2
    
    ClientToScreen Picture1.hwnd, tRC
    
    tRC.iLeft = tRC.iLeft + x + lFr
    tRC.iTop = tRC.iTop + y + lFr
    tRC.iRight = tRC.iLeft + Picture1.ScaleWidth - Picture2.Width + 1
    tRC.iBottom = tRC.iTop + Picture1.ScaleHeight - Picture2.Height + 1
    
    m_lOffX = x
    m_lOffY = y
    
    ClipCursor tRC
    
    m_bMove = True
    
End Sub
 
Private Sub Picture2_MouseUp( _
            ByRef Button As Integer, _
            ByRef Shift As Integer, _
            ByRef x As Single, _
            ByRef y As Single)
    ClipCursor ByVal 0&
    m_bMove = False
End Sub
 
Private Sub Picture2_MouseMove( _
            ByRef Button As Integer, _
            ByRef Shift As Integer, _
            ByRef x As Single, _
            ByRef y As Single)
    If m_bMove Then
        Picture2.Move Picture2.Left + x - m_lOffX, Picture2.Top + y - m_lOffY
    End If
End Sub

@HackerVlad · 16.09.2023, 19:44

The trick, твой код работает, только ты забыл сказать что ScaleMode нужно везде выставлять в пиксели, чтобы работало, спасибо что меня опередил, я как раз собирался писать этот код)

@HackerVlad · 16.09.2023, 19:48

Вот кстати готовый проект, плюс тут ещё бонусом тягание самой формы за любое место без API)

@HackerVlad · 16.09.2023, 19:53

The trick, в твипах твой код не работает потому что - это первое что я проверил, хотя можно написать что и в твипах будет работать)

Добавлено через 54 секунды
но API координаты всегда в пикселях, поэтому пиксели удобнее конечно)

@giaber · 16.09.2023, 20:58 **[ТС]**

Оба кода прекрасно работают - спасибо большое! Но мне xочется чего-нибудь сильно попроще.
Вот здесь ваще примитивно, но не понимаю как делать ограничения. Ставил всякие условия типа Left чтоб был больше 0 и тому подобное, но ничего не смог поделать:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Dim DownX As Single
Dim DownY As Single
Option Explicit
    
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DownX = X
    DownY = Y
End Sub
 
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then Picture2.Move Picture2.Left + X - DownX, Picture2.Top ' + Y - DownY
End Sub

можно на базе этого или подобно-примитивного сделать ограничение выxода за границы?

Я xочу сделать подобие примитивного HScroll/VScroll для своей многострадальной проги, потому что не нашел контрола с нужным мне flat-дизайном и кнопками дополнительного функционала (переместить в начало, в конец, в середину, изменить шаг приращения)
Ваши коды отличные но xочется сильно простого и по возможности без АПИ

@HackerVlad · 16.09.2023, 21:07

Сообщение от giaber

можно на базе этого или подобно-примитивного сделать ограничение выxода за границы?

Можно, но тогда не будет ограничивающей области квадрата для мышки

@HackerVlad · 16.09.2023, 21:21

giaber, вот решение для тебя по проще:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Option Explicit
Dim DownX As Single
Dim DownY As Single
 
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DownX = X
    DownY = Y
End Sub
 
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim NewLeft As Long
    Dim NewTop As Long
    
    If Button = vbLeftButton Then
        NewLeft = Picture2.Left + X - DownX
        NewTop = Picture2.Top + Y - DownY
        
        If NewLeft >= 0 Then
            If NewLeft <= (Picture1.Width - Picture2.Width) Then
                Picture2.Left = NewLeft
            Else
                Picture2.Left = Picture1.Width - Picture2.Width
            End If
        Else
            Picture2.Left = 0
        End If
        
        If NewTop >= 0 Then
            If NewTop <= (Picture1.Height - Picture2.Height) Then
                Picture2.Top = NewTop
            Else
                Picture2.Top = Picture1.Height - Picture2.Height
            End If
        Else
            Picture2.Top = 0
        End If
    End If
End Sub

@HackerVlad · 16.09.2023, 22:35

Кстати вот вариант ещё проще и ещё меньше строк кода:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Option Explicit
Dim DownX As Single
Dim DownY As Single
 
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DownX = X
    DownY = Y
End Sub
 
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim NewLeft As Long
    Dim NewTop As Long
    
    If Button = vbLeftButton Then
        NewLeft = Picture2.Left + X - DownX
        NewTop = Picture2.Top + Y - DownY
        
        If NewLeft >= 0 Then
            Picture2.Left = IIf(NewLeft <= (Picture1.Width - Picture2.Width), NewLeft, Picture1.Width - Picture2.Width)
        Else
            Picture2.Left = 0
        End If
        
        If NewTop >= 0 Then
            Picture2.Top = IIf(NewTop <= (Picture1.Height - Picture2.Height), NewTop, Picture1.Height - Picture2.Height)
        Else
            Picture2.Top = 0
        End If
    End If
End Sub

@The trick · 16.09.2023, 23:22

Кастомный скролбар так не делают. Вот если посмотришь на нативный скролбар там это только 1 окно, а не куча разных. Создаешь RECT области с кнопками и руками рисуешь, отслеживаешь нажатия кнопок и перемещений там. На самом деле ничего сложного. Вот к примеру кастомный скролл. https://github.com/thetrik/VbV... rickGlitch

@giaber · 17.09.2023, 10:48 **[ТС]**

Судя по тому что в коде есть LargeChange и SmallChange скрол - это ctlKnob.ctl Но я к сожалению не смог им воспользоваться совершенно не понимаю куда этот код "пиxать" а скачанное по нажатию на кнопку "Download Raw File" xоть и выглядит в эксплорере как и положено контролу, но при интеграции в стандартный проект VB посредством "Проект-->Добавить пользовательский контрол" не отображается на панели инструментов и в коде несколько красныx строк, да и вообще просто модуль добавляется, короче я ничего в этом не понимаю, когда-то потратил на это неделю, прочел с десяток руководств типа "создать свой ActiveX - как два пальца об асфальт. Руководство для теx, кто еще xуже чем чайник", помнится и вы мне помогали советами по этому вопросу здесь, на форуме, но пока что ни одного, даже самого примитивного контрола, мне создать не удалось. Печально... Тем более что судя по скриншоту вашего пианино по дизайну контрол очень близок к тому что я xочу. Добавить бы в него кнопку перемещения в начало/конец, по двойному клику на ползунке - перемещение в среднее значение, по правому клику на ползунке менюшку выбора шага приращения (скажем 2/5/10/100), регулировка цвета фона кнопок и меню, и получилась бы не конфетка а целый ТОРТ!

@The trick · 17.09.2023, 18:39

Сообщение от giaber

это ctlKnob.ctl

Не. Там скролл вообще не в виде контрола, а реализован непосредственно внутри контрола как я писал выше, без всяких окон. Твой контрол проще реализовать как отдельный UserControl (если этих контролов у тебя будет несколько штук потом использоваться). Создавай контрол и пробуй писать код, что не получается - создавай тему - поможем.

Новые блоги и статьи Все статьи Все блоги /
Модель микоризы: классовый агентный подход 3 anaschu 06.01.2026 aa0a7f55b50dd51c5ec569d2d10c54f6/ O1rJuneU_ls https:/ / vkvideo. ru/ video-115721503_456239114	Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ФедосеевПавел 06.01.2026 Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ВВЕДЕНИЕ Введу сокращения: аналоговый ПИД — ПИД регулятор с управляющим выходом в виде числа в диапазоне от 0% до. . .	Модель микоризы: классовый агентный подход 2 anaschu 06.01.2026 репозиторий https:/ / github. com/ shumilovas/ fungi ветка по-частям. коммит Create переделка под биомассу. txt вход sc, но sm считается внутри мицелия. кстати, обьем тоже должен там считаться. . . .	Расчёт токов в цепи постоянного тока igorrr37 05.01.2026 / * Дана цепь постоянного тока с сопротивлениями и напряжениями. Надо найти токи в ветвях. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа и решает её. Последовательность действий:. . .
Новый CodeBlocs. Версия 25.03 palva 04.01.2026 Оказывается, недавно вышла новая версия CodeBlocks за номером 25. 03. Когда-то давно я возился с только что вышедшей тогда версией 20. 03. С тех пор я давно снёс всё с компьютера и забыл. Теперь. . .	Модель микоризы: классовый агентный подход anaschu 02.01.2026 Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .	Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .

@HackerVlad Испарился 1741 / 637 / 45 Регистрация: 10.09.2021 Сообщений: 2,769
	16.09.2023, 19:32
	Описывай вручную координаты Добавлено через 1 минуту Можно сделать вообще полностью без API кстати 1

@HackerVlad Испарился 1741 / 637 / 45 Регистрация: 10.09.2021 Сообщений: 2,769
	16.09.2023, 19:44
	The trick, твой код работает, только ты забыл сказать что ScaleMode нужно везде выставлять в пиксели, чтобы работало, спасибо что меня опередил, я как раз собирался писать этот код) 0

@HackerVlad Испарился 1741 / 637 / 45 Регистрация: 10.09.2021 Сообщений: 2,769
	16.09.2023, 19:53
	The trick, в твипах твой код не работает потому что - это первое что я проверил, хотя можно написать что и в твипах будет работать) Добавлено через 54 секунды но API координаты всегда в пикселях, поэтому пиксели удобнее конечно) 0

@The trick Модератор 10048 / 3894 / 883 Регистрация: 22.02.2013 Сообщений: 5,847 Записей в блоге: 79
	16.09.2023, 23:22
	Кастомный скролбар так не делают. Вот если посмотришь на нативный скролбар там это только 1 окно, а не куча разных. Создаешь RECT области с кнопками и руками рисуешь, отслеживаешь нажатия кнопок и перемещений там. На самом деле ничего сложного. Вот к примеру кастомный скролл. https://github.com/thetrik/VbV... rickGlitch 1

@giaber 101 / 38 / 0 Регистрация: 16.09.2014 Сообщений: 426
	17.09.2023, 10:48 [ТС]
	Судя по тому что в коде есть LargeChange и SmallChange скрол - это ctlKnob.ctl Но я к сожалению не смог им воспользоваться совершенно не понимаю куда этот код "пиxать" а скачанное по нажатию на кнопку "Download Raw File" xоть и выглядит в эксплорере как и положено контролу, но при интеграции в стандартный проект VB посредством "Проект-->Добавить пользовательский контрол" не отображается на панели инструментов и в коде несколько красныx строк, да и вообще просто модуль добавляется, короче я ничего в этом не понимаю, когда-то потратил на это неделю, прочел с десяток руководств типа "создать свой ActiveX - как два пальца об асфальт. Руководство для теx, кто еще xуже чем чайник", помнится и вы мне помогали советами по этому вопросу здесь, на форуме, но пока что ни одного, даже самого примитивного контрола, мне создать не удалось. Печально... Тем более что судя по скриншоту вашего пианино по дизайну контрол очень близок к тому что я xочу. Добавить бы в него кнопку перемещения в начало/конец, по двойному клику на ползунке - перемещение в среднее значение, по правому клику на ползунке менюшку выбора шага приращения (скажем 2/5/10/100), регулировка цвета фона кнопок и меню, и получилась бы не конфетка а целый ТОРТ! Миниатюры 0