Demo of methods to keep a QB64 window active

[Pete]

Code: (Select All)

Rem Credit to SpriggsySpriggs for the mask/restore mouse WinAPI subroutines and thanks to Unseen Machine for researching the possibilities.

title$ = "Pesistency Demo - "

_Title title$ + "Normal Window"

Const HWND_TOPMOST%& = -1

Const HWND_BOTTOM%& = -2

Const SWP_NOSIZE%& = &H1

Const SWP_NOMOVE%& = &H2

Const SWP_SHOWWINDOW%& = &H40

Type POINTAPI

    X_Pos As Long

    Y_Pos As Long

End Type

Dim WinMse As POINTAPI

Declare Dynamic Library "User32"

    Function ShowWindow%& (ByVal hwnd As _Offset, ByVal nCmdShow As Long)

    Function SetWindowPos%& (ByVal hWnd As Long, ByVal hWndInsertAfter As _Offset, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal uFlags As _Offset)

    Function GetForegroundWindow%&

    Function GetCursorPos (lpPoint As POINTAPI)

    Function SetCursorPos%& (ByVal wx As Integer, ByVal wy As Integer)

    Function ShowCursor& (ByVal bShow As Long)

    Function CreateCursor%& (ByVal hInst As _Offset, ByVal xHotSpot As Long, ByVal yHotSpot As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal pvANDPlane As _Offset, ByVal pvXORPlane As _Offset)

    Function SetSystemCursor& (ByVal hcur As _Offset, ByVal id As Long)

    Function SystemParametersInfo& Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As _Offset, ByVal fuWinIni As Long)

End Declare

Const OCR_NORMAL = 32512

Const SPI_SETCURSORS = 87

Const SPIF_SENDCHANGE = 2

Dim Shared CursorIDs(4) As Long ' Array of Cursor IDs to hide (Arrow, IBeam, Hand, Wait, etc.)

CursorIDs(0) = 32512 ' Standard Arrow

CursorIDs(1) = 32513 ' I-Beam (Text Select)

CursorIDs(2) = 32649 ' Hand Link

CursorIDs(3) = 32514 ' Hourglass/Wait

CursorIDs(4) = 32648 ' "No" symbol

Dim Shared AndMask(32) As Long ' Bitmasks for a 32x32 transparent cursor.

Dim Shared XorMask(32) As Long

For i = 0 To 32 ' Initialize mask: AND=All 1s, XOR=All 0s results in transparency.

    AndMask(i) = &HFFFFFFFF

    XorMask(i) = 0

Next i



Print "Press F1 for normal window."

Print "Press F2 to have window keep focus but not always active."

Print "Press F3 to keep window active using min/restore."

Print "Press F4 to keep window active and always visible."

View Print 7 To _Height

Print "Type characters or mouse click here: ";



pOptions = 0 ' 0 to release focus. 1 to keep focus. 2 to keep window active and in focus.

Do

    _Limit 60

    While _MouseInput: Wend

    If lb And _MouseButton(1) = 0 Then Print "Left Mouse Click..."

    lb = _MouseButton(1)

    b$ = InKey$

    Select Case Len(b$)

        Case 1 ' Let's type some characters to the screen.

            If b$ = Chr$(27) Then System

            Print b$;

        Case 2

            Select Case Mid$(b$, 2, 1)

                Case Chr$(59): pOptions = 0 ' F1 - Lose focus

                    _Title title$ + "Normal Window"

                Case Chr$(60): pOptions = 1 ' F2 - Maintain focus.

                    _Title title$ + "Window Keeps Focus"

                Case Chr$(61): pOptions = 2 ' F3 - Maintain focus and remain active using min/max.

                    _Title title$ + "Window Remains Active Method 1"

                Case Chr$(62): pOptions = 3 ' F4 - Maintain focus and remain active using _ScreenClick.

                    _Title title$ + "Window Remains Active Method 2"

            End Select

    End Select

    persistency pOptions, WinMse ' Manipulte window active / focus.

Loop



Sub persistency (pOptions, winmse As POINTAPI)

    Static hwnd As Long, switch, oldpOptions, y%&

    If oldpOptions <> pOptions Then switch = 0 ' Reset switch when changing persistency value.

    If pOptions = 0 Then

        If y%& Then

            y%& = SetWindowPos%&(hwnd, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_SHOWWINDOW)

            y%& = 0

        End If

        Exit Sub

    End If

    If hwnd = 0 Then hwnd = _WindowHandle

    fgwin%& = GetForegroundWindow%&

    If fgwin%& <> hwnd Then

        If switch = 0 Then

            y%& = SetWindowPos%&(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_SHOWWINDOW)

            switch = 1 ' Prevents the routine from constantly running until needed.

            If pOptions = 2 Then ' Min/Max method.

                y%& = ShowWindow%&(hwnd&, 0)

                y%& = ShowWindow%&(hwnd&, 2)

                y%& = ShowWindow%&(hwnd&, 9)

            ElseIf pOptions = 3 Then ' _ScreenClick Method.

                z& = GetCursorPos(winmse): wy = winmse.Y_Pos: wx = winmse.X_Pos

                cRow = _ScreenY + 20: cCol = _ScreenX + 100 ' Finds a good place to click on the title bar.

                GoSub HideGlobalCursor

                _Delay .2 ' Delay needed for racing issues. If the activation gets missed, this is the problem.

                _ScreenClick cCol, cRow ' Clicks the title bar to restore active focus.

                Rem  _MouseMove _Width \ 2, _Height \ 2 ' Move mouse pointer to the center of the QB64 window.

                y%& = SetCursorPos%&(wx, wy) ' Return mouse pointer.

                GoSub RestoreGlobalCursor

            End If

        End If

    Else

        If switch Then switch = 0 ' Resets the switch when focus is returned.

    End If

    oldpOptions = pOptions

    Exit Sub



    ' Subroutines provided by SpriggsySpriggs

    HideGlobalCursor: ' Subroutine to replace system cursors with transparent one.

    For i = 0 To 4

        ' 1. Create a transparent cursor in memory

        ' We must recreate it for every SetSystemCursor call because

        ' SetSystemCursor destroys the handle it receives.

        hTrim%& = CreateCursor%&(0, 0, 0, 32, 32, _Offset(AndMask(0)), _Offset(XorMask(0)))

        ' 2. Replace the system cursor

        res& = SetSystemCursor&(hTrim%&, CursorIDs(i))

    Next i

    Return



    RestoreGlobalCursor: ' Subroutine to reset system cursors to Windows defaults

    ' SPI_SETCURSORS with 0 params reloads system cursors from registry

    res& = SystemParametersInfo&(SPI_SETCURSORS, 0, 0, SPIF_SENDCHANGE)

    Return

End Sub

Read the remarks. 4 variations. It starts with a normal window that runs behind any other open window you click on like the IDE. Now press F2 and try it again. The window stays persistent, meanin it remains over the window you clicked. Now try F3. It quickly minimizes and returns our QB ap, which returns it to focus. Now my favorite, F4. It uses _SCREENCLICK to reactivate itself, and appears like it never lost active focus at all. The mouse pointer is quickly returned to the original off-ap position on yuor desktop! Note that with F3 and F3 allows us to continuously type to the app since clicking out of it won't steal the active focus.

Issues: Racing can be a problem and is remarked in the code. That's why a delay was needed. Racing is a common problem with mixing QB code with WinAPI.

If you want to use this in a program, just copy and the persistency sub along with the constants at the top and Declare Library. Set the pOptions variable to 1, 2, 3, or 4.

@PhilOfPerth - If you ever come up with something better, let me (us) know. Unfortunately you can beat your brains against the wall trying SetActiveWindow and the get absolutely nowhere... except if you beat enough grey matter out, it could land you a promising position at MicroSoft.

Pete

[PhilOfPerth]

Code: (Select All)

title$ = "Pesistency Demo - "

_Title title$ + "Normal Window"

Const HWND_TOPMOST%& = -1

Const HWND_BOTTOM%& = -2

Const SWP_NOSIZE%& = &H1

Const SWP_NOMOVE%& = &H2

Const SWP_SHOWWINDOW%& = &H40

Declare Dynamic Library "User32"

    Function ShowWindow%& (ByVal hwnd As _Offset, ByVal nCmdShow As Long)

    Function SetWindowPos%& (ByVal hWnd As Long, ByVal hWndInsertAfter As _Offset, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal uFlags As _Offset)

    Function GetForegroundWindow%&

End Declare

pOptions = 0 ' 0 to release focus. 1 to keep focus. 2 to keep window active and in focus.

Do

    _Limit 60

    While _MouseInput: Wend

    If lb And _MouseButton(1) = 0 Then Print "Left Mouse Click..."

    lb = _MouseButton(1)

    b$ = InKey$

    Select Case Len(b$)

        Case 1 ' Let's type some characters to the screen.

            Print b$;

        Case 2

            Select Case Mid$(b$, 2, 1)

                Case Chr$(59): pOptions = 0 ' F1 - Lose focus

                    _Title title$ + "Normal Window"

                Case Chr$(60): pOptions = 1 ' F2 - Maintain focus.

                    _Title title$ + "Window Keeps Focus"

                Case Chr$(61): pOptions = 2 ' F3 - Maintain focus and remain active using min/max.

                    _Title title$ + "Window Remains Active Method 1"

                Case Chr$(62): pOptions = 3 ' F4 - Maintain focus and remain active using _ScreenClick.

                    _Title title$ + "Window Remains Active Method 2"

            End Select

    End Select

    persistency pOptions ' Manipulte window active / focus.

Loop



Sub persistency (pOptions)

    Static hwnd As Long, switch, oldpOptions, y%&

    If oldpOptions <> pOptions Then switch = 0 ' Reset switch when changing persistency value.

    If pOptions = 0 Then

        If y%& Then

            y%& = SetWindowPos%&(hwnd, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_SHOWWINDOW)

            y%& = 0

        End If

        Exit Sub

    End If

    If hwnd = 0 Then hwnd = _WindowHandle

    fgwin%& = GetForegroundWindow%&

    Rem _Title Str$(fgwin%&) + "  " + Str$(hwnd)

    If fgwin%& <> hwnd Then

        If switch = 0 Then

            y%& = SetWindowPos%&(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_SHOWWINDOW)

            switch = 1 ' Prevents the routine from constantly running until needed.

            If pOptions = 2 Then ' Min/Max method.

                y%& = ShowWindow%&(hwnd&, 0)

                y%& = ShowWindow%&(hwnd&, 2)

                y%& = ShowWindow%&(hwnd&, 9)

            ElseIf pOptions = 3 Then ' _ScreenClick Method.

                cRow = _ScreenY + 20: cCol = _ScreenX + 100 ' Finds a good place to click on the title bar.

                _Delay .2 ' Delay needed for racing issues. If the activation gets missed, this is the problem.

                _ScreenClick cCol, cRow ' Clicks the title bar to restore active focus.

                _MouseMove _Width \ 2, _Height \ 2 ' Move mouse pointer to the center of the QB64 window.

            End If

        End If

    Else

        If switch Then switch = 0 ' Resets the switch when focus is returned.

    End If

    oldpOptions = pOptions

End Sub

Read the remarks. 4 variations. It starts with a normal window that runs behind any other open window you click, like the IDE. Now press F2 and try it again. The window stays persistent over the clicked window. F3 it quickly minimizes and returns, which returns focus. F4 and it uses _SCREENCLICK to reactivate itself, and appears like it never lost active focus. With the F3 and F4 options, you can continuously type to the app., as clicking out of it won't steal the active nature of the qb64 app window.

Issues: Racing can be a problem and is remarked in the code. That's why a delay was needed. Racing is a common problem with mixing QB code with WinAPI.

If you want to use this in a program, just copy and the persistency sub along with the constants at the top and Declare Library. Set the pOptions variable to 1, 2, 3, or 4.

@PhilOfPerth - If you ever come up with something better, let me (us) know. Unfortunately you can beat your brains against the wall trying SetActiveWindow and the get absolutely nowhere... except if you beat enough grey matter out, it could land you a promising position at MicroSoft.

Pete

Thanks Pete. luckily my brain is so small that  impact with a wall has no effect! 
This is obviously not better, but much simpler, and it does what I intended., and nothing exploded.
Whadya reckon?

Code: (Select All)

SW = 800: sh = 600
Screen _NewImage(SW, sh, 32)
Common Shared CPL
SetFont: f& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace")
_Font f&
SMode = 32
Screen _NewImage(SW, sh, 32)
_ScreenMove (_DesktopWidth - SW) / 2, 90 '                                 centre window horizontally

Print "Press ESC to exit"
'                                                                          now move mouse inside window
Do
    Do While _MouseInput
        mx = _MouseX
        my = _MouseY

        If mx < 0 Then mx = 0 '                                           limit x
        If mx > SW Then mx = SW

        If my < 1 Then my = 1 '                                           limit y
        If my > sh Then my = sh
        _MouseMove mx, my
    Loop
    PSet (mx, my) '                                                       mark mouse position
Loop Until InKey$ = Chr$(27) '                                            Escape key to exit
System

[SMcNeill]

@Pete See how this works for you:

Code: (Select All)

' ============================

'  QB64-PE Force Foreground Window

'  Using AttachThreadInput Trick

' ============================



Declare Dynamic Library "user32"

    Function GetForegroundWindow& ()

    Function GetWindowThreadProcessId& (ByVal hWnd As Long, ByVal lpdwProcessId As _Offset)

    Function AttachThreadInput& (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long)

    Function SetForegroundWindow& (ByVal hWnd As Long)

    Function BringWindowToTop& (ByVal hWnd As Long)

End Declare



Declare Dynamic Library "kernel32"

    Function GetCurrentThreadId& ()

End Declare



' ----------------------------

'  Find the target window

' ----------------------------

targetTitle$ = "Untitled - Notepad" ' Change this to your window title

hTarget& = _WindowHandle

Do

    If _WindowHasFocus = 0 Then

        ' ----------------------------

        '  Get thread IDs

        ' ----------------------------

        hForeground& = GetForegroundWindow

        fgThread& = GetWindowThreadProcessId(hForeground&, 0)

        myThread& = GetCurrentThreadId



        ' ----------------------------

        '  Attach input queues

        ' ----------------------------

        result1& = AttachThreadInput(myThread&, fgThread&, 1)



        ' ----------------------------

        '  Try to force activation

        ' ----------------------------

        result2& = BringWindowToTop(hTarget&)

        result3& = SetForegroundWindow(hTarget&)



        ' ----------------------------

        '  Detach input queues

        ' ----------------------------

        result4& = AttachThreadInput(myThread&, fgThread&, 0)



        Print "Attempted to activate window."

        _Delay .1 'give it time to swap focus before trying again

    End If

    _Limit 30

Loop

This will attach an input to the proper thread here, always allowing the SetForeGroundWindow to work. I've tested it on my Windows 11 machine here and it seems to always work as intended, without any endless blinking of the taskbar icon.

It's not the most simplest of process flows to understand, but basically what you'd want is everything inside that IF _Window?HasFocus = 0 Then segment. Just copy/paste that, and the Declare Library declarations, into your own code somewhere and you should be golden.

Note that without that _Delay 0.1 at the bottom, it sometimes seems to loop back and poll the active window a second time, before the system has registered the change, so you'll see it run the process to restore control run twice. With that small delay, I get one click, one PRINT to the screen. Without it, I sometimes get one click, two PRINTS to the screen. Either way, it seems to work; it's just without the _DELAY it seems to force itself to run the same process twice, when the second time seems unnecessary and was just the system not updating values properly. In a more complicated program, where you're doing other stuff between this check, that _Delay may not be necessary. After all, if your code takes more than .1 second per loop normally, then that short delay would've already passed before it came back around and ran again.

(And .1 may not be the smallest delay suitable; it was just the first I tried and it worked, and that was good enough for me. You might get by with a 0.001 delay or something incredibly tiny and non-noticeable. Just thought I'd point out what it was in there for, and that it may not be needed, or may not need to be as large.)

[Pete]

@SMcNeill

Works! Now we're having fun...

Yes, delays are necessary with many WinAPI functions. Now here is some stuff I tested. Open Notepad, click 'file' and even though your code keeps focus, the popup file menu goes to the top. No biggie, just an interesting difference.

Oh, I edited mine to continue on a bit. Now F4 puts the cursor back to the original off-QB window position. It's pretty neat. It makes it seem like nothing happened, but the QB window always remains active!

Pete

[Pete]

Okay, I edited the initial post with a demo post that includes 4 different window methods.

1) Normal.
2) Maintains Focus.
3) Remains active with min/restore.
4) Remains active and stays on screen. Special thanks to @SpriggsySpriggs for the hide WinAPI mouse subroutines.

Pete: https://qb64phoenix.com/forum/showthread.php?tid=4230