| Вопрос: Окончание события Form_Resize | Добавлено: 03.04.07 12:06 |
Автор вопроса:  Боцман | Web-сайт: Rus-Skipper.narod.ru | ICQ: 295725312 |
|
При растягивании \ сжимании формы (Form_Resize) в конце мы отпускаем левую кнопку мыши. Как вот отловить это событие, например MsgBox "Конец изменения размеров"
Ведь при нажатии на <-> стрелочки события Form_MouseDown не происходит. Искал в WS нечего не нашел. Заранее благодарен, за конструктивные ответы. |
| Ответы | Всего ответов: 16 |
|
Номер ответа: 1 Автор ответа:  »VladikComper« ICQ: 419668582 Вопросов: 23 Ответов: 147 |
Web-сайт: Профиль | | #1 | Добавлено: 03.04.07 12:45 |
|
Конечно, мне не нужно ловить это событие, но другого выхода, кроме как сделать свои границы формы я не вижу...
Я вот тоже в данный момент пишу программу (не буду скрывать, что она - Softrate Notepad 5.0), в ней сделать свои границы у формы вынудил сделать особый интерфейс. Так вот: в роли границ формы может выступать линия (Line), но у меня рисунок (только Image, только Image!!!). Если Image, то Streetch = True (чтобы растягивалось) и рисунок. А при Form_Resize: Image1.Height = Form.Height. А теперь... API!!! Public Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Public Const HWND_TOPMOST = -1 Public Const HWND_NOTOPMOST = -2 Public Const SWP_NOMOVE = &H2 Public Const SWP_NOSIZE = &H1 Public Const SWP_NOACTIVATE = &H10 Public Const SWP_SHOWWINDOW = &H40 Public Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE Public Type PointAPI X As Long Y As Long End Type И процедурка... Public Sub ResizeForm(TheForm As Form, OldCursorPos As PointAPI, NewCursorPos As PointAPI, ResizeMode As Integer)
On Error Resume Next Dim DifferenceX Dim DifferenceY DifferenceX = (NewCursorPos.X - OldCursorPos.X) * Screen.TwipsPerPixelX DifferenceY = (NewCursorPos.Y - OldCursorPos.Y) * Screen.TwipsPerPixelY ' ResizeMode: 0 - Левая граница ' 1 - Правая граница ' 2 - Верхняя граница ' 3 - Нижняя граница ' 4 - Нижний правый угол ' 5 - Нижний левый угол ' 6 - Верхний правый угол ' 7 - Верхний левый угол Select Case ResizeMode Case 0 TheForm.Move TheForm.Left + DifferenceX, TheForm.Top, TheForm.Width - DifferenceX, TheForm.Height Case 1 TheForm.Move TheForm.Left, TheForm.Top, TheForm.Width + DifferenceX, TheForm.Height Case 2 TheForm.Move TheForm.Left, TheForm.Top + DifferenceY, TheForm.Width, TheForm.Height - DifferenceY Case 3 TheForm.Move TheForm.Left, TheForm.Top, TheForm.Width, TheForm.Height + DifferenceY Case 4 TheForm.Move TheForm.Left, TheForm.Top, TheForm.Width + DifferenceX, TheForm.Height + DifferenceY Case 5 TheForm.Move TheForm.Left + DifferenceX, TheForm.Top, TheForm.Width - DifferenceX, TheForm.Height + DifferenceY Case 6 TheForm.Move TheForm.Left, TheForm.Top + DifferenceY, TheForm.Width + DifferenceX, TheForm.Height - DifferenceY Case 7 TheForm.Move TheForm.Left + DifferenceX, TheForm.Top + DifferenceY, TheForm.Width - DifferenceX, TheForm.Height - DifferenceY End Select End Sub Для границы (Image1): Dim ResIze As Boolean, Temp As PointAPI, OldCursorPos As PointAPI, NewCursorPos As PointAPI Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Temp = GetCursorPos(OldCursorPos) ResIze = True End Sub Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If ResIze = True Then Temp = GetCursorPos(NewCursorPos) ResizeForm Me, OldCursorPos, NewCursorPos, 1 OldCursorPos = NewCursorPos End If End Sub Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) ResIze = False Temp = GetCursorPos(NewCursorPos) ResizeForm Me, OldCursorPos, NewCursorPos, 1 ' Вот здесь можно написать свой код... End Sub Понимаю трудный код! Но это - единственный вариант, который я могу предложить... |
||
|
Номер ответа: 2 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #2 | Добавлено: 03.04.07 16:06 |
|
Влад Рубцов спасибо конечно, но это не то, что нужно. У меня на форме три десятка контролов при событии Form_Resize они сами устанавливаются в нужном мне порядке. Но происходит мерцание формы особенно при уменьшении, если бы я мог определить что юзер уже бросил издеватся над формой, то часть кода которая и вызывает мерцание была бы только тогда выполнена.
|
||
|
Номер ответа: 3 Автор ответа: СерёгаICQ: 262809473 Вопросов: 17 Ответов: 561 |
Web-сайт: Профиль | | #3 | Добавлено: 03.04.07 18:36 |
|
Ну примерно как - то так:
форма: Private Sub Form_Load()
HookForm Me End Sub Private Sub Form_Resize() Me.Print "Form_resize" End Sub Private Sub Form_Unload(Cancel As Integer) UnHookForm Me End Sub Модуль: Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Const GWL_WNDPROC = (-4) Dim PrevProc As Long Private Const WM_SIZE = &H5 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_SETCURSOR = &H20 Private Const WM_MOUSEMOVE = &H200 Private SizeProcess As Long Private Type MSG uMsg As Long wParam As Long lParam As Long End Type Private oldMsg As MSG Public Sub HookForm(F As Form) PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc) End Sub Public Sub UnHookForm(F As Form) SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc End Sub Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim LParamLo As Long, LParamHi As Long If uMsg = WM_SIZE Then With oldMsg .uMsg = uMsg .lParam = lParam .wParam = wParam End With If SizeProcess = 1 Then uMsg = 0 End If If SizeProcess = 2 Then uMsg = oldMsg.uMsg lParam = oldMsg.lParam wParam = oldMsg.wParam SizeProcess = 0 End If If uMsg = WM_SETCURSOR Then LParamLo = lParam Mod 65536 LParamHi = lParam / 65536 If LParamLo > 9 And LParamLo < 18 Then If LParamHi = WM_LBUTTONDOWN Then SizeProcess = 1 If LParamHi = WM_MOUSEMOVE And SizeProcess = 1 Then SizeProcess = 2 End If End If WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam) End Function |
||
|
Номер ответа: 4 Автор ответа: AgentFire ICQ: 192496851 Вопросов: 75 Ответов: 3178 |
Профиль | | #4 | Добавлено: 03.04.07 20:01 |
|
Да не, все в ~4 раза проще, чем вы думаете.
Public Const VK_RBUTTON = &H2
Public Const VK_LBUTTON = &H1 Public Declare Function GetAsyncKeyState Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer Код для определения, нажата ли кнопка мыши (правая и левая): If GetAsyncKeyState(VK_LBUTTON) Then MsgBox "Ресайз окончен!" используй этот код в таймере, который включай при Form_Resize
|
||
|
Номер ответа: 5 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #5 | Добавлено: 03.04.07 22:03 |
|
AgentFire мне нужно конец "Ресайз окончен", а так получиется Ресайз начат.
Попробую вариант Серёги, что получится еще не знаю. |
||
|
Номер ответа: 6 Автор ответа: StarsВопросов: 41 Ответов: 239 |
Профиль | | #6 | Добавлено: 04.04.07 09:48 |
| Дай мыло скину пример если надо который глобально отлавливает Мышку. При желании легко можно доработать в то что тебе надо! | ||
|
Номер ответа: 7 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #7 | Добавлено: 04.04.07 10:20 |
|
Дай мыло скину пример если надо который глобально отлавливает Мышку. При желании легко можно доработать в то что тебе надо!
Rus-Skipper@yandex.ru Серёга извени еще не разбирался, но всю ночь болели старые раны,не спал, с трудом к компу подошел почту проверить и сюда заглянуть. |
||
|
Номер ответа: 8 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #8 | Добавлено: 04.04.07 11:27 |
| Серёга! Спасибо все OK'! ТО что нужно. | ||
|
Номер ответа: 9 Автор ответа: StarsВопросов: 41 Ответов: 239 |
Профиль | | #9 | Добавлено: 04.04.07 12:38 |
| Боцман всётаки я те заслал на мыло! ну хз вдруг гденить пригодится?! | ||
|
Номер ответа: 10 Автор ответа: AgentFireICQ: 192496851 Вопросов: 75 Ответов: 3178 |
Профиль | | #10 | Добавлено: 04.04.07 15:11 |
|
AgentFire мне нужно конец "Ресайз окончен", а так получиется Ресайз начат. Ну ёпрст, неужели так трудно чуть-чуть извилиной пошевелить? Знаете же ведь, что изменить посты нельзя, что я ошибся в одном месте, и что приписать нужно буквально 6-7 символов.
вместо этого If GetAsyncKeyState(VK_LBUTTON) Then MsgBox "Ресайз окончен!" вот этоIf Not GetAsyncKeyState(VK_LBUTTON) Then MsgBox "Ресайз окончен!"
|
||
|
Номер ответа: 11 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #11 | Добавлено: 04.04.07 17:46 |
|
Прежде чем писать попробовал бы сам свой код.
вместо этого
If GetAsyncKeyState(VK_LBUTTON) Then MsgBox "Ресайз окончен!" вот это If Not GetAsyncKeyState(VK_LBUTTON) Then MsgBox "Ресайз окончен!" Ну и что, всеравно Ресайз начат.Ты попробуй изменить размер формы? If Not GetAsyncKeyState(VK_LBUTTON) Then Me.Print "Ресайз окончен!"[/
Запиришся читать что он окончен. |
||
|
Номер ответа: 12 Автор ответа: СерёгаICQ: 262809473 Вопросов: 17 Ответов: 561 |
Web-сайт: Профиль | | #12 | Добавлено: 04.04.07 18:10 |
|
Боцман,я вчера торопился и написал явную лажу.
Хорошо, что все сделали вид, что не заметили  ))
Вот более корректный вариант модуля: Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const GWL_WNDPROC = (-4) Dim PrevProc As Long Private Const WM_SIZE = &H5 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_SETCURSOR = &H20 Private Const WM_MOUSEMOVE = &H200 Private SizeProcess As Long Private Type MSG uMsg As Long wParam As Long lParam As Long End Type Private OldMsg As MSG Public Sub HookForm(F As Form) PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc) End Sub Public Sub UnHookForm(F As Form) SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc End Sub Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim LParamLo As Long, LParamHi As Long If uMsg = WM_SIZE And SizeProcess > 0 Then With OldMsg .uMsg = uMsg .lParam = lParam .wParam = wParam End With uMsg = 0 If SizeProcess <> 2 Then SizeProcess = 2 End If If uMsg = WM_SETCURSOR Then LParamLo = lParam Mod 65536 LParamHi = lParam / 65536 If LParamLo > 9 And LParamLo < 18 Then If LParamHi = WM_LBUTTONDOWN Then SizeProcess = 1 If LParamHi = WM_MOUSEMOVE And SizeProcess = 2 Then PostMessage hwnd, OldMsg.uMsg, OldMsg.wParam, OldMsg.lParam SizeProcess = 0 End If End If End If WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam) End Function |
||
|
Номер ответа: 13 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #13 | Добавлено: 04.04.07 18:47 |
|
Боцман,я вчера торопился и написал явную лажу.
Да все нормально, лично мне если не произошло изменения, то как бы и мерцания небыло. |
||
|
Номер ответа: 14 Автор ответа: AgentFireICQ: 192496851 Вопросов: 75 Ответов: 3178 |
Профиль | | #14 | Добавлено: 05.04.07 14:16 |
|
Прежде чем писать попробовал бы сам свой код.
вместо этого
If GetAsyncKeyState(VK_LBUTTON) Then MsgBox "Ресайз окончен!" вот это If Not GetAsyncKeyState(VK_LBUTTON) Then MsgBox "Ресайз окончен!" Ну и что, всеравно Ресайз начат.Ты попробуй изменить размер формы? If Not GetAsyncKeyState(VK_LBUTTON) Then Me.Print "Ресайз окончен!"[/
Запиришся читать что он окончен. Да что такое, ты не вникаешь в суть кода, тебе все готовенькое печатай.. Если не хочешь мучиься читать дбавть Timer.Enabled=False, а включается он при Form_Resize, которые уже прекратилось. |
||
|
Номер ответа: 15 Автор ответа: БоцманICQ: 295725312 Вопросов: 53 Ответов: 830 |
Web-сайт: Профиль | | #15 | Добавлено: 05.04.07 16:24 |
| AgentFire в твой код я как раз вникал,но находился в плену своей задачи. Я отлавливал MouseUp это то, что точно определил Серега и даже не подумал о простой блокировки кода во время Ресайза. Спасибо за науку. | ||