WinTick 1.1

[Borje Hagsten]

Code:

'====================================================================
' WinTick.bas, a timer driven Window information grabber.
' Original code published in February 2003
' Public Domain by Borje Hagsten, November 2026
'
' WinTick looks at window under cursor with 200 ms intervals, grabs and
' shows hWnd, id and class name, plus eventual parent's class and hWnd.
' Now enhanced with drawing a rectangle round pointed widow (DrawRect)
'
' A note: It fails on disabled windows. Ms says ChildWindowFromPoint
' should work with disabled windows, but I couldn't get it to work so
' I decided it was not worth spending more time on, so skipped that.
'
' Why WinTick? Because I sometimes need window info for whatever reason.
' Why a version update after 23 years? Because it is fun to do..
'====================================================================
#COMPILE EXE
%UNICODE = 1
#INCLUDE "WIN32API.INC"
'--------------------------------------------------------------------
' For old/new dialog design - thank you Jules Marchildon for this tip!
DECLARE FUNCTION DwmSetWindowAttribute LIB "dwmapi.dll" ALIAS "DwmSetWindowAttribute" _
        (BYVAL hWnd AS DWORD,BYVAL dwAttribute AS DWORD, _
        BYREF pvAttribute AS DWORD, BYVAL cbAttribute AS DWORD) AS LONG

%DWMWA_NCRENDERING_POLICY = 2   '-Set, who should draw the frame
%DWMNCRP_DISABLED         = 1   '-DWM does not draw the frame gives the legacy look
%DWMNCRP_ENABLED          = 2   '-DWM draws the modern frame
'--------------------------------------------------------------------
%IDC_TEXBOX1 = 501
GLOBAL ghDlg AS LONG

'====================================================================
' Main entrance
'--------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
  LOCAL hDlg AS DWORD
  '------------------------------------------------------------------
  SetProcessDPIAware ' I do this, because I use 150% screen scaling
  '------------------------------------------------------------------
  DIALOG FONT "Tahoma", 9
  DIALOG NEW 0, "WinTick v1.1",,, 180, 90, %WS_CAPTION OR %WS_SYSMENU OR _
                                            %WS_MINIMIZEBOX, 0 TO ghDlg
  DIALOG SET COLOR ghDlg, -1, RGB(196, 196, 196)
  '------------------------------------------------------------------
  ' I like the old windows design better
  DwmSetWindowAttribute ghDlg, %DWMWA_NCRENDERING_POLICY, %DWMNCRP_DISABLED, 4
  '------------------------------------------------------------------
  CONTROL ADD LABEL, ghDlg,  %IDOK, "Click here and drag to target", 1, 1, 60, 20, %SS_CENTER OR %WS_DLGFRAME OR %SS_NOTIFY
  CONTROL SET COLOR  ghDlg,  %IDOK, -1, RGB(10, 175, 175)

  CONTROL ADD TEXTBOX, ghDlg, %IDC_TEXBOX1, "", 5, 25, 169, 60, _
                       %ES_MULTILINE, %WS_EX_CLIENTEDGE

  '------------------------------------------------------------------
  DIALOG SHOW MODELESS ghDlg, CALL DlgProc
  DO
    DIALOG DOEVENTS
  LOOP WHILE ISWIN(ghDlg)

END FUNCTION

'====================================================================
' Main dialog's callback procedure
'--------------------------------------------------------------------
CALLBACK FUNCTION DlgProc() AS LONG
  LOCAL hWnd, cId AS LONG, rc, rc2 AS RECT, _
        wStr AS WSTRING, wzStr AS WSTRINGZ * %MAX_PATH, _
        pt AS POINTAPI

  STATIC hTimer, iDraging, sthWnd AS LONG

  SELECT CASE CBMSG
     CASE %WM_INITDIALOG 'set topmost zorder on screen from start
        SetWindowPos CB.HNDL, %HWND_TOPMOST, 0, 0, 0, 0, _
                             %SWP_NOSIZE OR %SWP_NOMOVE

     CASE %WM_TIMER
        IF iDraging AND _  ' if left mouse button is released during action
          (GetAsyncKeyState(%VK_LBUTTON) AND &H8000) = 0 THEN
           KillTimer CB.HNDL, hTimer : hTimer = 0  ' clean up, refresh and exit
           ReleaseCapture
           MOUSEPTR 1 : DrawRect 0 : iDraging = 0 : sthWnd = 0
           CONTROL REDRAW CB.HNDL, %IDC_TEXBOX1
           EXIT FUNCTION
        END IF

        GetCursorPos pt            'grab cursor pos on screen
        hWnd = WindowFromPoint(pt) 'and look what window is under cursor

        IF hWnd AND hWnd <> sthWnd THEN 'if we got a handle
           sthWnd  = hWnd               'store it in a static variable
           DrawRect hWnd                'draw a rectangle around window under cursor
           '---------------------------------------------------------
           'collect and show some useful data abour the window under cursor
           GetClassName hWnd, wzStr, SIZEOF(wzStr) 'grab class name
           'z-order trick (fixes problem of not seeing inside FRAMES/TABs etc)
           IF UCASE$(wzStr) = "SYSTABCONTROL32" OR _
             (UCASE$(wzStr) = "BUTTON" AND (GetWindowLong(hWnd, %GWL_STYLE) AND %BS_GROUPBOX) = %BS_GROUPBOX) THEN
                 SetWindowPos hWnd, %HWND_BOTTOM, 0, 0, 0, 0, %SWP_NOSIZE OR %SWP_NOMOVE
                 hWnd = WindowFromPoint(Pt)
           END IF
           '---------------------------------------------------------
           cId = GetDlgCtrlID(hWnd)  'try to get id
           GetWindowRect hWnd, rc2   'get coordiantes on screen
           GetClientRect hWnd, rc    'get client size

           wStr = "Class:"   + $TAB + " " + wzStr + $CRLF + _
                  "hWnd:"    + $TAB + STR$(hWnd)   + "  (&H" + HEX$(hWnd) + ")" + $CRLF + _  ' build string
                  "Id:"      + $TAB + STR$(cId)    + $CRLF + _
                  "Rect:"    + $TAB + "(" + FORMAT$(rc2.nLeft) + ", " + FORMAT$(rc2.nTop) + ")-(" + _
                                            FORMAT$(rc2.Right) + ", " + FORMAT$(rc2.nBottom) + ") " + $CRLF + _
                  "Client:"  + $TAB + FORMAT$(rc.Right)  + "x"  + FORMAT$(rc.nBottom) + $CRLF + _
                  "Unicode:" + $TAB + FORMAT$(IsWindowUnicode(hWnd)) + $CRLF  'is it unicode?

           CONTROL SET TEXT CB.HNDL, %IDC_TEXBOX1, wStr
           '---------------------------------------------------------
        END IF

     CASE %WM_DESTROY  ' in case a timer is running at exit..
        IF hTimer THEN KillTimer CB.HNDL, hTimer

     CASE %WM_COMMAND
       SELECT CASE CB.CTL
       CASE %IDOK  'start timer action
          IF CB.CTLMSG = %STN_CLICKED THEN
             SetCapture CB.HNDL 'set capture to parent dialog
             iDraging = 1       'set static flag
             MOUSEPTR 2         'good enough mouse ptr
             hTimer = SetTimer(CB.HNDL, 1, 200, 0) 'start timer
          END IF

       CASE %IDCANCEL  'also responds to Esc key...
          IF CB.CTLMSG = %BN_CLICKED THEN
             DIALOG END CB.HNDL
          END IF
       END SELECT

  END SELECT
END FUNCTION

'====================================================================
' Draw a rectangle on screen around given window
'--------------------------------------------------------------------
SUB DrawRect(hWnd AS DWORD)
  LOCAL hDC, hBrush, hPen AS DWORD, rc AS RECT
  STATIC memDC, hBit AS DWORD

  hDC = GetWindowDC(GetDesktopWindow)   'get desktop DC
    GetWindowRect GetDesktopWindow, rc  'get desktop size
    IF memDC = 0 THEN  'if not yet done, grab and store a fresh copy of the desktop
       CONTROL SET TEXT ghDlg, %IDC_TEXBOX1, ""                       'clear Textbox
       memDC = CreateCompatibleDC(hDC)                                'create a memory DC
       hbit  = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
       hBit  = SelectObject (memDC, hBit)
       FillRect memDC, rc, GetStockObject(%WHITE_BRUSH)
       BitBlt memDC, 0, 0, rc.nRight, rc.nBottom, hDC, 0, 0, %SRCCOPY 'clean copy of screen to memDC
    ELSE
       RedrawWindow GetDesktopWindow, BYVAL %NULL, 0, %RDW_FRAME OR %RDW_ERASE OR %RDW_INVALIDATE OR %RDW_UPDATENOW
    END IF
    BitBlt hDC, 0, 0, rc.nRight, rc.nBottom, memDC, 0, 0, %SRCCOPY    'copy memDC to screen (wipe out previous rect)

    hPen   = CreatePen(%PS_SOLID, 4, %RED)                  'create a pen for given color (here red)
    hPen   = SelectObject(hDC, hPen)                        'select the new pen into the DC
    hBrush = SelectObject(hDC, GetStockObject(%NULL_BRUSH)) 'use stock null brush for hollow rect

    IF hWnd THEN                                            'draw a rectangle around given window
       GetWindowRect hWnd, rc                               'get coordinates on screen
       Rectangle hDC, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom 'draw the rectangle
    ELSE
       DeleteObject SelectObject(memDC, hBit)               'if no hWnd, delete what we created
       DeleteDC memDC                                       'to avoid GDI memory leaks
       memDC = 0
    END IF

    SelectObject hDC, hBrush  'return original brush, delete create pen and release DC
    DeleteObject SelectObject(hDC, hPen)
  ReleaseDC(GetDesktopWindow, hDC)
END SUB