Как узнать координаты при 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 (если этих контролов у тебя будет несколько штук потом использоваться). Создавай контрол и пробуй писать код, что не получается - создавай тему - поможем.

Новые блоги и статьи Все статьи Все блоги /
Отчёт о спецтехнике находящейся в ремонте Maks 20.04.2026 Отчёт из решения ниже размещен в конфигурации КА2. Задача: отобразить спецтехнику, которая на данный момент находится в ремонте. Есть нетиповой документ "Заявка на ремонт спецтехники" который. . .	Памятка для бота и "визитка" для читателей "Semantic Universe Layer (Слой семантической вселенной)" Hrethgir 19.04.2026 Сгенерировано для краткого описания по случаю сборки и компиляции скелета серверного приложения. И пусть после этого скажут, что статьи сгенерированные AI - туфта и не интересно. И это не реклама -. . .	Запрет удаления строк ТЧ документа при определенном условии Maks 19.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "Аккумуляторы", разработанного в конфигурации КА2. У данного документа есть ТЧ, в которой в зависимости от прав доступа. . .	Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .
Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .

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

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

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

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

@giaber 101 / 38 / 0 Регистрация: 16.09.2014 Сообщений: 429
	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