|
Post by scalion on Dec 27, 2018 15:42:00 GMT 1
I try use GetWindowInfo function from user32.dll , but that's dont work and i never found what the problem Maybe in my type declaration for the structure of WINDOWINFO or the declaration of function GetWindowInfo, idk . Does anyone have an idea because I am completely lost there.
Declare Function GetWindowInfo Lib "user32.dll" (Hwnd As Long, pwindowinfo As Long) As Boolean InitialisationTypes ' Step 1: Registering the Window Class
Global wc As WNDCLASSEX wc.cbSize = SizeOf(WNDCLASSEX) wc.style = 0 wc.lpfnWndProc = ProcAddr(toto) wc.cbClsExtra = 0 wc.cbWndExtra = 0 wc.hInstance = Screen.hWnd wc.hIcon = LoadIcon(Null, IDI_APPLICATION) wc.hCursor = IDC_ARROW wc.hbrBackground = 0 wc.lpszMenuName = Null Global String PP = "Toto"#0 wc.lpszClassName = V:PP wc.hIconSm = LoadIcon(Null, IDI_APPLICATION)
If !RegisterClassEx(V:wc) Message "zut..." End Else Message "Register ok" EndIf
' Step 2: Creating the Window Global Long Hwnd Hwnd = CreateWindowEx(WS_EX_CLIENTEDGE, PP, "title", WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 640, 480, Screen.hWnd, Null, Null, Null) If Hwnd = Null Message "CreateWindowEx fail...." End EndIf Void ShowWindow(Hwnd, SW_NORMAL) Void UpdateWindow(Hwnd) Void SetForegroundWindow(Hwnd) Global Msg As MSG Global WinInfo As WINDOWINFO WinInfo.cbSize = SizeOf(WINDOWINFO)
If GetWindowInfo(Hwnd, V:WinInfo) = True // <- never work !!! grrrrr With WinInfo.RcWindow Void MessageBox(Hwnd, .x1 & .y1 & .x2 & .y2, "Info", MB_OK) EndWith EndIf Global PT As POINT Global RC As RECT Global Long WinLeft, WinTop, WinRight, WinBottom Global Long ClientLeft, ClientTop, ClientRight, ClientBottom Global Long Mx, My While GetMessage(V:Msg, Null, 0, 0) Void TranslateMessage(V:Msg) Void DispatchMessage(V:Msg) Void GetCursorPos(V:PT) Void ScreenToClient(Hwnd, V:PT) Mx = PT.x My = PT.y Void SetPixel(GetDC(Hwnd), Mx, My, 0) Wend
Void UnregisterClass(V:PP, Screen.hWnd)
Function toto(hWnd%, Mess%, wParam%, lParam%) As Long Static Long hdc, hdcCompat, crBkgnd, hbrBkgnd Static ps As PAINTSTRUCT Static rc As RECT Select Mess Case WM_CREATE hdc = GetDC(hWnd) 'crBkgnd = GetBkColor(hdc) hbrBkgnd = CreateSolidBrush(RGB(255, 255, 255)) //crBkgnd) Void ReleaseDC(hWnd, hdc) Case WM_CLOSE 'If MessageBox(Hwnd,"Are you sure ?", "Quit the program", MB_YESNO) = IDYES Void DestroyWindow(hWnd) ' EndIf Case WM_DESTROY Void DeleteObject(hbrBkgnd) Void PostQuitMessage(0) Case WM_MOVE Void GetWindowRect(hWnd, V:rc) WinLeft = rc.x1 : WinTop = rc.y1 : WinRight = rc.x2 : WinBottom = rc.y2 Void GetClientRect(hWnd, V:rc) ClientLeft = rc.x1 : ClientTop = rc.y1 : ClientRight = rc.x2 : ClientBottom = rc.y2 Case WM_SIZE Void GetWindowRect(hWnd, V:rc) WinLeft = rc.x1 : WinTop = rc.y1 : WinRight = rc.x2 : WinBottom = rc.y2 Void GetClientRect(hWnd, V:rc) ClientLeft = rc.x1 : ClientTop = rc.y1 : ClientRight = rc.x2 : ClientBottom = rc.y2 Void GetClientRect(hWnd, V:rc) hdc = BeginPaint(hWnd, V:ps) Void SelectObject(ps.hdc, GetStockObject(WHITE_BRUSH)) Void Rectangle(ps.hdc, rc.x1, rc.y1, rc.x2, rc.y2) Void TextOut(hdc, 0, 0, "Hello, Windows!", 15) Void EndPaint(hWnd, V:ps) Void InvalidateRect(hWnd, Null, True) Case WM_PAINT Case Else Return DefWindowProc(hWnd, Mess, wParam, lParam) EndSelect Return 0 EndFunc Proc InitialisationTypes Type PAINTSTRUCT Packed 1 - Long hdc - Boolean fErase - Long x1, y1, x2, y2 - Boolean fRestore - Boolean fIncUpdate - Byte rgbReserved(32) EndType Type RECT Packed 1 - Long x1, y1, x2, y2 EndType Type WINDOWINFO Packed 1 - Long cbSize RcWindow As RECT RcClient As RECT - Long dwStyle - Long dwExStyle - Long dwWindowStatus - Long cxWindowBorders - Long cyWindowBorders - Card atomWindowType - Card wCreatorVersion EndType Type MSG Packed 1 - Long Hwnd - Long message - Short wParam - Short lParam - Double time - Long Mx - Long My - Long lPrivate EndType Type WNDCLASSEX Packed 1 - Long cbSize - Long style - Long lpfnWndProc - Long cbClsExtra - Long cbWndExtra - Long hInstance - Long hIcon - Long hCursor - Long hbrBackground - Long lpszMenuName - Long lpszClassName - Long hIconSm EndType Type POINT Packed 1 - Long x, y EndType EndProc
|
|
|
Post by dragonjim on Jan 10, 2019 22:39:12 GMT 1
Hi, I've tried your example and can not work out why this is not working - it seems as though the Hwnd value is corrupt. I will have a look at some old programs I wrote some years ago and see how I managed to get this to work.
|
|
|
Post by scalion on Jan 11, 2019 21:54:22 GMT 1
Hi Dragonjim, Thx for your reply; I hope you find them quickly ! Have a good day.
|
|
|
Post by dragonjim on Jan 27, 2019 0:25:33 GMT 1
Hi,
Tried to find a solution to this but having no joy. Also having no joy in tracking down my old code in which I am sure I got GetWindowInfo to work...😣
Had a quick look online and there seem to be no reported issues with the function in other applications. My interim conclusion would have to be that there is a problem with the way GFA creates and stores the information but I can not see why this should be...
In other words, I'm stuck at the moment...
|
|
|
Post by scalion on Jan 27, 2019 13:46:13 GMT 1
Hi,
Thank's for your research. I think i missing something in my code, i will try antother way.
|
|
|
Post by (X) on Mar 3, 2022 1:14:22 GMT 1
Si tu changes la définition à:
Declare Function GetWindowInfo Lib "user32.dll" ( _ ByVal Hwnd As Long, _ ByRef pwindowinfo As WINDOWINFO) As Boolean Ou ceci: Declare Function GetWindowInfo Lib "user32.dll" ( _ ByVal Hwnd As Long, _ ByVal pwindowinfo As Any) As Boolean Et utilises:
If GetWindowInfo(Hwnd, WinInfo) = True
Ou:
Declare Function GetWindowInfo Lib "user32.dll" ( _ ByVal hWnd As Long, _ ByVal pwindowinfo As Long) As Boolean Et utilises:
If GetWindowInfo(Hwnd, V:WinInfo) = True
Ça marche...
|
|
|
Post by (X) on Mar 7, 2022 1:18:54 GMT 1
The code I used:
' ' This program uses the window messages to translate and dispatch ' messages to the window process function: FnWndProcess() thus ' acting more like a C++ program than a VB program. ' ' Originally, I was just trying to verify that GetWindowInfo() ' function actually works. ' ' $Library "gfawinx" $ManifestOff Mode Date "-" P_Main
Proc P_Main P_Inits P_Create_Window P_MessageHandlerLoop Proc P_Inits P_Init_Types P_Init_Declarations P_Init_Application Proc P_Init_Declarations °Declare Function GetWindowInfo Lib "user32.dll" ( _ ByVal hWnd As Long, _ ByRef pwindowinfo As WINDOWINFO) As Boolean Declare Function GetWindowInfo Lib "user32.dll" ( _ ByVal hWnd As Long, _ ByVal pwindowinfo As Long) As Boolean Declare Function _LoadCursor Lib "user32" Alias "LoadCursorA" ( _ ByVal hInstance As Long, _ ByVal lpCursorName As String) As Long Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" ( _ ByVal dwExStyle As Long, _ ByVal lpClassName As Long, _ ByVal lpWindowName As Long, _ ByVal dwStyle As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal hWndParent As Long, _ ByVal hMenu As Long, _ ByVal hInstance As Long, _ lpParam As Any) As Long Proc P_Init_Application ' ' Step 1: Registering the Window Class ' Local WC As WNDCLASSEX Global G_Msg As MSG Local String sClassName = "MainWClass" Local String sMenuName = "MainMenu" Global Long lpClassName = V:sClassName Local Long lpMenuName = V:sMenuName Global Long hInstance = App.hInstance Trace hInstance With WC .cbSize = SizeOf(WNDCLASSEX) .style = CS_HREDRAW | CS_VREDRAW .lpfnWndProc = ProcAddr(FnWndProc) .cbClsExtra = 0 .cbWndExtra = 0 .hInstance = hInstance .hIcon = LoadIcon(hInstance, IDI_APPLICATION) .hCursor = _LoadCursor(hInstance, IDC_ARROW) 'IDC_ARROW .hbrBackground = GetStockObject(LTGRAY_BRUSH) .lpszMenuName = lpMenuName .lpszClassName = lpClassName .hIconSm = LoadIcon(Null, IDI_APPLICATION) EndWith ' ' If the function fails, the return value is zero. ' If (RegisterClassEx(V:WC) == 0) Trace "RegisterClassEx Failure" Else Trace "RegisterClassEx Success" EndIf Proc P_Close Try Debug "Close" ' ' This sometimes fails and when I try to run ' the program again it fails to register. ' Especially, if I have moved the window. ' I have to shut down GFA IDE and start over. ' ' This seems to have fixed the problem: ' ' From: https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-registerclassexa ' ' All window classes that an application registers ' are unregistered when it terminates. ' ' No window classes registered by a DLL are unregistered ' when the DLL is unloaded. A DLL must explicitly ' unregister its classes when it is unloaded. ' °Trace lpClassName °Trace App.hInstance °Trace hInstance °Trace UnregisterClass(lpClassName, hInstance) °Local bRet As Byte, c% = 1 °Do °bRet = UnregisterClass(lpClassName, Null) °Debug "Count = "; c, "bRet= ";bRet °c++ °Loop While (bRet == 0) And (c <= 10) Catch Trace Err$ EndCatch Proc P_Create_Window ' ' Step 2: Creating the Window ' Global Long G_hWnd Local String sTitle = App.Name Local Long lpTitle = V:sTitle ° ByVal dwExStyle As Long, _ ByVal lpClassName As Long, _ ByVal lpWindowName As Long, _ ByVal dwStyle As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal hWndParent As Long, _ ByVal hMenu As Long, _ ByVal hInstance As Long, _ lpParam As Any) As Long ' WS_EX_CLIENTEDGE | ' WS_OVERLAPPEDWINDOW G_hWnd = CreateWindowEx( _ WS_EX_TOPMOST | WS_EX_STATICEDGE | WS_EX_OVERLAPPEDWINDOW | WS_EX_APPWINDOW, _ lpClassName, _ lpTitle, _ WS_OVERLAPPEDWINDOW | WS_BORDER , _ 100, _ 100, _ 600, 400, _ 0, 0, _ App.hInstance, _ ByVal 0) If (G_hWnd = Null) Trace "CreateWindowEx Failure" Else Trace "CreateWindowEx Success" EndIf ~ShowWindow(G_hWnd, SW_NORMAL) ~UpdateWindow(G_hWnd) ~SetForegroundWindow(G_hWnd) P_Show_Window_Info Proc P_Show_Window_Info ' ' Uses: ' /* Declare Function GetWindowInfo Lib "user32.dll" ( _ ByVal hWnd As Long, _ ByRef pwindowinfo As WINDOWINFO) As Boolean */ ' // // Type WINDOWINFO Packed 2 // - Long cbSize // RcWindow As RECT // RcClient As RECT // - Long dwStyle // - Long dwExStyle // - Long dwWindowStatus // - Long cxWindowBorders // - Long cyWindowBorders // - Card atomWindowType // - Card wCreatorVersion // EndType // ' ' Define window information variable... ' Local WI As WINDOWINFO ' ' Note that you must set the cbSize member to ' SizeOf(WINDOWINFO) before calling this function. ' WI.cbSize = SizeOf(WINDOWINFO) ' ' If the function succeeds, the return value is nonzero. ' If (GetWindowInfo(G_hWnd, V:WI) <> 0) With WI.RcWindow 'Debug "RcWindow(x1:";(.x1) & ", y1:";(.y1) & ", x2:";(.x2) & ", y2:";(.y2);")" Debug "RcWindow(x1:";(.Left) & ", y1:";(.Top) & ", x2:";(.Right) & ", y2:";(.Bottom);")" EndWith With WI.RcClient 'Debug "RcClient(x1:";(.x1) & ", y1:";(.y1) & ", x2:";(.x2) & ", y2:";(.y2);")" Debug "RcClient(x1:";(.Left) & ", y1:";(.Top) & ", x2:";(.Right) & ", y2:";(.Bottom);")" EndWith Else Debug "GetWindowInfo Failure" EndIf Proc P_MessageHandlerLoop Debug "Loop Start " & DateTime$ ' ' Message Handler Loop... ' Do While (GetMessage(V:G_Msg, Null, 0, 0)) ~TranslateMessage(V:G_Msg) ~DispatchMessage(V:G_Msg) Loop Debug "Loop End " & DateTime$ Function FnWndProc(hWnd%, Mess%, wParam%, lParam%) As Long ' ' Declare a few vars... ' Local Long hdc, crBkgnd, hbrBkgnd Local Long Mx, My Local ps As PAINTSTRUCT Local rc As RECT Local PT As POINT ' ' Select..Case ' Select Mess Case WM_CREATE : Debug "WM_Create" hdc = GetDC(hWnd) 'crBkgnd = GetBkColor(hdc) hbrBkgnd = CreateSolidBrush(RGB(255, 255, 255)) //crBkgnd) ~ReleaseDC(hWnd, hdc) Case WM_CLOSE : Debug "WM_Close" 'If MessageBox(hWnd,"Are you sure ?", "Quit the program", MB_YESNO) = IDYES P_Close ~DestroyWindow(hWnd) ' EndIf Case WM_DESTROY : Debug "WM_Destroy" ~DeleteObject(hbrBkgnd) ~PostQuitMessage(0) Case WM_MOVE : Debug "WM_Move" P_Show_Window_and_Client_Metrics(hWnd) Case WM_SIZE : Debug "WM_Size" P_Show_Window_and_Client_Metrics(hWnd) Case WM_PAINT : Debug "WM_Paint" Case WM_MOUSEMOVE : Debug "WM_MouseMove" Void GetCursorPos(V:PT) Void ScreenToClient(hWnd, V:PT) Mx = PT.x My = PT.y Void SetPixel(GetDC(hWnd), Mx, My, 0) P_Show_Window_and_Client_Metrics(hWnd) Case Else Return DefWindowProc(hWnd, Mess, wParam, lParam) EndSelect Return 0 EndFunc
Proc P_Show_Window_and_Client_Metrics(hWnd As Long) Local Long hdc Local ps As PAINTSTRUCT Local rc As RECT Local Long WinLeft, WinTop, WinRight, WinBottom Local Long ClientLeft, ClientTop, ClientRight, ClientBottom ~GetWindowRect(hWnd, V:rc) WinLeft = rc.Left WinTop = rc.Top WinRight = rc.Right WinBottom = rc.Bottom 'Debug "Window:", WinLeft, WinTop, WinRight, WinBottom ~GetClientRect(hWnd, V:rc) ClientLeft = rc.Left ClientTop = rc.Top ClientRight = rc.Right ClientBottom = rc.Bottom 'Debug "Client:", ClientLeft, ClientTop, ClientRight, ClientBottom Local WI As WINDOWINFO ~GetWindowInfo(hWnd, V:WI) 'Trace WinLeft ' ' For some reason the variable values for WinLeft are set to 0 ' after the BeginPaint statement. ' NWTFITA? "Now, Wut the fuk is dat about?" (Best with Irish accent) ' Local s1$ = "Hello World! " & DateTime$ Local s2$ = "GetWindowRect(" & _ WinLeft & "," & _ WinTop & "," & _ WinRight & "," & _ WinBottom & ")" Local s3$ = "GetClientRect(" & _ ClientLeft & "," & _ ClientTop & "," & _ ClientRight & "," & _ ClientBottom & ")" Local s4$ = "GetWindowInfo:Window(" & _ WI.RcWindow.Left & "," & _ WI.RcWindow.Top & "," & _ WI.RcWindow.Right & "," & _ WI.RcWindow.Bottom & ")" Local s5$ = "GetWindowInfo:Client(" & _ WI.RcClient.Left & "," & _ WI.RcClient.Top & "," & _ WI.RcClient.Right & "," & _ WI.RcClient.Bottom & ")" Local s6$ = "MouseScreen:(x:" & _ MouseSX & ", y:" & _ MouseSY & ")" Local s7$ = "MsgMouseXY:(x:" & _ G_Msg.Mx & ", y:" & _ G_Msg.My & ")" Local s8$ = "WindowBorders:(cx:" & _ WI.cxWindowBorders & ", cy:" & _ WI.cyWindowBorders & ")" ~InvalidateRect(hWnd, Null, True) ' '######################################################## ' hdc = BeginPaint(hWnd, V:ps) ~SelectObject(ps.hdc, GetStockObject(GRAY_BRUSH)) ~Rectangle(ps.hdc, _ (ClientLeft + 20), _ (ClientTop + 20), _ (ClientRight - 20), _ (ClientBottom - 20)) ~TextOut(hdc, 30, 30, s1$, Len(s1$)) ~TextOut(hdc, 30, 90, s2$, Len(s2$)) ~TextOut(hdc, 30, 120, s3$, Len(s3$)) ~TextOut(hdc, 30, 150, s4$, Len(s4$)) ~TextOut(hdc, 30, 180, s5$, Len(s5$)) ~TextOut(hdc, 30, 210, s6$, Len(s6$)) ~TextOut(hdc, 30, 240, s7$, Len(s7$)) ~TextOut(hdc, 30, 270, s8$, Len(s8$)) ~EndPaint(hWnd, V:ps) ' '######################################################## ' Proc P_Init_Types Type PAINTSTRUCT Packed 2 - Long hdc - Boolean fErase - Long x1, y1, x2, y2 - Boolean fRestore - Boolean fIncUpdate - Byte rgbReserved(32) EndType °Type RECT Packed 2 °- Long x1, y1, x2, y2 °EndType Type WINDOWINFO Packed 2 cbSize As Int32 RcWindow As RECT RcClient As RECT dwStyle As Int32 dwExStyle As Int32 dwWindowStatus As Int32 cxWindowBorders As Int32 cyWindowBorders As Int32 atomWindowType As Int16 wCreatorVersion As Int16 EndType Type MSG Packed 2 - Long hWnd - Long message - Short wParam - Short lParam - Double time - Long Mx - Long My - Long lPrivate EndType Type WNDCLASSEX Packed 2 - Long cbSize - Long style - Long lpfnWndProc - Long cbClsExtra - Long cbWndExtra - Long hInstance - Long hIcon - Long hCursor - Long hbrBackground - Long lpszMenuName - Long lpszClassName - Long hIconSm EndType °Type POINT Packed 2 °- Long x, y °EndType EndProc
|
|