Getting mouse position not working as expected

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

Getting mouse position not working as expected

Post by UEZ »

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: 1619
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Getting mouse position not working as expected

Post by St_W »

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/window ... ed-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: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Post by UEZ »

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/window ... ed-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: 1619
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Getting mouse position not working as expected

Post by St_W »

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: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Post by UEZ »

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: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Getting mouse position not working as expected

Post by dodicat »

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: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Post by UEZ »

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: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Getting mouse position not working as expected

Post by dodicat »

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: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Post by UEZ »

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: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Getting mouse position not working as expected

Post by dodicat »

Thanks UEZ.
https://docs.microsoft.com/en-gb/window ... ing-timers
But I would never have thought of that.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Post by UEZ »

dodicat wrote:Thanks UEZ.
https://docs.microsoft.com/en-gb/window ... ing-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: 1619
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Getting mouse position not working as expected

Post by St_W »

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: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Getting mouse position not working as expected

Post by UEZ »

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: 1619
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Getting mouse position not working as expected

Post by St_W »

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.
Post Reply