Solved

VB6 make other app stay on top

Posted on 2011-03-25
8
696 Views
Last Modified: 2012-05-11
Hi

I was wondering if there is a way to make other applications to stay on top,
this is my code:

Dim consolewindowclass As Long

consolewindowclass = FindWindow("consolewindowclass", vbNullString)
Call StayOnTop(consolewindowclass, False)

I am trying is this case to keep CMD always ontop

Thanks
0
Comment
Question by:C0ding
  • 4
  • 3
8 Comments
 
LVL 16

Expert Comment

by:HooKooDooKu
ID: 35220634
The biggest problem is going to be finding  (for sure) the correct window that you want on top.  If you can get a window handle to that window, you could send it a message telling it to be topmost.

But perhaps a better option would be to change the z-order of the VB application instead.
0
 
LVL 11

Expert Comment

by:kbirecki
ID: 35221764
HooKooDooKu is correct that you need to have a good way to determine the unizue other app you want to control.  I do this frequently, but I know my apps are unique that I am setting to be on top by the name in the title bar.  So here is how I do it.

I have a module called "basWindowMgmt": (I don't remember where I got it, but you'll find this all over the Internet.)
<code>
Option Explicit

Declare Function SetFocusAPI Lib "user32" Alias "SetForegroundWindow" _
   (ByVal hWnd As Long) As Long
Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, _
 ByVal wCmd As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowLW Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
 (ByVal hWnd As Long, ByVal lpClassName As String, _
  ByVal nMaxCount As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
 (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) _
  As Long
Declare Function GetWindowPlacement Lib "user32" _
    (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function SetForegroundWindow Lib "user32" _
    (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" _
    (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Public Declare Function WaitForSingleObject Lib "kernel32" _
   (ByVal hHandle As Long, _
   ByVal dwMilliseconds As Long) As Long
Public Declare Function PostMessage Lib "user32" _
   Alias "PostMessageA" _
   (ByVal hWnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long

Public Declare Function IsWindow Lib "user32" _
   (ByVal hWnd As Long) As Long

Public 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

'For disabling the Minimize and Maximize buttons on a window
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 GetWindowLong Lib "user32" Alias _
          "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
          As Long
Public Const WS_MINIMIZEBOX = -131073   '&H20000
Public Const WS_MAXIMIZEBOX = -65537    '&H10000
'Defined below - Public Const GWL_STYLE = (-16)
   
   
Private lpwndpl   As WINDOWPLACEMENT

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

Private Type WINDOWPLACEMENT
    Length           As Long
    FLAGS            As Long
    showCmd          As Long
    ptMinPosition    As POINTAPI
    ptMaxPosition    As POINTAPI
    rcNormalPosition As RECT
End Type

Private Const GWL_ID = (-12)
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Public Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const GWL_HWNDPARENT = (-8)
Private Const WM_COMMAND = &H111
Private Const MIN_ALL = 419
Private Const MIN_ALL_UNDO = 416
Private Const MAX_PATH = 260
Private Const SW_SHOW = 5
Private Const SW_RESTORE = 9
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWNORMAL = 1

'Constants used by the API functions
Public Const WM_CLOSE = &H10
Public Const INFINITE = &HFFFFFFFF

'FindWindowLike
' - Finds the window handles of the windows matching the specified
'   parameters
'
'hwndArray()
' - An integer array used to return the window handles
'
'hWndStart
' - The handle of the window to search under.
' - The routine searches through all of this window's children and their
'   children recursively.
' - If hWndStart = 0 then the routine searches through all windows.
'
'WindowText
' - The pattern used with the Like operator to compare window's text.
'
'ClassName
' - The pattern used with the Like operator to compare window's class
'   name.
'
'ID
' - A child ID number used to identify a window.
' - Can be a decimal number or a hex string.
' - Prefix hex strings with "&H" or an error will occur.
' - To ignore the ID pass the Visual Basic Null function.
'
'Returns
' - The number of windows that matched the parameters.
' - Also returns the window handles in hWndArray()
'
'----------------------------------------------------------------------
'Remove this next line to use the strong-typed declarations
#Const WinVar = True
#If WinVar Then
    Function FindWindowLike(hWndArray() As Variant, _
     ByVal hWndStart As Variant, WindowText As String, _
      Classname As String, _
      ID) As Integer
        ' Comments  :
        ' Parameters: hWndArray()
        '             hWndStart
        '             WindowText
        '             Classname
        '             ID -
        ' Returns   : Integer -
        ' Modified  :
        '
        ' --------------------------------------------------

       
        Dim hWnd
        Dim r
        Static level
        Static iFound
#ElseIf Win32 Then
    Function FindWindowLike(hWndArray() As Long, ByVal hWndStart As Long, _
     WindowText As String, Classname As String, ID) As Long
        Dim hWnd As Long
        Dim r As Long
        ' Hold the level of recursion:
        Static level As Long
        ' Hold the number of matching windows:
        Static iFound As Long
#ElseIf Win16 Then
    Function FindWindowLike(hWndArray() As Integer, _
     ByVal hWndStart As Integer, WindowText As String, _
     Classname As String, ID) As Integer
        Dim hWnd As Integer
        Dim r As Integer
        ' Hold the level of recursion:
        Static level As Integer
        'Hold the number of matching windows:
        Static iFound As Integer
#End If
Dim sWindowText As String
Dim sClassname As String
Dim sID
' Initialize if necessary:
If level = 0 Then
    iFound = 0
    ReDim hWndArray(0 To 0)
    If hWndStart = 0 Then
        hWndStart = GetDesktopWindow()
    End If
End If
' Increase recursion counter:
level = level + 1
' Get first child window:
hWnd = GetWindow(hWndStart, GW_CHILD)
Do Until hWnd = 0
    DoEvents ' Not necessary
    ' Search children by recursion:
    r = FindWindowLike(hWndArray(), hWnd, WindowText, Classname, ID)
    ' Get the window text and class name:
    sWindowText = Space(255)
    r = GetWindowText(hWnd, sWindowText, 255)
    sWindowText = Left(sWindowText, r)
    'Debug.Print sWindowText
    sClassname = Space(255)
    r = GetClassName(hWnd, sClassname, 255)
    sClassname = Left(sClassname, r)
   
    'DEBUG CODE:
    'MsgBox sWindowText & " / " & sClassname
   
    ' If window is a child get the ID:
    If GetParent(hWnd) <> 0 Then
        r = GetWindowLW(hWnd, GWL_ID)
        sID = CLng("&H" & Hex(r))
    Else
        sID = Null
    End If
    ' Check that window matches the search parameters:
    If sWindowText Like WindowText And sClassname Like Classname Then
        If IsNull(ID) Then
            ' If find a match, increment counter and
            '  add handle to array:
            iFound = iFound + 1
            ReDim Preserve hWndArray(0 To iFound)
            hWndArray(iFound) = hWnd
        ElseIf Not IsNull(sID) Then
            If CLng(sID) = CLng(ID) Then
                ' If find a match increment counter and
                '  add handle to array:
                iFound = iFound + 1
                ReDim Preserve hWndArray(0 To iFound)
                hWndArray(iFound) = hWnd
            End If
        End If
        'Debug.Print "Window Found: "
        'Debug.Print "  Window Text  : " & sWindowText
        'Debug.Print "  Window Class : " & sClassname
        'Debug.Print "  Window Handle: " & CStr(hwnd)
        'MOD: 3/14/03/KB - Added stmt to jump out of loop when window is found
        Exit Do
        'ENDMOD: 3/14/03/KB
    End If
    ' Get next child window:
    hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop
' Decrement recursion counter:
level = level - 1
' Return the number of windows found:
FindWindowLike = iFound

PROC_EXIT:
    Exit Function

PROC_ERR:
    FindWindowLike = -1
    Resume PROC_EXIT

End Function

Public Function SetTopMostWindow(hWnd As Long, TopMost As Boolean) _
   As Long
    ' Comments  :
    ' Parameters: hwnd
    '             Topmost -
    ' Returns   : Long -
    ' Modified  :
    '
    ' --------------------------------------------------
   
 
    If TopMost = True Then 'Make the window topmost
        SetTopMostWindow = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, _
           0, FLAGS)
    Else
        SetTopMostWindow = SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, _
           0, 0, FLAGS)
        SetTopMostWindow = False
    End If

   
End Function


Public Function DisplayWindow(ByVal lHandle As Long)
    Dim sAppName   As String
    Dim lState     As Long
   
    lpwndpl.Length = 44
    If lHandle = 0 Then Exit Function
    '
    ' Get the window's state and activate it.
    '
    lState = GetWindowPlacement(lHandle, lpwndpl)
    Select Case lpwndpl.showCmd
        Case SW_SHOWMINIMIZED
            Call ShowWindow(lHandle, SW_RESTORE)
        Case SW_SHOWNORMAL, SW_SHOWMAXIMIZED
            Call ShowWindow(lHandle, SW_SHOW)
    End Select
    Call SetForegroundWindow(lHandle)
End Function

</code>

Then, in the routine where you want to control the other app, do this:

<code>
Sub ControlRoutine()
    Dim v_hwnds() As Variant
    Dim lNumAppsFound As Integer, i As Integer
    Dim M As Long
   
    'Set the application application TopMost based on the name in the window
    lNumAppsFound = FindWindowLike(v_hwnds(), 0, "Notepad*", "*", Null)
    If lNumAppsFound > 0 Then
        For i = 1 To lNumAppsFound

            'This sets the window Top Most
            SetTopMostWindow CLng(v_hwnds(i)), True
            'END - This sets the window Top Most

            'The following lines are used to disable the minimize and maximize buttons
            M = GetWindowLong(CLng(v_hwnds(i)), GWL_STYLE)
            M = M And (WS_MINIMIZEBOX)
            M = M And (WS_MAXIMIZEBOX)
            M = SetWindowLong(CLng(v_hwnds(i)), GWL_STYLE, M)
            'END - The following lines are used to disable the minimize and maximize buttons

        Next i
    Else
        'Do nothing
    End If

End Sub
</code>

You didn't ask how to enable/disable the min/max buttons, but it was in the code sample I used, so I kept in in there.  You don't need those lines that start with "M = ".

The third parameter of the FindWindowLike function has a few noteworthy points:
1. This is where you put the whole or partial name of the window you are trying to control.
2. It is case sensitive (I found this the hard way).
3. It accepts "*" wildcard before and/or after the title text you are looking for.

That should do it!
0
 

Author Comment

by:C0ding
ID: 35224437

The window i am trying to set on top is the cmd = command prompt,
how could i use your example .bas mod in this case of my project?
thanks
0
 
LVL 11

Accepted Solution

by:
kbirecki earned 500 total points
ID: 35224489
Well, when I open my command prompt window, I see the text in the title bar is _exactly_ "C:\WINDOWS\system32\cmd.exe".  I am going to guess that the "C:\WINDOWS\system32\" part might vary on different systems.  So I'd suggest the code in your calling routine could be:

Sub ControlRoutine()
    Dim v_hwnds() As Variant
    Dim lNumAppsFound As Integer, i As Integer
    Dim M As Long
    
    'Set the application application TopMost based on the name in the window
    lNumAppsFound = FindWindowLike(v_hwnds(), 0, "*cmd.exe*", "*", Null)
    If lNumAppsFound > 0 Then
        For i = 1 To lNumAppsFound

            'This sets the window Top Most
            SetTopMostWindow CLng(v_hwnds(i)), True
            'END - This sets the window Top Most


        Next i
    Else
        'Do nothing
    End If

End Sub

Open in new window


And, if you want to make FindWindowLike *not* case-sensitive, modifiy the line in the module that is about 2/3's of the way down that looks like this:
If sWindowText Like WindowText And sClassname Like Classname Then

Open in new window


...to be instead...

If UCASE(sWindowText) Like UCASE(WindowText) And UCASE(sClassname) Like UCASE(Classname) Then

Open in new window


Does that work for you?
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 

Author Comment

by:C0ding
ID: 35224511

Ok, my cmd windows can have the name i want, in my example
i renamed cmd to Coding, so i have no problem with that at all...
0
 

Author Comment

by:C0ding
ID: 35224519

Hey I got it!!!
0
 

Author Comment

by:C0ding
ID: 35224521

Thank You So Much :-)

0
 
LVL 11

Expert Comment

by:kbirecki
ID: 35224554
Glad it worked for you!
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
DO Loop not working 4 63
Restricting text box entry from \/:?<>"| 9 62
Excel - Save a copy of work book 13 80
Spell Check in VB6 13 48
Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now