Dan Appleman's Visual Bas…s Guide to the Win32 API/Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD/VB5PG32.mdf/vbpg32/samples4/ch05/winview.frm

Visual Basic Form | 1996-02-16 | 22.0 KB | 643 lines

VERSION 4.00
Begin VB.Form Winview
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "WinView"
   ClientHeight    =   3555
   ClientLeft      =   1440
   ClientTop       =   2265
   ClientWidth     =   7140
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   4245
   Left            =   1380
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   237
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   476
   Top             =   1635
   Width           =   7260
   Begin VB.PictureBox picPoint2
      Height          =   375
      Left            =   6240
      ScaleHeight     =   345
      ScaleWidth      =   645
      TabIndex        =   9
      Top             =   3060
      Width           =   675
   End
   Begin VB.ListBox List1
      Appearance      =   0  'Flat
      Height          =   1980
      Left            =   240
      TabIndex        =   8
      Top             =   360
      Width           =   6795
   End
   Begin VB.CommandButton CmdPosition
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Position"
      Height          =   435
      Left            =   240
      TabIndex        =   2
      Top             =   2460
      Width           =   975
   End
   Begin VB.CommandButton CmdSize
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Size"
      Height          =   435
      Left            =   1320
      TabIndex        =   3
      Top             =   2460
      Width           =   975
   End
   Begin VB.CommandButton CmdClassInfo
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "ClassInfo"
      Height          =   435
      Left            =   2400
      TabIndex        =   4
      Top             =   2460
      Width           =   975
   End
   Begin VB.CommandButton CmdWinStyles
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "WinStyles"
      Height          =   435
      Left            =   3480
      TabIndex        =   5
      Top             =   2460
      Width           =   1035
   End
   Begin VB.CommandButton CmdFlash
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Flash"
      Height          =   435
      Left            =   4620
      TabIndex        =   6
      Top             =   2460
      Width           =   975
   End
   Begin VB.CommandButton CmdCtlName
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "CtlName"
      Height          =   435
      Left            =   240
      TabIndex        =   7
      Top             =   3000
      Width           =   975
   End
   Begin VB.CommandButton CmdParent
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Parent"
      Height          =   435
      Left            =   1320
      TabIndex        =   1
      Top             =   3000
      Width           =   975
   End
   Begin VB.Label lblHere
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Click Here For point mode 2 -->"
      Height          =   255
      Left            =   3420
      TabIndex        =   10
      Top             =   3120
      Width           =   2835
   End
   Begin Cbkd.Callback Callback1
      Left            =   2580
      Top             =   3000
      _Version        =   262144
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
      Type            =   6
   End
   Begin VB.Label Label1
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   195
      Left            =   240
      TabIndex        =   0
      Top             =   60
      Width           =   5415
   End
   Begin VB.Menu MenuLoadList
      Caption         =   "LoadList"
      Begin VB.Menu MenuTopLevel
         Caption         =   "&TopLevel"
         Shortcut        =   ^T
      End
      Begin VB.Menu MenuChildren
         Caption         =   "&Children"
         Shortcut        =   ^C
      End
      Begin VB.Menu MenuOwned
         Caption         =   "&Owned"
         Shortcut        =   ^O
      End
      Begin VB.Menu MenuPointed
         Caption         =   "&Pointed"
         Shortcut        =   ^P
      End
      Begin VB.Menu MenuClear
         Caption         =   "C&lear"
      End
   End
Attribute VB_Name = "Winview"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Copyright
 1996 by Desaware. All Rights Reserved
Public Function GetControlNameFromWindow(ByVal hwnd&)
    Dim formnum%
    Dim ctlnum%
    For formnum% = 0 To Forms.Count - 1
        If Forms(formnum%).hwnd = hwnd& Then
            GetControlNameFromWindow = Forms(formnum%).Name
            Exit Function
        End If
        For ctlnum% = 0 To Forms(formnum%).Controls.Count - 1
            On Error Resume Next
            If Forms(formnum%).Controls(ctlnum%).hwnd = hwnd& Then
                If Err.Number = 0 Then
                    GetControlNameFromWindow = Forms(formnum%).Controls(ctlnum%).Name
                End If
                Exit Function
            End If
        Next ctlnum%
    Next formnum%
End Function
'   lpData was passed by the EnumWindows call and contains
'   the parent window handle that we are looking for.
Private Sub Callback1_EnumWindows(hwnd As Long, lpData As Long, retval As Long)
    ' If hWnd is owned by window in lpData,
    ' Add it to the listbox
    ' Was: If GetParent(hwnd) = CInt(lpData) Then
    If GetParent(hwnd) = lpData Then
        List1.AddItem GetWindowDesc$(hwnd)
    End If
    retval = 1  ' Continue enumeration
End Sub
' Show class styles for the selected window
Private Sub CmdClassInfo_Click()
    Dim clsextra&, wndextra&    ' Change to long, though probably unnecessary
    Dim style&      ' Changed to long
    Dim useHwnd&    ' Changed to long
    Dim crlf$
    Dim outstring$, titlestring$
    crlf$ = Chr$(13) + Chr$(10)
    If List1.ListIndex < 0 Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    titlestring$ = List1.Text
    useHwnd& = GetHwnd(titlestring$)
    ' Get the class info
    ' These all used to be GetClassWord and GCW_ constants
    clsextra& = GetClassLong(useHwnd&, GCL_CBCLSEXTRA)
    wndextra& = GetClassLong(useHwnd&, GCL_CBWNDEXTRA)
    style& = GetClassLong(useHwnd&, GCL_STYLE)
    outstring$ = "Class & Word Extra = " + Str$(clsextra&) + "," + Str$(wndextra&) + crlf$
    If style& And CS_BYTEALIGNCLIENT Then
        outstring$ = outstring$ + "CS_BYTEALIGNCLIENT" + crlf$
    End If
    If style& And CS_BYTEALIGNWINDOW Then
        outstring$ = outstring$ + "CS_BYTEALIGNWINDOW" + crlf$
    End If
    If style& And CS_CLASSDC Then
        outstring$ = outstring$ + "CS_CLASSDC" + crlf$
    End If
    If style& And CS_DBLCLKS Then
        outstring$ = outstring$ + "CS_DBLCLKS" + crlf$
    End If
    ' Was CS_GLOBALCLASS (has same value)
    If style& And CS_PUBLICCLASS Then
        outstring$ = outstring$ + "CS_GLOBALCLASS" + crlf$
    End If
    If style& And CS_HREDRAW Then
        outstring$ = outstring$ + "CS_HREDRAW" + crlf$
    End If
    If style& And CS_NOCLOSE Then
        outstring$ = outstring$ + "CS_NOCLOSE" + crlf$
    End If
    If style& And CS_OWNDC Then
        outstring$ = outstring$ + "CS_OWNDC" + crlf$
    End If
    If style& And CS_PARENTDC Then
        outstring$ = outstring$ + "CS_PARENTDC" + crlf$
    End If
    If style& And CS_SAVEBITS Then
        outstring$ = outstring$ + "CS_SAVEBITS" + crlf$
    End If
    If style& And CS_VREDRAW Then
        outstring$ = outstring$ + "CS_VREDRAW" + crlf$
    End If
    MsgBox outstring$, 0, titlestring$
End Sub
' Obtains the control name or form name of a Visual
' Basic form or control given the window handle.
' Non VB windows will have no form or control name
Private Sub CmdCtlName_Click()
    Dim titlestring$
    Dim outputstring$
    Dim useHwnd&
    If List1.ListIndex < 0 Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    titlestring$ = List1.Text
    useHwnd& = GetHwnd(titlestring$)
    ' Was: outputstring$ = agGetControlName$(useHwnd&)
    ' See text for reason for this change
    outputstring$ = GetControlNameFromWindow(useHwnd&)
    If outputstring$ = "" Then
        MsgBox "Not a VB Form or Control", 0, titlestring$
    Else
        MsgBox "CtlName or FormName = " + outputstring$, 0, titlestring$
    End If
End Sub
' Flashes the caption of the selected window. This feature
' is typically attached to a timer when the code needs to
' "flash" a window caption to attract the users attention.
' Try clicking this button several times quickly for a
' visible window that has a caption to see the effect
Private Sub CmdFlash_Click()
    Dim titlestring$
    Dim useHwnd&
    Dim dl&
    If List1.ListIndex < 0 Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    titlestring$ = List1.Text
    useHwnd& = GetHwnd(titlestring$)
    dl& = FlashWindow(useHwnd&, -1)
End Sub
Private Sub CmdParent_Click()
    Dim hwnd&, newhwnd& ' Changed to long
    Dim windowdesc$
    If List1.ListIndex < 0 Then
        MsgBox "No Window Selected", 0, "Error"
        Exit Sub
    End If
    hwnd& = GetHwnd(List1.Text)
    newhwnd& = GetParent(hwnd&)
    If newhwnd& = 0 Then
        MsgBox "Window has no parent", 0, "Window &H" + Hex$(hwnd&)
        Exit Sub
    End If
    windowdesc$ = GetWindowDesc$(newhwnd&)
    MsgBox windowdesc$, 0, "Parent of &H" + Hex$(hwnd&) + " is"
End Sub
Private Sub cmdPoint_Click()
End Sub
'   Show the position of the selected window
Private Sub CmdPosition_Click()
    Dim WindowRect As RECT
    Dim useHwnd&
    Dim crlf$
    Dim outstring$, titlestring$
    crlf$ = Chr$(13) + Chr$(10)
    If List1.ListIndex < 0 Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    titlestring$ = List1.Text
    useHwnd& = GetHwnd(titlestring$)
    ' Get the rectangle describing the window
    GetWindowRect useHwnd&, WindowRect
    If IsIconic&(useHwnd&) Then
        outstring$ = "Is Iconic" + crlf$
    End If
    If IsZoomed&(useHwnd&) Then
        outstring$ = outstring$ + "Is Zoomed" + crlf$
    End If
    If IsWindowEnabled&(useHwnd&) Then
        outstring$ = outstring$ + "Is Enabled" + crlf$
    Else
        outstring$ = outstring$ + "Is Disabled" + crlf$
    End If
    If IsWindowVisible&(useHwnd&) Then
        outstring$ = outstring$ + "Is Visible" + crlf$
    Else
        outstring$ = outstring$ + "Is NOT Visible" + crlf$
    End If
    outstring$ = outstring$ + "Rect: " + Str$(WindowRect.Left) + ","
    outstring$ = outstring$ + Str$(WindowRect.Top) + ","
    outstring$ = outstring$ + Str$(WindowRect.Right) + ","
    outstring$ = outstring$ + Str$(WindowRect.Bottom)
    MsgBox outstring$, 0, titlestring$
End Sub
'   Show the size of the selected window
Private Sub CmdSize_Click()
    Dim WindowClientRect As RECT
    Dim useHwnd&
    Dim crlf$
    Dim outstring$, titlestring$
    crlf$ = Chr$(13) + Chr$(10)
    If List1.ListIndex < 0 Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    titlestring$ = List1.Text
    useHwnd& = GetHwnd(titlestring$)
    ' Get the rectangle describing the window
    GetClientRect useHwnd&, WindowClientRect
    outstring$ = "Horiz Pixels: " + Str$(WindowClientRect.Right) + crlf$
    outstring$ = outstring$ + "Vert Pixels: " + Str$(WindowClientRect.Bottom)
    MsgBox outstring$, 0, titlestring$
End Sub
' Show window styles for the selected window
Private Sub CmdWinStyles_Click()
    Dim style&
    Dim useHwnd&    ' Was integer
    Dim crlf$
    Dim outstring$, titlestring$
    crlf$ = Chr$(13) + Chr$(10)
    If List1.ListIndex < 0 Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    titlestring$ = List1.Text
    useHwnd& = GetHwnd(titlestring$)
    ' Get the class info
    style& = GetWindowLong&(useHwnd&, GWL_STYLE)
    If style& And WS_BORDER Then
        outstring$ = outstring$ + "WS_BORDER" + crlf$
    End If
    If style& And WS_CAPTION Then
        outstring$ = outstring$ + "WS_CAPTION" + crlf$
    End If
    If style& And WS_CHILD Then
        outstring$ = outstring$ + "WS_CHILD" + crlf$
    End If
    If style& And WS_CLIPCHILDREN Then
        outstring$ = outstring$ + "WS_CLIPCHILDREN" + crlf$
    End If
    If style& And WS_CLIPSIBLINGS Then
        outstring$ = outstring$ + "WS_CLIPSIBLINGS" + crlf$
    End If
    If style& And WS_DISABLED Then
        outstring$ = outstring$ + "WS_DISABLED" + crlf$
    End If
    If style& And WS_DLGFRAME Then
        outstring$ = outstring$ + "WS_DLGFRAME" + crlf$
    End If
    If style& And WS_GROUP Then
        outstring$ = outstring$ + "WS_GROUP" + crlf$
    End If
    If style& And WS_HSCROLL Then
        outstring$ = outstring$ + "WS_HSCROLL" + crlf$
    End If
    If style& And WS_MAXIMIZE Then
        outstring$ = outstring$ + "WS_MAXIMIZE" + crlf$
    End If
    If style& And WS_MAXIMIZEBOX Then
        outstring$ = outstring$ + "WS_MAXIMIZEBOX" + crlf$
    End If
    If style& And WS_MINIMIZE Then
        outstring$ = outstring$ + "WS_MINIMIZE" + crlf$
    End If
    If style& And WS_MINIMIZEBOX Then
        outstring$ = outstring$ + "WS_MINIMIZEBOX" + crlf$
    End If
    If style& And WS_POPUP Then
        outstring$ = outstring$ + "WS_POPUP" + crlf$
    End If
    If style& And WS_SYSMENU Then
        outstring$ = outstring$ + "WS_SYSMENU" + crlf$
    End If
    If style& And WS_TABSTOP Then
        outstring$ = outstring$ + "WS_TABSTOP" + crlf$
    End If
    If style& And WS_THICKFRAME Then
        outstring$ = outstring$ + "WS_THICKFRAME" + crlf$
    End If
    If style& And WS_VISIBLE Then
        outstring$ = outstring$ + "WS_VISIBLE" + crlf$
    End If
    If style& And WS_VSCROLL Then
        outstring$ = outstring$ + "WS_VSCROLL" + crlf$
    End If
    ' Note: We could tap the style& variable for class
    ' styles as well (especially since it is easy to
    ' determine the class for a window), but that is
    ' beyond the scope of this sample program.
    MsgBox outstring$, 0, titlestring$
End Sub
Private Sub Form_Load()
    Dim tabsets&(2) ' Change to an array of longs
    Dim dl&
    tabsets(0) = 45
    tabsets(1) = 110
    dl = SendMessageLongByRef&(List1.hwnd, LB_SETTABSTOPS, 2, tabsets(0))
End Sub
'   If we're in point mode, record the current window
'   in the listbox
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If PointMode% <> -1 Then Exit Sub
    List1.AddItem Label1.Caption
    PointMode% = 0
    Label1.Caption = ""
    ' If capture is still held, release it - this is
    ' actually not necessary in VB 1.0 as it seems to
    ' release the capture anyway!
    If GetCapture() = Winview.hwnd Then ReleaseCapture
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pt As POINTAPI
    Dim foundhWnd&  ' Now a long
    ' Only record window if we're in point mode
    If PointMode% = 0 Then Exit Sub
    pt.X = X
    pt.Y = Y
    ClientToScreen Winview.hwnd, pt
    ' Was: foundhWnd% = WindowFromPointBynum%(agPOINTAPItoLong&(pt))
    foundhWnd& = WindowFromPoint(pt.X, pt.Y)
    Label1.Caption = GetWindowDesc$(foundhWnd)
End Sub
' If source$ is a path, this function retrieves the
' basename, or filename sans path
' source$ MUST be a valid filename
Private Function GetBaseName$(ByVal source$)
    Do While InStr(source$, "\") <> 0
        source$ = Mid$(source$, InStr(source$, "\") + 1)
    Loop
    If InStr(source$, ":") <> 0 Then
        source$ = Mid$(source$, InStr(source$, ":") + 1)
    End If
    GetBaseName$ = source$
End Function
'   Builds a string descrbing the window in format
'   handle, source application, class
'   seperated by tabs
'   Used to take an integer parameter, now a long
Private Function GetWindowDesc$(hwnd&)
    Dim desc$
    Dim tbuf$
    Dim inst&   ' Now a long
    Dim dl&
    Dim hWndProcess&
    ' Include the windows handle first
    desc$ = "&H" + Hex$(hwnd) + Chr$(9)
    ' Get name of source app
    tbuf$ = String$(256, 0) ' Predefine string length
    ' Handling of process is different in Win32 - see text
    dl& = GetWindowThreadProcessId(hwnd, hWndProcess)
    If hWndProcess = GetCurrentProcessId() Then
        ' Get instance for window
        ' Was: inst% = GetWindowWord(hwnd%, GWW_HINSTANCE)

        inst& = GetWindowLong(hwnd&, GWL_HINSTANCE)
        ' Get the module filename
        ' Was: dummy% = GetModuleFileName(inst%, tbuf$, 255)
        dl& = GetModuleFileName(inst, tbuf$, 255)
        tbuf$ = GetBaseName(tbuf$)
        ' The following two lines are equivalent
        tbuf$ = agGetStringFromLPSTR$(tbuf$)
        ' If InStr(tbuf$, Chr$(0)) Then tbuf$ = Left$(tbuf$, InStr(tbuf$, Chr$(0)) - 1)
    Else
        tbuf$ = "Foreign Window"
    End If
    ' And add it to the description
    desc$ = desc$ + tbuf$ + Chr$(9)
    ' Finally, add the class name
    tbuf$ = String$(256, 0) ' Initialize space again
    dl& = GetClassName(hwnd&, tbuf$, 255)
    tbuf$ = agGetStringFromLPSTR$(tbuf$)
    desc$ = desc$ + tbuf$
    ' And return the description
    GetWindowDesc$ = desc$
End Function
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If PointMode% <> -2 Then Exit Sub
    List1.AddItem Label1.Caption
    PointMode% = 0
    Label1.Caption = ""
    ' If capture is still held, release it - this is
    ' actually not necessary in VB 1.0 as it seems to
    ' release the capture anyway!
    If GetCapture() = Winview.hwnd Then ReleaseCapture
End Sub
Private Sub MenuChildren_Click()
    Dim hwnd&   ' Changed to long
    Dim windowdesc$
    ' Is there a window selected?
    If List1.ListIndex < 0 Then
        MsgBox "No Window Selected", 0, "Error"
        Exit Sub
    End If
    windowdesc$ = List1.Text
    hwnd = GetHwnd(windowdesc$)    ' Extract window handle
    ' It's first child is the specified window
    hwnd = GetWindow(hwnd, GW_CHILD)
    If hwnd = 0 Then
        MsgBox "No children found for this window", 0, "Error"
        Exit Sub
    End If
    ' Clear the listbox
    List1.Clear
    ' Now load all the child windows
    Do
        List1.AddItem GetWindowDesc$(hwnd)
        hwnd = GetWindow(hwnd, GW_HWNDNEXT)
    Loop While hwnd <> 0
    Label1.Caption = "Children of: " + "&" + windowdesc$
End Sub
'   Just clear the listbox
Private Sub MenuClear_Click()
    ' Clear the listbox
    ' Was dummy% = SendMessageBynum&(agGetControlHwnd(List1), LB_RESETCONTENT, 0, 0&)
    List1.Clear
End Sub
'   Show owned windows of the currently selected window
Private Sub MenuOwned_Click()
    Dim hwnd&   ' Switch to Long
    Dim dl&
    Dim windowdesc$
    ' Is there a window selected?
    If List1.ListIndex < 0 Then
        MsgBox "No Window Selected", 0, "Error"
        Exit Sub
    End If
    windowdesc$ = List1.Text
    hwnd = GetHwnd(windowdesc$)    ' Extract window handle
    ' Clear the listbox
    List1.Clear
    ' This uses the cbk.vbx control to obtain a callback
    ' address for EnumWindows.
    ' This will trigger the Callback1_EnumWindows event
    ' for each top level window.  This technique could
    ' also have been used in place of the GetWindow loop
    ' in the MenuTopLevel_Click event.
    ' Was: dummy% = EnumWindows(Callback1.ProcAddress, CLng(hwnd))
    dl& = EnumWindows(Callback1.ProcAddress, hwnd)
    If List1.ListCount = 0 Then
        MsgBox "No owned windows found for this window", 0, "Error"
        Label1.Caption = ""
        Exit Sub
    End If
    Label1.Caption = "Owned windows of: " + "&" + windowdesc$
End Sub
Private Sub MenuPointed_Click()
    Dim dl&
    ' Let system know that we're in point mode
    PointMode% = -1
    dl& = SetCapture(Winview.hwnd)
End Sub
'   Loads the listbox with a list of all top level
'   windows.
Private Sub MenuTopLevel_Click()
    Dim hwnd&
    ' Clear the listbox
    ' Was: dummy% = SendMessage&(agGetControlHwnd(List1), LB_RESETCONTENT, 0, 0&)
    ' Could be: dummy& = SendMessage&(agGetControlHwnd(List1), LB_RESETCONTENT, 0, 0&)
    ' But we might as well use:
    List1.Clear
    ' The desktop is the highest window
    hwnd& = GetDesktopWindow()
    ' It's first child is the 1st top level window
    hwnd& = GetWindow(hwnd&, GW_CHILD)
    ' Now load all top level windows
    Do
        List1.AddItem GetWindowDesc$(hwnd&)
        hwnd& = GetWindow(hwnd&, GW_HWNDNEXT)
    Loop While hwnd& <> 0
    Label1.Caption = "Top level windows"
End Sub
Private Sub picPoint2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim dl&
    ' Let system know that we're in point mode
    PointMode% = -2
    dl& = SetCapture(Winview.hwnd)
    ' Initialize the label
    Label1.Caption = GetWindowDesc$(picPoint2.hwnd)
End Sub
Private Function GetHwnd&(title$)
    Dim p%
    p% = InStr(title$, Chr$(9))
    If p% > 0 Then GetHwnd& = Val(Left$(title$, p% - 1))
End Function