Getting mouse position not working as expected

Windows specific questions.
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Getting mouse position not working as expected

Postby UEZ » Nov 06, 2018 15:30

I tried to translate one of my Autoit scripts to FB but got surprised that it is not working as expected.

Getting the mouse cursor position works only when mouse hovers the cross-hairs. The GUI is transparent and the cross-hairs will only shown.

Code: Select all

#Include "fbgfx.bi"
#Include "windows.bi"

Type RectF
   X as Single
   Y as Single
   Width as Single
   Height as Single
End Type

type tCURSORINFO
   cbSize as Long
   flags as Long
   hCursor as HCURSOR
   ptScreenPos as POINT
end type

Dim Shared As HWND hGUI
Dim Shared Msg As MSG
Dim Shared As Any Ptr hHBitmap, hDC, hMemDC, hOld, hPen
Dim Shared As Ushort iW, iH
Dim Shared As Point pSize, pSource, pDest
Dim Shared As POINT mp
Dim Shared As tCURSORINFO mpos
Dim Shared As RECT tDesktop
Dim Shared As BLENDFUNCTION pBlend
Dim Shared As Integer mx, my, mb, mxo, myo


Function _WinAPI_MarkScreenRegion() As RectF
   Dim As RectF tMarkedArea
   Dim As HWND hHWND_Dt
   
   hHWND_Dt = FindWindow("Progman","Program Manager")
   GetWindowRect(hHWND_Dt, @tDesktop)

   iW = tDesktop.right + Abs(tDesktop.left)
   iH = tDesktop.bottom + Abs(tDesktop.top)
   
   Dim As String sTitle = "GDI Mark Screen Region"

   hGUI = CreateWindowEx(   WS_EX_LAYERED Or WS_EX_TOPMOST, _
                     Strptr("#32770"), sTitle, _
                     WS_POPUP Or WS_VISIBLE, _
                     tDesktop.left, tDesktop.top, _
                     iW, iH, _
                     NULL, NULL, GetModuleHandle(NULL), NULL)
   
   ShowWindow(hGUI, SW_SHOW)
   ShowCursor(False)
   Dim As Ulong Ptr aBitmap
   Dim As BITMAPINFO tBITMAP
   With tBITMAP.bmiheader
            .biSize = Sizeof(BITMAPINFOHEADER)
            .biWidth = iW
            .biHeight = -iH
            .biPlanes = 1
            .biBitCount = 32
            .biCompression = BI_RGB
   End With

   hDC = GetDC(hGUI)
   hMemDC = CreateCompatibleDC(hDC)
   hHBitmap = CreateDIBSection(hDC, @tBITMAP, DIB_RGB_COLORS, @aBitmap, NULL, NULL)
   hOld = SelectObject(hMemDC, hHBitmap)
   hPen = SelectObject(hMemDC, GetStockObject(DC_Pen))
   SetDCPenColor(hMemDC, &h0000FF) 'BGR
   
   
   pSize.x = iW
   pSize.y = iH
   pDest.x = tDesktop.left
   pDest.y = tDesktop.top
   
   With pBlend
        .BlendOp = AC_SRC_OVER
        .BlendFlags = 0
        .SourceConstantAlpha = 255
        .AlphaFormat = AC_SRC_ALPHA
   End With
   
   mpos.cbSize = Sizeof(tCURSORINFO)
   
   
   While GetMessage(@Msg, hGUI, 0, 0)
   
      If GetCursorInfo(Cast(Any ptr, @mpos)) <> 0 Then mpos.cbSize = Sizeof(tCURSORINFO)
      mx = mpos.ptScreenPos.x + Abs(tDesktop.left)
      my = mpos.ptScreenPos.y + Abs(tDesktop.top)
      
      If mx <> mxo Or my <> myo Then
         BitBlt(hMemDC, 0, 0, iW, iH, hMemDC, 0, 0, CAPTUREBLT)

         MoveToEx(hMemDC, tDesktop.left, my, NULL)
         LineTo(hMemDC, iW, my)

         MoveToEx(hMemDC, mx, tDesktop.top, NULL)
         LineTo(hMemDC, mx, iH)
         
         'UpdateLayeredWindow(hGUI, hDC, Cast(Any Ptr, @pDest), Cast(Any Ptr, @pSize), hMemDC, Cast(Any Ptr, @pSource), 0, Cast(Any Ptr, @pBlend), ULW_OPAQUE)
         UpdateLayeredWindow(hGUI, hDC, Cast(Any Ptr, @pDest), Cast(Any Ptr, @pSize), hMemDC, Cast(Any Ptr, @pSource), 0, Cast(Any Ptr, @pBlend), ULW_COLORKEY)
         
         mxo = mx
         myo = my
      End If
      
      TranslateMessage(@Msg)
      DispatchMessage(@Msg)

      Select Case Msg.hwnd
         Case hGUI
            Select Case Msg.message
               Case WM_QUIT, WM_COMMAND 
                  Exit While
            End Select
      End Select   
   Wend
   
   SelectObject(hMemDC, hPen)
   DeleteObject(hPen)
   SelectObject(hMemDC, hOld)
   DeleteDC(hMemDC)
   ReleaseDC(0, hDC)
   DeleteObject(hHBitmap)
   CloseWindow(hGUI)
   ShowCursor(TRUE)
   
   Return tMarkedArea
End Function


_WinAPI_MarkScreenRegion()


Is there anything that I missed? I tried several get mouse coordinate winapi functions but non of them worked as expected.

If you switch line 100 <-> 101 then it works but then the GUI is opaque.
Last edited by UEZ on Nov 06, 2018 20:37, edited 1 time in total.
St_W
Posts: 1404
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Getting mouse position not working as expected

Postby St_W » Nov 06, 2018 15:50

I think it behaves as expected:
MSDN wrote:Hit testing of a layered window is based on the shape and transparency of the window. This means that the areas of the window that are color-keyed or whose alpha value is zero will let the mouse messages through.
https://docs.microsoft.com/en-us/windows/desktop/winmsg/window-features#layered-windows

Which type of WM do you get in your AutoIt application's message loop?

To solve the issue you could use a timer:

Code: Select all

SetTimer(hGUI, 100, 0, 0)


btw your application has issues with multiple and/or HiDPI screens
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Postby UEZ » Nov 06, 2018 16:11

St_W wrote:I think it behaves as expected:
MSDN wrote:Hit testing of a layered window is based on the shape and transparency of the window. This means that the areas of the window that are color-keyed or whose alpha value is zero will let the mouse messages through.
https://docs.microsoft.com/en-us/windows/desktop/winmsg/window-features#layered-windows

Which type of WM do you get in your AutoIt application's message loop?

To solve the issue you could use a timer:

Code: Select all

SetTimer(hGUI, 100, 0, 0)


btw your application has issues with multiple and/or HiDPI screens


Well, with AutoIt it works different. I don't need to set a timer function for this kind of a GUI and that's the reason why the result is different using FB. It seems that AutoIt behaves different than what MS suggests.
In AutoIt you don't need necessary to work with WMs. If you are interested to see the AutoIt code then have a look here: _WinAPI_MarkScreenRegionAndCapture
The trick with the SetTimer worked - thx.

I tested this code in my office with 3 monitors and the cross-hairs follows the mouse properly. The DPI is set to normal. Further, I just started with it... ;-)
Last edited by UEZ on Nov 06, 2018 20:38, edited 1 time in total.
St_W
Posts: 1404
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Getting mouse position not working as expected

Postby St_W » Nov 06, 2018 17:34

I also tested it in the office :-) but with a laptop (150% scaling) connected to a monitor (100% / no scaling). Depending on whether the application (console) was positioned on the one display or the other it worked or didn't. As you do not face issues i assume it's related to HiDpi. Maybe the app just needs to be marked as dpiaware - I haven't tried.
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Postby UEZ » Nov 06, 2018 19:45

St_W wrote:I also tested it in the office :-) but with a laptop (150% scaling) connected to a monitor (100% / no scaling). Depending on whether the application (console) was positioned on the one display or the other it worked or didn't. As you do not face issues i assume it's related to HiDpi. Maybe the app just needs to be marked as dpiaware - I haven't tried.


Can you try this when you are in your office again if it displayed properly please?

Code: Select all

#Include "fbgfx.bi"
#Include "windows.bi"

Using FB

Type RectF
   X as Single
   Y as Single
   Width as Single
   Height as Single
End Type

type tCURSORINFO
   cbSize as Long
   flags as Long
   hCursor as HCURSOR
   ptScreenPos as POINT
end type

Enum PROCESS_DPI_AWARENESS
   PROCESS_DPI_UNAWARE = 0,
   PROCESS_SYSTEM_DPI_AWARE,
   PROCESS_PER_MONITOR_DPI_AWARE
End Enum

Function _WinAPI_MarkScreenRegion() As RectF
   Dim As HWND hGUI
   Dim Msg As MSG
   Dim As Any Ptr hHBitmap, hDC, hMemDC, hOld, hPen
   Dim As Ushort iW, iH
   Dim As Point pSize, pSource, pDest, mp
   Dim As tCURSORINFO mpos
   Dim As RECT tDesktop
   Dim As BLENDFUNCTION pBlend
   Dim As Integer mx, my, mb, mxo, myo
   Dim As Long dwVersion = GetVersion()
   If Hiword(dwVersion) > 6299 Then
      Dim As Any Ptr hLib = Dylibload("Shcore.dll")
      Dim pPROCESS_DPI_AWARENESS As Function(Byval value As PROCESS_DPI_AWARENESS) As Long
      pPROCESS_DPI_AWARENESS = Dylibsymbol(hLib, "SetProcessDpiAwareness")
      pPROCESS_DPI_AWARENESS(PROCESS_SYSTEM_DPI_AWARE)
      Dylibfree(hLib)
   Else
      Dim As Any Ptr hLib = Dylibload("User32.dll")
      Dim pPROCESS_DPI_AWARENESS As Function() As BOOL
      pPROCESS_DPI_AWARENESS = Dylibsymbol(hLib, "SetProcessDPIAware")
      pPROCESS_DPI_AWARENESS()
      Dylibfree(hLib)
   End If
   
   Dim As RectF tMarkedArea
   Dim As HWND hHWND_Dt
   
   hHWND_Dt = FindWindow("Progman","Program Manager")
   GetWindowRect(hHWND_Dt, @tDesktop)

   iW = tDesktop.right + Abs(tDesktop.left)
   iH = tDesktop.bottom + Abs(tDesktop.top)
   
   Dim As String sTitle = "GDI Mark Screen Region"

   hGUI = CreateWindowEx(   WS_EX_LAYERED Or WS_EX_TOPMOST, _
                     Strptr("#32770"), sTitle, _
                     WS_POPUP Or WS_VISIBLE, _
                     tDesktop.left, tDesktop.top, _
                     iW, iH, _
                     NULL, NULL, GetModuleHandle(NULL), NULL)
   
   ShowWindow(hGUI, SW_SHOW)
   ShowCursor(False)
   Dim As Ulong Ptr aBitmap
   Dim As BITMAPINFO tBITMAP
   With tBITMAP.bmiheader
            .biSize = Sizeof(BITMAPINFOHEADER)
            .biWidth = iW
            .biHeight = -iH
            .biPlanes = 1
            .biBitCount = 32
            .biCompression = BI_RGB
   End With

   hDC = GetDC(hGUI)
   hMemDC = CreateCompatibleDC(hDC)
   hHBitmap = CreateDIBSection(hDC, @tBITMAP, DIB_RGB_COLORS, @aBitmap, NULL, NULL)
   hOld = SelectObject(hMemDC, hHBitmap)
   hPen = SelectObject(hMemDC, GetStockObject(DC_Pen))
   SetDCPenColor(hMemDC, &h0000FF) 'BGR
   
   
   pSize.x = iW
   pSize.y = iH
   pDest.x = tDesktop.left
   pDest.y = tDesktop.top
   
   With pBlend
        .BlendOp = AC_SRC_OVER
        .BlendFlags = 0
        .SourceConstantAlpha = 255
        .AlphaFormat = AC_SRC_ALPHA
   End With
   
   mpos.cbSize = Sizeof(tCURSORINFO)
   
   Dim As uinteger pTimer = SetTimer(hGUI, 0, 10, 0)
   
   While GetMessage(@Msg, hGUI, 0, 0)

      If GetCursorInfo(Cast(Any ptr, @mpos)) <> 0 Then mpos.cbSize = Sizeof(tCURSORINFO)
      mx = mpos.ptScreenPos.x + Abs(tDesktop.left)
      my = mpos.ptScreenPos.y + Abs(tDesktop.top)
      
      If mx <> mxo Or my <> myo Then
         BitBlt(hMemDC, 0, 0, iW, iH, hMemDC, 0, 0, CAPTUREBLT)

         MoveToEx(hMemDC, tDesktop.left, my, NULL)
         LineTo(hMemDC, iW, my)

         MoveToEx(hMemDC, mx, tDesktop.top, NULL)
         LineTo(hMemDC, mx, iH)
         
         'UpdateLayeredWindow(hGUI, hDC, Cast(Any Ptr, @pDest), Cast(Any Ptr, @pSize), hMemDC, Cast(Any Ptr, @pSource), 0, Cast(Any Ptr, @pBlend), ULW_OPAQUE)
         UpdateLayeredWindow(hGUI, hDC, Cast(Any Ptr, @pDest), Cast(Any Ptr, @pSize), hMemDC, Cast(Any Ptr, @pSource), 0, Cast(Any Ptr, @pBlend), ULW_COLORKEY)
         
         mxo = mx
         myo = my
      End If
      
      TranslateMessage(@Msg)
      DispatchMessage(@Msg)
            
      Select Case Msg.hwnd
         Case hGUI
            Select Case Msg.message
               Case WM_KEYDOWN
                  If Msg.wParam = VK_ESCAPE Then Exit While
            End Select
      End Select   
      
   Wend
   
   KillTimer(hGUI, pTimer)
   
   SelectObject(hMemDC, hPen)
   DeleteObject(hPen)
   SelectObject(hMemDC, hOld)
   DeleteDC(hMemDC)
   ReleaseDC(0, hDC)
   DeleteObject(hHBitmap)
   CloseWindow(hGUI)
   ShowCursor(TRUE)
   
   Return tMarkedArea
End Function


_WinAPI_MarkScreenRegion()


Danke.
Last edited by UEZ on Nov 06, 2018 20:41, edited 1 time in total.
dodicat
Posts: 5221
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Getting mouse position not working as expected

Postby dodicat » Nov 06, 2018 19:56

I think
While GetMessage(@Msg,WM_INPUT, 0, 0)
gets the whole desktop.
Your code:

Code: Select all

#Include "fbgfx.bi"
#Include "windows.bi"

Type RectF
   X as Single
   Y as Single
   Width as Single
   Height as Single
End Type

type tCURSORINFO
   cbSize as Long
   flags as Long
   hCursor as HCURSOR
   ptScreenPos as POINT
end type

Dim Shared As HWND hGUI
Dim Shared Msg As MSG
Dim Shared As Any Ptr hHBitmap, hDC, hMemDC, hOld, hPen
Dim Shared As Ushort iW, iH
Dim Shared As Point pSize, pSource, pDest
Dim Shared As POINT mp
Dim Shared As tCURSORINFO mpos
Dim Shared As RECT tDesktop
Dim Shared As BLENDFUNCTION pBlend
Dim Shared As Integer mx, my, mb, mxo, myo


Function _WinAPI_MarkScreenRegion() As RectF
   Dim As RectF tMarkedArea
   Dim As HWND hHWND_Dt
   
   hHWND_Dt = FindWindow("Progman","Program Manager")
   GetWindowRect(hHWND_Dt, @tDesktop)

   iW = tDesktop.right + Abs(tDesktop.left)
   iH = tDesktop.bottom + Abs(tDesktop.top)
   
   Dim As String sTitle = "GDI Mark Screen Region"

   hGUI = CreateWindowEx(   WS_EX_LAYERED Or WS_EX_TOPMOST, _
                     Strptr("#32770"), sTitle, _
                     WS_POPUP Or WS_VISIBLE, _
                     tDesktop.left, tDesktop.top, _
                     iW/2, iH/2, _
                     NULL, NULL, GetModuleHandle(NULL), NULL)
   
   ShowWindow(hGUI, SW_SHOW)
   ShowCursor(False)
   Dim As Ulong Ptr aBitmap
   Dim As BITMAPINFO tBITMAP
   With tBITMAP.bmiheader
            .biSize = Sizeof(BITMAPINFOHEADER)
            .biWidth = iW
            .biHeight = -iH
            .biPlanes = 1
            .biBitCount = 32
            .biCompression = BI_RGB
   End With

   hDC = GetDC(hGUI)
   hMemDC = CreateCompatibleDC(hDC)
   hHBitmap = CreateDIBSection(hDC, @tBITMAP, DIB_RGB_COLORS, @aBitmap, NULL, NULL)
   hOld = SelectObject(hMemDC, hHBitmap)
   hPen = SelectObject(hMemDC, GetStockObject(DC_Pen))
   SetDCPenColor(hMemDC, &h0000FF) 'BGR
   
   
   pSize.x = iW
   pSize.y = iH
   pDest.x = tDesktop.left
   pDest.y = tDesktop.top
   
   With pBlend
        .BlendOp = AC_SRC_OVER
        .BlendFlags = 0
        .SourceConstantAlpha = 255
        .AlphaFormat = AC_SRC_ALPHA
   End With
   
   mpos.cbSize = Sizeof(tCURSORINFO)
   
 
   While GetMessage(@Msg,WM_INPUT, 0, 0)
 
      If GetCursorInfo(Cast(Any ptr, @mpos)) <> 0 Then mpos.cbSize = Sizeof(tCURSORINFO)
      mx = mpos.ptScreenPos.x + Abs(tDesktop.left)
      my = mpos.ptScreenPos.y + Abs(tDesktop.top)
     
      If mx <> mxo Or my <> myo Then
         BitBlt(hMemDC, 0, 0, iW, iH, hMemDC, 0, 0, CAPTUREBLT)

         MoveToEx(hMemDC, tDesktop.left, my, NULL)
         LineTo(hMemDC, iW, my)

         MoveToEx(hMemDC, mx, tDesktop.top, NULL)
         LineTo(hMemDC, mx, iH)
         
         'UpdateLayeredWindow(hGUI, hDC, Cast(Any Ptr, @pDest), Cast(Any Ptr, @pSize), hMemDC, Cast(Any Ptr, @pSource), 0, Cast(Any Ptr, @pBlend), ULW_OPAQUE)
         UpdateLayeredWindow(hGUI, hDC, Cast(Any Ptr, @pDest), Cast(Any Ptr, @pSize), hMemDC, Cast(Any Ptr, @pSource), 0, Cast(Any Ptr, @pBlend), ULW_COLORKEY)
         
         mxo = mx
         myo = my
      End If
     
      TranslateMessage(@Msg)
      DispatchMessage(@Msg)

      Select Case Msg.hwnd
         Case hGUI
            Select Case Msg.message
               Case WM_QUIT, WM_COMMAND 
                  Exit While
            End Select
      End Select   
   Wend
   
   SelectObject(hMemDC, hPen)
   DeleteObject(hPen)
   SelectObject(hMemDC, hOld)
   DeleteDC(hMemDC)
   ReleaseDC(0, hDC)
   DeleteObject(hHBitmap)
   CloseWindow(hGUI)
   ShowCursor(TRUE)
   
   Return tMarkedArea
End Function


_WinAPI_MarkScreenRegion() 
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Postby UEZ » Nov 06, 2018 20:17

Thx dodicat, the cross-hairs is moved now when I move the mouse but the program crashes as soon as I press the lmb.
dodicat
Posts: 5221
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Getting mouse position not working as expected

Postby dodicat » Nov 06, 2018 21:25

I see UEZ.
Well I cheated anyway, bypassing the working window.
What did you change from post 1 to get it to work?
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Postby UEZ » Nov 06, 2018 21:45

dodicat wrote:I see UEZ.
Well I cheated anyway, bypassing the working window.
What did you change from post 1 to get it to work?


I added

Code: Select all

Dim As uinteger pTimer = SetTimer(hGUI, 0, 10, 0)
as St_W has suggested. It works properly.
Currently, for me it is not clear why SetTimer() fixes the issue...
dodicat
Posts: 5221
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Getting mouse position not working as expected

Postby dodicat » Nov 06, 2018 22:49

Thanks UEZ.
https://docs.microsoft.com/en-gb/windows/desktop/winmsg/using-timers
But I would never have thought of that.
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Postby UEZ » Nov 07, 2018 11:22

dodicat wrote:Thanks UEZ.
https://docs.microsoft.com/en-gb/windows/desktop/winmsg/using-timers
But I would never have thought of that.


Thanks for the link. Now it makes more sense why to use SetTimer but then the code has to be changed accordingly.

Code: Select all

#Include "fbgfx.bi"
#Include "windows.bi"

Using FB

Type RectF
   X as Single
   Y as Single
   Width as Single
   Height as Single
End Type

type tCURSORINFO
   cbSize as Long
   flags as Long
   hCursor as HCURSOR
   ptScreenPos as POINT
end type

Enum PROCESS_DPI_AWARENESS
   PROCESS_DPI_UNAWARE = 0,
   PROCESS_SYSTEM_DPI_AWARE,
   PROCESS_PER_MONITOR_DPI_AWARE
End Enum

Function _WinAPI_MarkScreenRegion() As RectF
   Dim As HWND hGUI
   Dim Msg As MSG
   Dim As Any Ptr hHBitmap, hDC, hMemDC, hOld, hPen
   Dim As Ushort iW, iH
   Dim As Point pSize, pSource, pDest, mp
   Dim As tCURSORINFO mpos
   Dim As RECT tDesktop
   Dim As BLENDFUNCTION pBlend
   Dim As Integer mx, my, mb, mxo, myo
   Dim As Long dwVersion = GetVersion()
   If Hiword(dwVersion) > 6299 Then
      Dim As Any Ptr hLib = Dylibload("Shcore.dll")
      Dim pPROCESS_DPI_AWARENESS As Function(Byval value As PROCESS_DPI_AWARENESS) As Long
      pPROCESS_DPI_AWARENESS = Dylibsymbol(hLib, "SetProcessDpiAwareness")
      pPROCESS_DPI_AWARENESS(PROCESS_SYSTEM_DPI_AWARE)
      Dylibfree(hLib)
   Else
      Dim As Any Ptr hLib = Dylibload("User32.dll")
      Dim pPROCESS_DPI_AWARENESS As Function() As BOOL
      pPROCESS_DPI_AWARENESS = Dylibsymbol(hLib, "SetProcessDPIAware")
      pPROCESS_DPI_AWARENESS()
      Dylibfree(hLib)
   End If
   
   Dim As RectF tMarkedArea
   Dim As HWND hHWND_Dt
   
   hHWND_Dt = FindWindow("Progman","Program Manager")
   GetWindowRect(hHWND_Dt, @tDesktop)

   iW = tDesktop.right + Abs(tDesktop.left)
   iH = tDesktop.bottom + Abs(tDesktop.top)
   
   Dim As String sTitle = "GDI Mark Screen Region"

   hGUI = CreateWindowEx(   WS_EX_LAYERED Or WS_EX_TOPMOST, _
                     Strptr("#32770"), sTitle, _
                     WS_POPUP Or WS_VISIBLE, _
                     tDesktop.left, tDesktop.top, _
                     iW, iH, _
                     NULL, NULL, GetModuleHandle(NULL), NULL)
   
   ShowWindow(hGUI, SW_SHOW)
   ShowCursor(False)
   Dim As Ulong Ptr aBitmap
   Dim As BITMAPINFO tBITMAP
   With tBITMAP.bmiheader
            .biSize = Sizeof(BITMAPINFOHEADER)
            .biWidth = iW
            .biHeight = -iH
            .biPlanes = 1
            .biBitCount = 32
            .biCompression = BI_RGB
   End With

   hDC = GetDC(hGUI)
   hMemDC = CreateCompatibleDC(hDC)
   hHBitmap = CreateDIBSection(hDC, @tBITMAP, DIB_RGB_COLORS, @aBitmap, NULL, NULL)
   hOld = SelectObject(hMemDC, hHBitmap)
   hPen = SelectObject(hMemDC, GetStockObject(DC_Pen))
   SetDCPenColor(hMemDC, &h0000FF) 'BGR
   
   
   pSize.x = iW
   pSize.y = iH
   pDest.x = tDesktop.left
   pDest.y = tDesktop.top
   
   With pBlend
        .BlendOp = AC_SRC_OVER
        .BlendFlags = 0
        .SourceConstantAlpha = 255
        .AlphaFormat = AC_SRC_ALPHA
   End With
   
   mpos.cbSize = Sizeof(tCURSORINFO)
   
   Dim As uinteger pTimer = SetTimer(hGUI, 0, 10, 0)
   
   While GetMessage(@Msg, hGUI, 0, 0)

      If GetCursorInfo(Cast(Any ptr, @mpos)) <> 0 Then mpos.cbSize = Sizeof(tCURSORINFO)
      mx = mpos.ptScreenPos.x + Abs(tDesktop.left)
      my = mpos.ptScreenPos.y + Abs(tDesktop.top)
         
      TranslateMessage(@Msg)
      DispatchMessage(@Msg)
            
      Select Case Msg.hwnd
         Case hGUI
            Select Case Msg.message
               Case WM_KEYDOWN
                  If Msg.wParam = VK_ESCAPE Then Exit While
               Case WM_TIMER
                  If mx <> mxo Or my <> myo Then
                     BitBlt(hMemDC, 0, 0, iW, iH, hMemDC, 0, 0, CAPTUREBLT)

                     MoveToEx(hMemDC, tDesktop.left, my, NULL)
                     LineTo(hMemDC, iW, my)

                     MoveToEx(hMemDC, mx, tDesktop.top, NULL)
                     LineTo(hMemDC, mx, iH)
                     
                     'UpdateLayeredWindow(hGUI, hDC, Cast(Any Ptr, @pDest), Cast(Any Ptr, @pSize), hMemDC, Cast(Any Ptr, @pSource), 0, Cast(Any Ptr, @pBlend), ULW_OPAQUE)
                     UpdateLayeredWindow(hGUI, hDC, Cast(Any Ptr, @pDest), Cast(Any Ptr, @pSize), hMemDC, Cast(Any Ptr, @pSource), 0, Cast(Any Ptr, @pBlend), ULW_COLORKEY)
                     
                     mxo = mx
                     myo = my
                  End If
            End Select
      End Select   
      
   Wend
   
   KillTimer(hGUI, pTimer)
   
   SelectObject(hMemDC, hPen)
   DeleteObject(hPen)
   SelectObject(hMemDC, hOld)
   DeleteDC(hMemDC)
   ReleaseDC(0, hDC)
   DeleteObject(hHBitmap)
   CloseWindow(hGUI)
   ShowCursor(TRUE)
   
   Return tMarkedArea
End Function


_WinAPI_MarkScreenRegion()
St_W
Posts: 1404
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Getting mouse position not working as expected

Postby St_W » Nov 07, 2018 14:05

UEZ wrote:Can you try this when you are in your office again if it displayed properly please?

No, unfortunately doesn't fix the issue. However, I tried setting HiDPI override to "application" in the compatibility settings and this does work. So dpi-awareness seems to be the issue, but your fix doesn't work somehow. Probably it needs per-monitor dpi awareness, because my monitors use different scaling settings?
I've implemented a tiny dpiAware demo a while ago and tried using the application manifest from that demo with your application and that worked.
http://users.freebasic-portal.de/stw/fi ... e-demo.zip
UEZ
Posts: 210
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Postby UEZ » Nov 07, 2018 14:33

St_W wrote:
UEZ wrote:Can you try this when you are in your office again if it displayed properly please?

No, unfortunately doesn't fix the issue. However, I tried setting HiDPI override to "application" in the compatibility settings and this does work. So dpi-awareness seems to be the issue, but your fix doesn't work somehow. Probably it needs per-monitor dpi awareness, because my monitors use different scaling settings?
I've implemented a tiny dpiAware demo a while ago and tried using the application manifest from that demo with your application and that worked.
http://users.freebasic-portal.de/stw/fi ... e-demo.zip


Hmm, as I don't have that issue what is your issue? I assume the mouse cursor is not at proper position (middle of the cross-hairs).
I changed 2 of 3 of my monitors to different scale value and tried "PROCESS_PER_MONITOR_DPI_AWARE" as value and it seemed to work properly if this was the case.
Thanks for the manifest. I will test it later...
St_W
Posts: 1404
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Getting mouse position not working as expected

Postby St_W » Nov 07, 2018 20:10

UEZ wrote:Hmm, as I don't have that issue what is your issue? I assume the mouse cursor is not at proper position (middle of the cross-hairs).
Exactly; mouse pointer position and crosshairs position differ on the screen with scaling <> 100%. It works fine on the other display with 100% scaling.

Return to “Windows”

Who is online

Users browsing this forum: No registered users and 1 guest