Форум программистов, компьютерный форум, киберфорум
Visual Basic
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск  
 
 
Рейтинг 4.88/17: Рейтинг темы: голосов - 17, средняя оценка - 4.88
 Аватар для radlif
44 / 44 / 3
Регистрация: 18.12.2011
Сообщений: 577

Форма и внутрение объекты?

19.09.2013, 14:58. Показов 3732. Ответов 47
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Разрабатываю код который уводит форму за верхний край монитора оставляя несколько пикселей
чтоб при наведении мышки показать форму.
И столкнулся с таким глюком когда форма где то до середины уходит вверх за рамку экрана объекты внутри замедляют
перемещение, в итоге низ формы начинает наезжать на объекты (кнопки картинки и тд).
С чем это связано и как с этим бороться?
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
19.09.2013, 14:58
Ответы с готовыми решениями:

Форма и объекты
Объясните пожалуйста, как сделать так, чтобы при увеличении/уменьшению размера формы, объекты которые на ней установлены, различные...

Найти внутрение углы треугольника,заданного координатами своих вершин на площаде.
Найти внутрение углы треугольника,заданного координатами своих вершин на площаде. Заранее спасибо!!!!

Как сделать, чтобы при открытии форма растягивалась во весь экран и расположенные на ней объекты были всегда в зоне видимости?
Такое вообще возможно?

47
 Аватар для morgann55
1365 / 207 / 37
Регистрация: 09.02.2012
Сообщений: 745
21.09.2013, 09:37
Студворк — интернет-сервис помощи студентам
Нет, экран так и остался в огромных цифирях
Вот пришёл Василий ))) Сейчас всё разъяснит Очень надеюсь!!!
0
Модератор
10068 / 3913 / 886
Регистрация: 22.02.2013
Сообщений: 5,863
Записей в блоге: 79
21.09.2013, 09:37
Цитата Сообщение от radlif Посмотреть сообщение
Вот только не понятно как узнать качество изображения рабочего стола в пикселях на дюйм....
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
 
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
 
Private Const LOGPIXELSX = 88        '  Logical pixels/inch in X
 
 
Private Sub Form_Load()
    Dim W As Long, DC As Long
    
    DC = GetDC(0)
    W = GetDeviceCaps(DC, LOGPIXELSX)
    ReleaseDC 0, DC
End Sub
1
 Аватар для radlif
44 / 44 / 3
Регистрация: 18.12.2011
Сообщений: 577
21.09.2013, 09:37  [ТС]
Без проблем видать некак

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
 
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim ReturnValue As Long
    If Button = 1 Then
        Call ReleaseCapture
        ReturnValue = SendMessage(Form.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Debug.Print "ok"
    
End Sub
Проблема в том что Event MouseUp срабатывает только после 2 клика как я понимаю из за
кода что в MouseDown, а вот как обойти эту проблему без понятия но надо)
0
 Аватар для morgann55
1365 / 207 / 37
Регистрация: 09.02.2012
Сообщений: 745
21.09.2013, 09:41
radlif, а ты привяжись к ReturnValue
Visual Basic
1
If ReturnValue = 0 Then '.......
1
Модератор
10068 / 3913 / 886
Регистрация: 22.02.2013
Сообщений: 5,863
Записей в блоге: 79
21.09.2013, 09:45
Цитата Сообщение от radlif Посмотреть сообщение
как обойти эту проблему без понятия но надо
Откажись от ReleaseCapture.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim Dx As Long, Dy As Long, Flag As Boolean
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dx = X: Dy = Y
    Flag = True
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Flag Then Me.Move Me.Left + X - Dx, Me.Top + Y - Dy
End Sub
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Flag = False
    Debug.Print "ok"
    
End Sub
0
 Аватар для radlif
44 / 44 / 3
Регистрация: 18.12.2011
Сообщений: 577
21.09.2013, 09:50  [ТС]
The trick, Выше попроще
Это надо для того чтоб когда перетаскивал форму действия таймера не обрабатывались.
А то как только мышка с формой оказывается за пределами бывшей позиции вижу 2 формы,
1 под мышкой 2 уезжает за край)
0
 Аватар для morgann55
1365 / 207 / 37
Регистрация: 09.02.2012
Сообщений: 745
21.09.2013, 13:08
Ну вроде разобрался как работать от края при любом разрешении, и заодно убрал "дребезг" при опускании курсора вниз ПанелиЗадач:
Кликните здесь для просмотра всего текста
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
64
65
66
67
68
69
70
71
72
73
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, GO As Rect) As Long 'читает размер и позицию окна
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long ' перетаскивание элементов (пара)
Private Declare Function ReleaseCapture Lib "user32" () As Long '....
Const WM_NCLBUTTONDOWN = &HA1: Const HTCAPTION = 2: Const HP = 500 ' высота панели задач в твипах
Dim BarX&, BarY&
Dim K As POINTAPI, GO As Rect, Sdvig%, HagG%, HagV%, VhodG&, VihodG&, VhodV&, VihodV&, Vdvig%, SW&, SH&, FW&, FH&
 
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 27 Then End 'выход через Esc
End Sub
 
Private Sub Form_Load()
SW = Screen.Width: SH = Screen.Height - HP: 'загоняем в переменные КраяЭкрана
FW = Me.Width - 75: FH = Me.Height - 75: 'и габариты Формы (отнимая чтоб высовывалась)
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer1.Enabled = False: BarY = Y: BarX = X
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button Then
Me.Top = Me.Top + Y - BarY: Me.Left = Me.Left + X - BarX: DoEvents: Label2 = Me.Top + FH + 75: DoEvents
Call ReleaseCapture:
Sdvig = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
 
If Sdvig = 0 Then 'раздача данных и включение таймера (когда явно закончено таскание)
HagG = 0: HagV = 0 ' сначала ОБА нулим (отсекая предыдущие установки)
If Me.Left < 10 Then HagG = -100: VhodG = -FW: VihodG = 0: Vdvig = Vdvig + 1: 'вдвигаем и выдвигаем через разность габаритов Экрана и Формы
If Me.Left > SW - FW Then HagG = 100: VhodG = SW: VihodG = SW - FW: Vdvig = Vdvig + 1:
If Me.Top < 10 Then HagV = -100: VhodV = -FH: VihodV = -50: Vdvig = Vdvig + 1:
If Me.Top > SH - FH Then HagV = 100: VhodV = SH - 70: VihodV = SH - FH - 50: Vdvig = Vdvig + 1:
Timer1.Enabled = IIf(Vdvig > 0, True, False)
End If
End If
End Sub
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer1.Enabled = True: 'страховка...
End Sub
 
Private Sub Timer1_Timer()
GetCursorPos K: If K.Y > (Screen.Height - HP - 5) / Screen.TwipsPerPixelY Then K.Y = (Screen.Height - HP - 5) / Screen.TwipsPerPixelY 'страховка от "дребезга" при опускании курсора под ПанельЗадач
GetWindowRect Form1.hwnd, GO
 
If Vdvig > 0 Then 'сначала полный Вдвиг окна при поднесении к краю
If Abs(Form1.Left - VhodG) > 100 Then Form1.Move Form1.Left + HagG
If Abs(Form1.Top - VhodV) > 100 Then Form1.Top = Form1.Top + HagV
If Abs(Form1.Left - VhodG) < 100 Then Vdvig = Vdvig - 1:
If Abs(Form1.Top - VhodV) < 100 Then Vdvig = Vdvig - 1:
Exit Sub
End If ' дальше движения по наведению курсора
 
If K.X <= GO.Right And K.X >= GO.Left And K.Y <= GO.Bottom And K.Y >= GO.Top Then
   If Abs(Form1.Left - VihodG) > 100 Then Form1.Move Form1.Left - HagG
   If Abs(Form1.Top - VihodV) > 100 Then Form1.Top = Form1.Top - HagV:
End If
If K.X >= GO.Right Or K.X <= GO.Left Or K.Y >= GO.Bottom Or K.Y <= GO.Top Then
   If Abs(Form1.Left - VhodG) > 100 Then Form1.Move Form1.Left + HagG
   If Abs(Form1.Top - VhodV) > 100 Then Form1.Top = Form1.Top + HagV:
End If
End Sub

(проверил и на на другом компе...)
0
 Аватар для radlif
44 / 44 / 3
Регистрация: 18.12.2011
Сообщений: 577
21.09.2013, 13:45  [ТС]
У вас тож нечё так вариант
Окончательно сформированный класс который просто присоединяем к проекту
Описание внутри класса.
Lipyhka.rar
3
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
21.09.2013, 13:45

Одним div выровнить внутрение div
У меня проблема, у меня div за место таблицы на сайте сайт работает отлично. Тока вот сайт с левой стороны и всё, как его сделать по...

Добавление записи в Listview(1 форма) через Диалоговое окно(3 форма) другой формы (2 форма)
Всем доброго дня и с наступающими праздниками! Знаю, тема 7 частых вопросов по WinForms уже не раз обсуждалась, и была прочитана, но или...

Как уничтожать динамические объекты и вообще объекты, если это необходимо сделать в их процедурах?
Создать отдельную процедуру CloseObject(Object: TObject) и вызывать ее в конце процедуры или так тоже нельзя? А то бесят эти access...

Встроенные объекты Java Script. Объекты Array, Date
Создать массив, содержащий названия элементов, находящихся в системном блоке компьютера. Добавить к нему массив, содержащий названия ...

Форма 1 вызывает форму 2, форма 2 закрывается, форма 1 продолжает работать дальше
Вынес предстартовые действия формы1 в форму2 (там у меня проверка существования файлов, их закачка если нету и проверка обновления), но как...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
48
Ответ Создать тему
Новые блоги и статьи
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ"
Adler 06.10.2026
Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .
ИИ не может найти нужный язык в списке
Supersumestria 05.10.2026
Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .
Новая последняя моя музыка в SUNO
zorxor 05.10.2026
Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .
Программный домашний кинотеатр
russiannick 27.09.2026
Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого
zorxor 21.09.2026
Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .
Мобильное приложение ColorStep
pavlinmavlin 17.09.2026
Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .
Запрет дублирования строк в табличной части
Maks 13.09.2026
Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр.
Jin X 06.09.2026
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru