| Вопрос: Ограничение resize'а | Добавлено: 28.01.05 18:57 |
Автор вопроса:  Vit | Web-сайт: www.home-soft.jino-net.ru
|
| Кто знает/помнит, при помощи какой API можно было ограничить размер формы при Resize'е? |
| Ответы | Всего ответов: 10 |
|
Номер ответа: 1 Автор ответа:  cresta Вопросов: 117 Ответов: 1538 |
Профиль | | #1 | Добавлено: 28.01.05 19:14 |
|
Не такой API.
Обрабатывай сообщение WM_GETMINMAXINFO |
||
|
Номер ответа: 2 Автор ответа:  Alexandrus ICQ: 496782368 Вопросов: 18 Ответов: 312 |
Web-сайт: Профиль | | #2 | Добавлено: 28.01.05 21:46 |
|
Код в модуль :
Private Const GWL_WNDPROC = -4 Private Const WM_GETMINMAXINFO = &H24 Private Type POINTAPI x As Long y As Long End Type Private Type MINMAXINFO ptReserved As POINTAPI ptMaxSize As POINTAPI ptMaxPosition As POINTAPI ptMinTrackSize As POINTAPI ptMaxTrackSize As POINTAPI End Type Dim lpPrevWndProc As Long Dim gHW As Long Private Type Resize xMin As Single yMin As Single xMax As Single yMax As Single End Type Private Declare Function DefWindowProc Lib "user32" Alias "  efWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Sub CopyMemoryToMinMaxInfo Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, ByVal cbCopy As Long) Private Declare Sub CopyMemoryFromMinMaxInfo Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, ByVal cbCopy As Long) Dim rResize As Resize Public Sub Hook(ByVal wHWND As Long, Optional ByVal X_Min As Single = 0, Optional ByVal Y_Min As Single = 0, Optional ByVal X_Max As Single = 0, Optional ByVal Y_Max As Single = 0) gHW = wHWND rResize.xMax = X_Max rResize.yMax = Y_Max rResize.xMin = X_Min rResize.yMin = Y_Min lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc) End Sub Public Sub Unhook() im temp As Long
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc) End Sub Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim MinMax As MINMAXINFO If uMsg = WM_GETMINMAXINFO Then WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam) CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax) If rResize.xMin <> 0 Then MinMax.ptMinTrackSize.x = rResize.xMin If rResize.yMin <> 0 Then MinMax.ptMinTrackSize.y = rResize.yMin If rResize.xMax <> 0 Then MinMax.ptMaxTrackSize.x = rResize.xMax If rResize.yMax <> 0 Then MinMax.ptMaxTrackSize.y = rResize.yMax CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax) WindowProc = DefWindowProc(hw, uMsg, wParam, lParam) Else WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam) End If End Function Код в форму : Private Sub Form_Load() Hook Me.hwnd, 100, 100, 500, 500 End Sub Private Sub Form_Unload(Cancel As Integer) Unhook End Sub С ув. Alex |
||
|
Номер ответа: 3 Автор ответа: HACKERРазработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | | #3 | Добавлено: 29.01.05 15:55 |
|
ого, а не проще что то типа
Private Sub Form_Resize() Static MeH Static MeW If MeH = 0 Then MeH = Me.Height If MeW = 0 Then MeW = Me.Width 'ограничение максимум If Me.Height > MeH Then Me.Height = MeH If Me.Width > MeW Then Me.Width = MeW 'ограничение минимум If Me.Height <= 2000 Then Me.Height = 2000 If Me.Width <= 1000 Then Me.Width = 1000 End Sub |
||
|
Номер ответа: 4 Автор ответа: sneРазработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | | #4 | Добавлено: 29.01.05 17:21 |
|
Нет не легче, оно мерцает, мигает и вообще неадекватно ведет сеюя...
Не хотел я тут флэймить, но вот реализация вышеупомянутого кода в более краткой форме: Option Explicit
'-------------------------------------------------------------------------------- ' Модуль : mFormSubclassing ' Проект : OfflineClient ' ' Описание : Модуль функций сабклассинга окон... Мало-ли что может понадобиться 
' ' Изменяли : sne, '-------------------------------------------------------------------------------- Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) Private Declare Function DefWindowProc Lib "user32.dll" Alias " efWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_USER As Long = &H400 Private Const WM_GETMINMAXINFO As Long = &H24 Public Function puFrmProgress(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Const cxMin As Long = 333& ' мин. и макс. размеры окошка Const cyMin As Long = 233& Const cxMax As Long = 520& Const cyMax As Long = 682& If uMsg = WM_GETMINMAXINFO Then If clSettings.frmProgress.bMaximized Then Call CopyMemory(ByVal lParam + 24&, cxMin&, 4&
Call CopyMemory(ByVal lParam + 28&, cyMin&, 4&
Call CopyMemory(ByVal lParam + 32&, cxMax&, 4&
Call CopyMemory(ByVal lParam + 36&, cyMax&, 4&
puFrmProgress = DefWindowProc(hwnd, uMsg, wParam, lParam) Exit Function End If End If puFrmProgress = WM_USER + vbNull ' Вызов стандартного обработчика End Function Public Function puFrmMain(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Const cx As Long = 500& ' мин. размеры окошка Const cy As Long = 400& If uMsg = WM_GETMINMAXINFO Then Call CopyMemory(ByVal lParam + 24&, cx&, 4&
Call CopyMemory(ByVal lParam + 28&, cy&, 4&
puFrmMain = DefWindowProc(hwnd, uMsg, wParam, lParam) Exit Function End If puFrmMain = WM_USER + vbNull ' Вызов стандартного обработчика End Function Тут приведены две оконные процедуры ограничение изменения размеров окна... Код сабклассинга включать сюда не стал... |
||
|
Номер ответа: 5 Автор ответа: HACKERРазработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | | #5 | Добавлено: 29.01.05 17:56 |
Мы не ищем лёгких путей!  )) Это уже скоро будет девиз ВБНЭТА...
|
||
|
Номер ответа: 6 Автор ответа: sneРазработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | | #6 | Добавлено: 29.01.05 18:39 |
| imho - это девиз любого кто решается писать что-то на VB... такая уж судьба горькая... | ||
|
Номер ответа: 7 Автор ответа: ПавелАдминистратор ICQ: 326066673 Вопросов: 368 Ответов: 5968 |
Web-сайт: Профиль | | #7 | Добавлено: 29.01.05 20:16 |
|
2 HACKER: может и проще, но хуже: граинца окна будет дергаться при
изменении размера, что может раздражать юзера. |
||
|
Номер ответа: 8 Автор ответа:  AlexandrusICQ: 496782368 Вопросов: 18 Ответов: 312 |
Web-сайт: Профиль | | #8 | Добавлено: 29.01.05 21:15 |
|
У-у-у-у ! Ну про все написали ... и вставить то нечего !
С ув. Alex |
||
|
Номер ответа: 9 Автор ответа: sneРазработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | | #9 | Добавлено: 29.01.05 21:43 |
|
Ах да, солвсем забыл, в моем вариенте там используется модуль для сабклассинга, дык вот это:
puFrmMain = WM_USER + vbNull ' Вызов стандартного обработчика это для него... тут надо просто вставить CallWindowProc... |
||
|
Номер ответа: 10 Автор ответа: Vit Вопросов: 68 Ответов: 62 |
Web-сайт: Профиль | | #10 | Добавлено: 30.01.05 13:06 |
| Огромное спасибо ВСЕМ!!!!! | ||
Страница: 1 |