Grid on top of desktop?

Hello, I'd like to create a grid of lines ( forming 9 fields) on top of all other visible windows ( on the desktop ). The purpose is to create a "mousegrid"-application to control my mouse pointer via a remote control by clicking 1-9 representing one of the fields. When a button on the remote is pressed, the selected field divides up in 9 new fields and thus I can control where to move the mouse while repeating the procedure. The big question though is how to draw the grid on top of the desktop covering everything else and still being able to see through the grid so I'll know where to move the mouse. Thanks!
Who is Participating?
Mike TomlinsonConnect With a Mentor Middle School Assistant TeacherCommented:
Hi foxeye,

Here is a completely different aproach to the problem...

I am drawing directly onto the desktop without a window via a handle to the desktop device context.  This completely eliminates the window transparency problem.  All lines are drawn with an inverse pen using lightining fast API calls.  The lines can then be erased (consequently restoring what was under them previously) by simply redrawing the same lines again.

Since I don't have a remote, I have used Hotkeys to simulate one.  The app is driven using the number pad in conjuction with the Ctrl and Alt keys.

|  7 | 8 | 9  |    NumPad7 corresponds to the upper left grid onscreen
|  4 | 5 | 6  |
|  1 | 2 | 3  |    NumPad3 corresonds to the lower right grid onscreen.
|  0       |

Pressing Ctrl-NumPad0 causes the process to start or cancels a current selection in progress.

Pressing Ctrl-NumPad1 thru Ctrl-NumPad9 causes the current onscreen grid to be erased and a new smaller grid to be drawn at the selected region.

When the small center square of a region is over what you want to click on, hold down the Alt key and press the numpad key corresponding to the desired region.

Remember that the other apps and the mouse are still active during the selection process.  If anything draws itself over one of your grids lines, it will not erase properly.

If this is unacceptable, then you can take a screenshot of the desktop and display it on a borderless fullscreen form with the mouse hidden.  Then you will be drawing over a picture of the desktop via your form.  You can then simply close the form before sending the click message.

If you like the behaviour of this app you can make it minmize to the tray so you don't have a window to deal with (let me know if you need help with that as well).  You can either incorporate this code and logic into your remote control app or somehow make your remote control press the hotkeys.

At any rate, this should give you a good idea of how what you want can be accomplished.



Create a new project and add a module.  Paste the code below into the appropriate areas as labeled.  The main form simply registers/unregisters the hotkeys and sets up the subclassing.  All the hard work is done in the module.

Remember, since subclassing is involved to trap the hotkeys, ALWAYS close the application via the close button on the form.  Pressing the stop button in the IDE will cause the app to crash.

' ----------------------------------------------------------------------------------------------
'  Form1
' ----------------------------------------------------------------------------------------------
Option Explicit

Private ctrl_0 As Boolean
Private ctrl_1 As Boolean, ctrl_2 As Boolean, ctrl_3 As Boolean
Private ctrl_4 As Boolean, ctrl_5 As Boolean, ctrl_6 As Boolean
Private ctrl_7 As Boolean, ctrl_8 As Boolean, ctrl_9 As Boolean
Private alt_1 As Boolean, alt_2 As Boolean, alt_3 As Boolean
Private alt_4 As Boolean, alt_5 As Boolean, alt_6 As Boolean
Private alt_7 As Boolean, alt_8 As Boolean, alt_9 As Boolean

Private Sub Form_Load()
    capturing = False
    desktopDC = GetWindowDC(GetDesktopWindow())
    ctrl_0 = RegisterHotKey(hwnd, 0, MOD_CONTROL, vbKeyNumpad0)
    ctrl_1 = RegisterHotKey(hwnd, 1, MOD_CONTROL, vbKeyNumpad1)
    ctrl_2 = RegisterHotKey(hwnd, 2, MOD_CONTROL, vbKeyNumpad2)
    ctrl_3 = RegisterHotKey(hwnd, 3, MOD_CONTROL, vbKeyNumpad3)
    ctrl_4 = RegisterHotKey(hwnd, 4, MOD_CONTROL, vbKeyNumpad4)
    ctrl_5 = RegisterHotKey(hwnd, 5, MOD_CONTROL, vbKeyNumpad5)
    ctrl_6 = RegisterHotKey(hwnd, 6, MOD_CONTROL, vbKeyNumpad6)
    ctrl_7 = RegisterHotKey(hwnd, 7, MOD_CONTROL, vbKeyNumpad7)
    ctrl_8 = RegisterHotKey(hwnd, 8, MOD_CONTROL, vbKeyNumpad8)
    ctrl_9 = RegisterHotKey(hwnd, 9, MOD_CONTROL, vbKeyNumpad9)
    alt_1 = RegisterHotKey(hwnd, 10, MOD_ALT, vbKeyNumpad1)
    alt_2 = RegisterHotKey(hwnd, 20, MOD_ALT, vbKeyNumpad2)
    alt_3 = RegisterHotKey(hwnd, 30, MOD_ALT, vbKeyNumpad3)
    alt_4 = RegisterHotKey(hwnd, 40, MOD_ALT, vbKeyNumpad4)
    alt_5 = RegisterHotKey(hwnd, 50, MOD_ALT, vbKeyNumpad5)
    alt_6 = RegisterHotKey(hwnd, 60, MOD_ALT, vbKeyNumpad6)
    alt_7 = RegisterHotKey(hwnd, 70, MOD_ALT, vbKeyNumpad7)
    alt_8 = RegisterHotKey(hwnd, 80, MOD_ALT, vbKeyNumpad8)
    alt_9 = RegisterHotKey(hwnd, 90, MOD_ALT, vbKeyNumpad9)
    SubClass Me.hwnd
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If capturing Then
    End If
    UnSubClass Me.hwnd
    If ctrl_0 Then Call UnregisterHotKey(hwnd, 0)
    If ctrl_1 Then Call UnregisterHotKey(hwnd, 1)
    If ctrl_2 Then Call UnregisterHotKey(hwnd, 2)
    If ctrl_3 Then Call UnregisterHotKey(hwnd, 3)
    If ctrl_4 Then Call UnregisterHotKey(hwnd, 4)
    If ctrl_5 Then Call UnregisterHotKey(hwnd, 5)
    If ctrl_6 Then Call UnregisterHotKey(hwnd, 6)
    If ctrl_7 Then Call UnregisterHotKey(hwnd, 7)
    If ctrl_8 Then Call UnregisterHotKey(hwnd, 8)
    If ctrl_9 Then Call UnregisterHotKey(hwnd, 9)
    If alt_1 Then Call UnregisterHotKey(hwnd, 10)
    If alt_2 Then Call UnregisterHotKey(hwnd, 20)
    If alt_3 Then Call UnregisterHotKey(hwnd, 30)
    If alt_4 Then Call UnregisterHotKey(hwnd, 40)
    If alt_5 Then Call UnregisterHotKey(hwnd, 50)
    If alt_6 Then Call UnregisterHotKey(hwnd, 60)
    If alt_7 Then Call UnregisterHotKey(hwnd, 70)
    If alt_8 Then Call UnregisterHotKey(hwnd, 80)
    If alt_9 Then Call UnregisterHotKey(hwnd, 90)
End Sub

' ----------------------------------------------------------------------------------------------
'  Module1
' ----------------------------------------------------------------------------------------------
' API Heaven...
Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle&, ByVal nWidth&, ByVal crColor&) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Public Declare Function Rectangle Lib "gdi32" (ByVal hdc&, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Public Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Const SW_NORMAL = 1
Public Const GWL_WNDPROC = -4
Public Const WM_HOTKEY = &H312
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const NULLBRUSH = 5

Public desktopDC As Long
Public lpPrevWndProc As Long
Public capturing As Boolean
Public boxDrawn As Boolean
Public currentRegion As Rect
Public gridWidth As Single
Public gridHeight As Single

Public Sub SubClass(ByVal hwnd As Long)
    lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnSubClass(ByVal hwnd As Long)
    Dim lngReturnValue As Long
    If lpPrevWndProc Then _
        Call SetWindowLong(hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hwnd As Long, _
                    ByVal uMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long) As Long
    If uMsg = WM_HOTKEY Then
        Select Case wParam
            Case 0 ' start the process or cancel it
                capturing = Not capturing
                If capturing Then
                    currentRegion.Top = 0
                    currentRegion.Left = 0
                    currentRegion.Bottom = Form1.ScaleY(Screen.Height, vbTwips, vbPixels)
                    currentRegion.Right = Form1.ScaleX(Screen.Width, vbTwips, vbPixels)
                End If
            Case 1 To 9 ' select a new grid
                If capturing Then
                    selectGrid wParam
                End If
            Case 10 To 90 ' click on a grid
                If capturing Then
                    clickGrid wParam / 10
                End If
        End Select
    End If
    WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End Function

Public Sub DrawGrid()
    Dim blackPen As Long, hOldPen As Long, hOldBrush As Long
    Dim x As Single
    Dim y As Single
    Const NULL_BRUSH = 5
    Const R2_NOT = 6
    gridWidth = (currentRegion.Right - currentRegion.Left + 1#) / 3#
    gridHeight = (currentRegion.Bottom - currentRegion.Top + 1#) / 3#
    ' Create an inverse pen
    SetROP2 desktopDC, R2_NOT
    blackPen = CreatePen(0, 1, 0)

    ' Draw the  Grid
    hOldPen = SelectObject(desktopDC, blackPen)
    hOldBrush = SelectObject(desktopDC, GetStockObject(NULL_BRUSH))
    For x = 0 To 2
        For y = 0 To 2
            ' main grid
            Rectangle desktopDC, _
                currentRegion.Left + (x * gridWidth), _
                currentRegion.Top + (y * gridHeight), _
                currentRegion.Left + ((x + 1#) * gridWidth), _
                currentRegion.Top + ((y + 1#) * gridHeight)
            ' center point
            Rectangle desktopDC, _
                currentRegion.Left + (x * gridWidth) + (gridWidth / 2) - 2, _
                currentRegion.Top + (y * gridHeight) + (gridHeight / 2) - 2, _
                currentRegion.Left + (x * gridWidth) + (gridWidth / 2) + 2, _
                currentRegion.Top + (y * gridHeight) + (gridHeight / 2) + 2
        Next y
    Next x
    ' put the old objects back and clean up
    SelectObject desktopDC, hOldBrush
    SelectObject desktopDC, hOldPen
    DeleteObject blackPen
End Sub

Private Sub calculateNewRegion(ByVal grid As Long)
    Select Case grid
        Case 7, 4, 1 ' left column
            ' left edge stays the same
        Case 8, 5, 2 ' middle column
            currentRegion.Left = currentRegion.Left + gridWidth
        Case 9, 6, 3 ' right column
            currentRegion.Left = currentRegion.Left + (gridWidth * 2#)
    End Select
    currentRegion.Right = currentRegion.Left + gridWidth
    Select Case grid
        Case 7, 8, 9 ' top row
            ' top edge stays the same
        Case 4, 5, 6 ' middle row
            currentRegion.Top = currentRegion.Top + gridHeight
        Case 1, 2, 3 ' bottom row
            currentRegion.Top = currentRegion.Top + (gridHeight * 2#)
    End Select
    currentRegion.Bottom = currentRegion.Top + gridHeight
End Sub

Private Sub selectGrid(ByVal grid As Long)
    If gridWidth > 5 And gridHeight > 5 Then
        ' erase current grid
        'setup new region
        calculateNewRegion grid
        gridWidth = (currentRegion.Right - currentRegion.Left + 1#) / 3#
        gridHeight = (currentRegion.Bottom - currentRegion.Top + 1#) / 3#
        ' draw new grid
    End If
End Sub

Private Sub clickGrid(ByVal grid As Long)
    Dim x As Single
    Dim y As Single
    ' erase currentgrid
    ' turn off capturing
    capturing = False
    ' calculate new region
    ' and point to click
    calculateNewRegion grid
    x = (currentRegion.Left + currentRegion.Right) / 2#
    y = (currentRegion.Top + currentRegion.Bottom) / 2#
    ' click the center of the selected grid
    Call SetCursorPos(x, y)
    'mouse_event MOUSEEVENTF_LEFTDOWN, x, y, 0, 0
    'mouse_event MOUSEEVENTF_LEFTUP, x, y, 0, 0
End Sub
See through is one problem (althoug this version has some bugs):

Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_TRANSPARENT = &H20&
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_NOTOPMOST = -2  
Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter _
As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long  

SetWindowLong Me.hwnd, GWL_EXSTYLE, _
SetWindowPos Me.hwnd, HWND_NOTOPMOST, _
0&, 0&, 0&, 0&, SWP_SHOWME

BUT: although you can SEE through the form, you can't CLICK anything that's below.
I think you task won't be easy (if not impossible), but I'm interested on how it goes on...
I guess you want a system modal application like Task Manager, am I right?
Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

You need 3 things
1) semi tansparency
2) System modality (to not let window got lost in background)
3) Some complex Window hooking mechanism may be.. but not sure.
For semitranparency use function below alpha can be between 0 and 255

Public Function AdjustWindowStyle(ByVal hwnd As Long, Optional alpha As Long)

    Dim style As Long
    If NoTrans Then Exit Function
    'in order to have transparent windows, the
    'WS_EX_LAYERED window style must be applied
    'to the form
    style = GetWindowLong(hwnd, GWL_EXSTYLE)
    If Not (style And WS_EX_LAYERED = WS_EX_LAYERED) Then
        style = style Or WS_EX_LAYERED
        SetWindowLong hwnd, GWL_EXSTYLE, style
    End If
    SetLayeredWindowAttributes hwnd, 0&, alpha, LWA_ALPHA
End Function

Private Declare Function SetLayeredWindowAttributes Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal crKey As Long, _
   ByVal bAlpha As Long, _
   ByVal dwFlags As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA As Long = &H2
Private Const WS_EX_LAYERED As Long = &H80000
foxeyeAuthor Commented:
Yes, well, this is kind of what Im looking for... although not quite. One possible solution could be to make the forms backcolor transparent. If that's possible then problem solved. It doesn't matter whether I can click it or not. That can be solved with another application, like if I just set the mousecursor in the right position, exit the grid-application and trigger the click-application. This can be done with the remote-control program.
foxeyeAuthor Commented:
Excellent! Exactly what I was looking for. Top notch!!
Mike TomlinsonMiddle School Assistant TeacherCommented:

I have discovered a quirk in my solution that I cannot explain or solve as of yet.

I have posted a question that hopefully will result in a fix:


Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.