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()
If you switch line 100 <-> 101 then it works but then the GUI is opaque.