собственно как? как отследить окно FULLSCREEN развернуто или NORMAL , получить логическое значение? Вот нажали мы на кнопке "развернуть" , как получить событие?
Добавлено (22.05.2023, 21:23) --------------------------------------------- может кому пригодится ... Сделать кнопку "развернуть" не активной :
Код
#Include Once "windows.bi" #include "fbgfx.bi" Using FB
ScreenRes 800, 600, 32, 2
Dim As Integer wind Dim As HWND w ScreenControl(GET_WINDOW_HANDLE, wind) w = Cast( HWND, wind) SetWindowLong( w,GWL_STYLE, GetWindowLong( w,GWL_STYLE) xor WS_MAXIMIZEBOX)
If MultiKey(SC_S ) Then ShowWindow( w, SW_MAXIMIZE) ' при нажатии на кнопку окно развернут в полный экран\ свернуть ей же
как отследить окно FULLSCREEN развернуто или NORMAL , получить логическое значение?
Код
#INCLUDE "windows.bi" Dim msg As MSG Dim As WNDCLASSEX wc Dim As String NameClass="MyClass" Dim As HINSTANCE Hinst=GetModuleHandle(0) Function wndproc(hwnd As HWND, msg As Uinteger,_ wparam As WPARAM, lparam As LPARAM) As Integer Select Case msg Case WM_DESTROY PostQuitMessage(0) case WM_SIZE if wparam = SIZE_MAXIMIZED then ' окно на весь экран ' ..... elseif wparam = SIZE_RESTORED ' размер восстановлен ' ..... endif End Select Return DefWindowProc(hwnd,msg,wparam,lparam) End Function With wc .cbSize=SizeOf(WNDCLASSEX) .style=CS_HREDRAW Or CS_VREDRAW .lpfnWndProc=@WndProc .hInstance=Hinst .hIcon=LoadIcon(0,IDI_QUESTION) .hCursor=LoadCursor(0,IDC_HELP) .hbrBackground=Cast(HBRUSH,COLOR_WINDOWFRAME) .lpszClassName=StrPtr(NameClass) .hIconSm=.hIcon End With If RegisterClassEx(@wc)=0 Then Print "Register error, press any key" Sleep End Endif CreateWindowEx(0,NameClass,"",_ WS_VISIBLE Or WS_OVERLAPPEDWINDOW,100,100,300,300,0,0,Hinst,0) While GetMessage(@msg,0,0,0) TranslateMessage(@msg) DispatchMessage(@msg) Wend
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
Откуда вообще возник вопрос «отследить»? Вы же режим устанавливаете, следовательно, вы знаете когда у вас «полноэкранное» окно и когда обычное перекрывающееся.
Возможно не корректно задал вопрос, в принципе необходимо отследить клик мыши на системную кнопку окна "развернуть", по типу "закрытия" окна ( InKey = Chr(255)+"k" ) , вот что нужно. А так же и клик по кнопке "свернуть". За ответы ,благодарю!
Добавлено (23.05.2023, 07:44) --------------------------------------------- на purebasic есть такая функция
Код
State = GetWindowState(#Window)
Код
Return value
It can be one of the following values:
#PB_Window_Normal : The window is neither maximized nor minimized. #PB_Window_Maximize: The window is maximized. #PB_Window_Minimize: The window is minimized.
считываю положение, размер окна ( окон ) и при нажатии кнопки "развернуть" положение сбрасывается в [ -3, -3] ,а при возврате
Код
If MultiKey(SC_S ) Then ShowWindow( root.handle, SW_MAXIMIZE)
положение окна остаётся [ -3, -3], а не каким было до разворачивания в полноэкранное.
Добавлено (25.05.2023, 20:06) --------------------------------------------- Ээ ... Привет, сново вопрос к теме. Переопределил WinProc
Код
Function handle() As HWND Dim As Integer wind ScreenControl( FB.GET_WINDOW_HANDLE, wind ) Return Cast( HWND, wind) End Function ... ... SetWindowLong( handle,GWL_WNDPROC, Cast(Long, @wndproc)) ... ... Function wndproc(hwnd As HWND, msg As Uinteger, wparam As WPARAM, lparam As LPARAM) As Integer Function = 0
Select Case msg Case WM_CREATE GetWindowRect( hwnd, @_window_size_rect_) Case WM_GETMINMAXINFO _window_minmax_=Cast(MINMAXINFO Ptr,lparam) _window_minmax_->ptMinTrackSize.x = 220're.right 'ìèíèìàëüíûé ðàçìåð ïî îñè X _window_minmax_->ptMinTrackSize.y = 1're.bottom 'ìèíèìàëüíûé ðàçìåð ïî îñè Y _window_minmax_->ptMaxTrackSize.x = GetSystemMetrics(SM_CXSCREEN)'ìàêñèìàëüíûé ðàçìåð ïî îñè X _window_minmax_->ptMaxTrackSize.y = GetSystemMetrics(SM_CYSCREEN)'ìàêñèìàëüíûé ðàçìåð ïî îñè Y Return 0 'Case WM_LBUTTONDOWN 'mb = 1 Case WM_RBUTTONDOWN 'mb = 2 Case WM_LBUTTONUP ' MessageBox NULL, "Hello world from FreeBasic", "FB Win", MB_OK Case Else Function = DefWindowProc(hwnd,msg,wparam,lparam) End Select End Function
и ... о, чудо, перестало работать GetMouse( mx, my, mz, mb) , напрочь. Собственно как встривать WM_GETMINMAXINFO в уже существующий WinProc? Куда копать? Заранее признателен к неравнодушным\знающим. polopok
первый второй (самый последний пример) Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
Type EVENT Field = 1 Type As Integer Union Type scancode As Integer ascii As Integer End Type Type x As Integer y As Integer dx As Integer dy As Integer End Type button As Integer z As Integer w As Integer End Union End Type
разшарил;
Код
Dim Shared evnt As EVENT
В общем переписал wndproc
Код
Function wndproc(hwnd As HWND, msg As Uinteger, wparam As WPARAM, lparam As LPARAM) As Integer Function = 0
'evnt.button = 0 'evnt.z = 0
Select Case msg Case WM_CREATE GetWindowRect( hwnd, @_window_size_rect_) Case WM_GETMINMAXINFO _window_minmax_=Cast(MINMAXINFO Ptr,lparam) _window_minmax_->ptMinTrackSize.x = _window_size_rect_.right _window_minmax_->ptMinTrackSize.y = _window_size_rect_.bottom _window_minmax_->ptMaxTrackSize.x = GetSystemMetrics(SM_CXSCREEN) _window_minmax_->ptMaxTrackSize.y = GetSystemMetrics(SM_CYSCREEN) Return 0 Case WM_LBUTTONDOWN evnt.type = EVENT_MOUSE_BUTTON_PRESS evnt.button = 1 Case WM_RBUTTONDOWN evnt.type = EVENT_MOUSE_BUTTON_PRESS evnt.button = 2 Case WM_MBUTTONDOWN evnt.type = EVENT_MOUSE_BUTTON_PRESS evnt.button = 4 Case WM_LBUTTONUP evnt.type = EVENT_MOUSE_BUTTON_RELEASE evnt.button = 1 Case WM_RBUTTONUP evnt.type = EVENT_MOUSE_BUTTON_RELEASE evnt.button = 2 Case WM_MBUTTONUP evnt.type = EVENT_MOUSE_BUTTON_RELEASE evnt.button = 4 Case WM_MOUSEMOVE evnt.type = EVENT_MOUSE_MOVE Case WM_NCMOUSEMOVE ' Ïåðåìåùåíèå êóðñîðà ìûøè âî âíåøíåé îáëàñòè îêíà evnt.type = EVENT_MOUSE_ENTER 'Case WM_MOUSEWHEEL ' evnt.type = EVENT_MOUSE_WHEEL 'Case WM_HSCROLL ' evnt.z = LoWord(wParam) ' 'Case WM_VSCROLL ' evnt.w = LoWord(wParam) ' Case Else Function = DefWindowProc(hwnd,msg,wparam,lparam) End Select End Function
С MOUSEWHEEL не понял как получать значения и клавиатуру пока не опрашиваю, выложил может кому пригодится.
Никакого DefWindowProc внутри субклассенной оконной процедуры быть не должно. Если вы не обрабатываете субклассенное сообщение, то его следует отправлять в оригинальную процедуру, которая вернула функция SetWindowLong когда вы субклассили окно.
Никакого DefWindowProc внутри субклассенной оконной процедуры быть не должно. Если вы не обрабатываете субклассенное сообщение, то его следует отправлять в оригинальную процедуру, которая вернула функция SetWindowLong когда вы субклассили окно.
Написано превосходно, но непонятно, я так профан-любитель. ( возможно наглядный пример прояснит , что , и куда пихать)
Последнее что я учудил:
Код
var Wlong = GetWindowLong( _root_.wnd,GWL_WNDPROC) SetWindowLong( _root_.wnd,GWL_WNDPROC, Wlong or Cast(Long, @wndproc) )
и ... прога немножечко вылетела, ругалась ... а я в печали. polopok
Сообщение отредактировал ntvgjhfnj - Суббота, 27.05.2023, 20:32
' Сохранить старую оконную процедуру Dim OldRightEnemyGroupBoxProc As WndProc = Cast(WndProc, GetWindowLongPtr(hWin, GWLP_WNDPROC))
' Установить новую оконную процедуру SetWindowLongPtr(hWin, GWLP_WNDPROC, Cast(LONG_PTR, @NewWindowProc))
' Новая оконная процедура: Function NewWindowProc(ByVal hWin As HWND, ByVal wMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT
Select Case wMsg
' Обрабатываем сообщения которые нам нунжы Case WM_ERASEBKGND ' ... Return 1
Case Else ' Сообщения которые не обрабатываем, отправляем в оригинальную оконную процедуру Return CallWindowProc(OldRightEnemyGroupBoxProc, hWin, wMsg, wParam, lParam)
End Select
End Function
Не используйте функции GetWindowLong и SetWindowLong — эти функции устарели. Используйте GetWindowLongPtr и SetWindowLongPtr.
