www.pudn.com > windowsrunning > frmMouseSelect.frm
VERSION 5.00
Begin VB.Form frmMouseSelect
Caption = "Select Window"
ClientHeight = 2640
ClientLeft = 60
ClientTop = 345
ClientWidth = 6810
ClipControls = 0 'False
Icon = "frmMouseSelect.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2640
ScaleWidth = 6810
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "Cancel"
Height = 435
Left = 3600
TabIndex = 16
Top = 2160
Width = 1395
End
Begin VB.CommandButton cmdOk
Caption = "Ok"
Default = -1 'True
Height = 435
Left = 2100
TabIndex = 15
Top = 2160
Width = 1395
End
Begin VB.TextBox txthWnd
Height = 285
Left = 2040
TabIndex = 14
Top = 60
Width = 2355
End
Begin VB.Timer TimerSelect
Enabled = 0 'False
Interval = 50
Left = 4200
Top = 1680
End
Begin VB.Label lblProgClass
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 195
Index = 1
Left = 2940
TabIndex = 13
Top = 1560
Width = 45
End
Begin VB.Label lblParClass
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 195
Index = 1
Left = 2940
TabIndex = 12
Top = 960
Width = 45
End
Begin VB.Label lblClass
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 195
Index = 1
Left = 2940
TabIndex = 11
Top = 360
Width = 45
End
Begin VB.Label lblProcess
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 195
Index = 1
Left = 2940
TabIndex = 10
Top = 1860
Width = 45
End
Begin VB.Label lblProghWnd
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 195
Index = 1
Left = 2940
TabIndex = 9
Top = 1260
Width = 45
End
Begin VB.Label lblParhWnd
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 195
Index = 1
Left = 2940
TabIndex = 8
Top = 660
Width = 45
End
Begin VB.Label lblProgClass
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Progenitor Class:"
Height = 195
Index = 0
Left = 1500
TabIndex = 7
Top = 1560
Width = 1185
End
Begin VB.Label lblParClass
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Parent Class:"
Height = 195
Index = 0
Left = 1500
TabIndex = 6
Top = 960
Width = 930
End
Begin VB.Label lblClass
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Class:"
Height = 195
Index = 0
Left = 1500
TabIndex = 5
Top = 360
Width = 420
End
Begin VB.Label lblProcess
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Process Name:"
Height = 195
Index = 0
Left = 1500
TabIndex = 4
Top = 1860
Width = 1080
End
Begin VB.Label lblProghWnd
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Progenitor hWnd:"
Height = 195
Index = 0
Left = 1500
TabIndex = 3
Top = 1260
Width = 1245
End
Begin VB.Label lblParhWnd
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Parent hWnd:"
Height = 195
Index = 0
Left = 1500
TabIndex = 2
Top = 660
Width = 990
End
Begin VB.Label lblHwnd
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "hWnd:"
Height = 195
Index = 0
Left = 1500
TabIndex = 1
Top = 60
Width = 480
End
Begin VB.Label lblSelect
BackStyle = 0 'Transparent
Caption = "Select Window:"
Height = 195
Left = 120
TabIndex = 0
Top = 420
Width = 1125
End
Begin VB.Image imgBackUp
Height = 480
Left = 360
Picture = "frmMouseSelect.frx":030A
Top = 1320
Visible = 0 'False
Width = 480
End
Begin VB.Image imgSelect
BorderStyle = 1 'Fixed Single
Height = 510
Left = 360
Top = 720
Width = 510
End
End
Attribute VB_Name = "frmMouseSelect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
' I have been to great troubles to learn all of the techniques in this program.
' I have spent many, many hours and late nights coding the many functions which I
' have included. As much as I resent it, Planet Source Code requires that I put
' the source code in the zip file. So I have placed it in here for you to view.
' Please use it wisely. And give me credit for all of the hard work that I have
' done. My biggest fear is that somebody will do an almost straight rip of this
' code, and take the credit for themselves. Please do not let this happening. I'm
' placing a lot of trust there. So please, use this program, use this code, and
' give me credit for it. If anybody rips all my routines, then my secret spy's
' (and I have a lot of them, as soon as I hire them) will tell me, and I'll get
' into my private jet (as soon as I buy it) and track you down over the whole
' world and eventually KILL YOU. You get the idea? Thanks. Read on for something
' a little more interesting!
'
' Code is Copyright Jolyon Bloomfield, February 2000
'
'
' Note: The graphics code for this form I released on Planet-Source-Code on 2/3/2000
' You may download it there. Jolyon Bloomfield.
'
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long ' Get the cursor position
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long ' Get the handle of the window that is foremost on a particular X, Y position. Used here to get the window under the cursor
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long ' Get the window co-ordinates in a RECT structure
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long ' Retrieve a handle for the hDC of a window
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long ' Release the memory occupied by an hDC
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long ' Create a GDI graphics pen object
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long ' Used to select brushes, pens, and clipping regions
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long ' Get hold of a "stock" object. I use it to get a Null Brush
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long ' Used to set the Raster OPeration of a window
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long ' Delete a GDI Object
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long ' GDI Graphics- draw a rectangle using current pen, brush, etc.
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long ' Set mouse events only for one window
Private Declare Function ReleaseCapture Lib "user32" () As Long ' Release the mouse capture
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long ' Create a rectangular region
Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long ' Select the clipping region of an hDC
Private Declare Function GetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long ' Get the Clipping region of an hDC
Private Const NULL_BRUSH = 5 ' Stock Object
Private Selecting As Boolean ' Am I currently selecting a window?
Private BorderDrawn As Boolean ' Is there a border currently drawn that needs to be undrawn?
Private Myhwnd As Long ' The current hWnd that has a border drawn on it
Public Selected As Boolean ' I have selected a window
Private Sub cmdCancel_Click()
Screen.MousePointer = MousePointerConstants.vbDefault
Screen.MouseIcon = LoadPicture()
imgSelect.Picture = imgBackUp.Picture
ReleaseCapture
Selecting = False
TimerSelect.Enabled = False
Me.txthWnd.Text = 0
Selected = True
Unload Me
End Sub
Private Sub cmdOk_Click()
Screen.MousePointer = MousePointerConstants.vbDefault
Screen.MouseIcon = LoadPicture()
imgSelect.Picture = imgBackUp.Picture
ReleaseCapture
Selecting = False
TimerSelect.Enabled = False
Dim Enumit As New Enumerator
If Enumit.IsValidWindow(Val("&H" & Me.txthWnd.Text)) = False Then
MsgBox "Please enter a valid window handle in HEXEDECIMAL.", vbInformation, "Invalid Handle"
Exit Sub
End If
UpdateInfo Val("&H" & Me.txthWnd.Text)
Selected = True
Unload Me
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbFormCode Then Else Selected = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Me.Visible = False Then Exit Sub
Me.Visible = False
If Selected = True Then
Cancel = True
Selected = False
frmSelect.Visible = True
frmSelect.ReturnhWnd = CLng(Val("&H" & Me.txthWnd.Text))
Else
Cancel = True
Selected = False
Selecting = False
frmSelect.ReturnhWnd = 0
frmSelect.Visible = True
End If
End Sub
Private Sub imgSelect_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Screen.MousePointer = MousePointerConstants.vbCustom
Screen.MouseIcon = imgSelect.Picture
imgSelect.Picture = LoadPicture()
Selecting = True
SetCapture Me.hwnd
imgSelect_MouseMove 0, Shift, X, Y
TimerSelect.Enabled = True
End Sub
Private Sub imgSelect_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Selecting = True Then Draw
End Sub
Private Sub imgSelect_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Selecting = False Then Exit Sub
UnDraw
Screen.MousePointer = MousePointerConstants.vbDefault
Screen.MouseIcon = LoadPicture()
imgSelect.Picture = imgBackUp.Picture
ReleaseCapture
Selecting = False
Myhwnd = 0
TimerSelect.Enabled = False
UpdateHWndInfo
End Sub
Private Sub TimerSelect_Timer()
UpdateHWndInfo
End Sub
Private Sub UpdateHWndInfo()
Dim Cursor As POINTAPI
Dim hwnd As Long
Dim Class As String
Dim ParhWnd As Long
Dim ParClass As String
Dim ProghWnd As Long
Dim ProgClass As String
Dim Process As String
Dim working As Enumerator
Set working = New Enumerator
GetCursorPos Cursor
hwnd = WindowFromPoint(Cursor.X, Cursor.Y)
ParhWnd = working.ParentWind(hwnd)
ProghWnd = working.Progenitor(hwnd)
Class = working.ClassName(hwnd)
ParClass = working.ClassName(ParhWnd)
ProgClass = working.ClassName(ProghWnd)
Process = working.ProcessName(working.WindProcess(hwnd))
Me.txthWnd.Text = working.Format8(hwnd)
'Me.lblHwnd(1).Caption = Working.Format8(hWnd)
lblParhWnd(1).Caption = working.Format8(ParhWnd)
lblProghWnd(1).Caption = working.Format8(ProghWnd)
lblClass(1).Caption = Class
lblParClass(1).Caption = ParClass
lblProgClass(1).Caption = ProgClass
lblProcess(1).Caption = Process
End Sub
Public Sub DoStuph()
frmSelect.Visible = False
imgSelect.Picture = imgBackUp.Picture
Dim working As New Enumerator
Me.txthWnd.Text = working.Format8(frmSelect.ReturnhWnd)
UpdateInfo Val("&H" & Me.txthWnd.Text)
Me.Show 1
End Sub
Private Sub txthWnd_Change()
'If txthWnd.Text <> "" Then
'lblhWnd(1).Caption = Hex(txthWnd.Text)
'Else
'lblhWnd(1).Caption = ""
'End If
End Sub
Private Sub UpdateInfo(ByVal hwnd As Long)
Dim Cursor As POINTAPI
Dim Class As String
Dim ParhWnd As Long
Dim ParClass As String
Dim ProghWnd As Long
Dim ProgClass As String
Dim Process As String
Dim working As Enumerator
Set working = New Enumerator
GetCursorPos Cursor
ParhWnd = working.ParentWind(hwnd)
ProghWnd = working.Progenitor(hwnd)
Class = working.ClassName(hwnd)
ParClass = working.ClassName(ParhWnd)
ProgClass = working.ClassName(ProghWnd)
Process = working.ProcessName(working.WindProcess(hwnd))
Me.txthWnd.Text = working.Format8(hwnd)
'Me.lblhWnd(1).Caption = working.Format8(hWnd)
lblParhWnd(1).Caption = working.Format8(ParhWnd)
lblProghWnd(1).Caption = working.Format8(ProghWnd)
lblClass(1).Caption = Class
lblParClass(1).Caption = ParClass
lblProgClass(1).Caption = ProgClass
lblProcess(1).Caption = Process
End Sub
Private Sub txthWnd_KeyPress(KeyAscii As Integer)
If IsNumeric(Chr(KeyAscii)) = True Or InStr("ABCDEF", UCase(Chr(KeyAscii))) <> 0 Or KeyAscii = vbKeyDelete Or KeyAscii = vbKeyBack Then
Else
KeyAscii = 0
End If
End Sub
Private Sub Draw()
Dim Cursor As POINTAPI ' Cursor position
Dim RetVal As Long ' Dummy returnvalue
Dim hdc As Long ' hDC that we're going to be using
Dim Pen As Long ' Handle to a GDI Pen object
Dim Brush As Long ' Handle to a GDI Brush object
Dim OldPen As Long ' Handle to previous Pen object (to restore it)
Dim OldBrush As Long ' Handle to previous brush object (to restore it)
Dim OldROP As Long ' Value of the previous ROP
Dim Region As Long ' Handle to a GDI Region object that I create
Dim OldRegion As Long ' Handle to previous Region object for the hDC
Dim FullWind As RECT ' the bounding rectangle of the window in screen coords
Dim Draw As RECT ' The drawing rectangle
'
' Getting all of the ingredients ready
'
' Get the cursor
GetCursorPos Cursor
' Get the window
RetVal = WindowFromPoint(Cursor.X, Cursor.Y)
' If the new hWnd is the same as the old one, skip drawing it, so to avoid flicker
If RetVal = Myhwnd Then Exit Sub
' New hWnd. If there is currently a border drawn, undraw it.
If BorderDrawn = True Then UnDraw
' Set the BorderDrawn property to true, as we're just about to draw it.
BorderDrawn = True
' And set the hWnd to the new value.
' Note, I didn't do it before, because the UnDraw routine uses the Myhwnd variable
Myhwnd = RetVal
' Get the full Rect of the window in screen co-ords
GetWindowRect Myhwnd, FullWind
' Create a region with width and height of the window
Region = CreateRectRgn(0, 0, FullWind.Right - FullWind.Left, FullWind.Bottom - FullWind.Top)
' Create an hDC for the hWnd
' Note: GetDC retrieves the CLIENT AREA hDC. We want the WHOLE WINDOW, including Non-Client
' stuff like title bar, menu, border, etc.
hdc = GetWindowDC(Myhwnd)
' Save the old region
RetVal = GetClipRgn(hdc, OldRegion)
' Retval = 0: no region 1: Region copied -1: error
' Select the new region
RetVal = SelectObject(hdc, Region)
' Create a pen
Pen = CreatePen(DrawStyleConstants.vbSolid, 6, 0) ' Draw Solid lines, width 6, and color black
' Select the pen
' A pen draws the lines
OldPen = SelectObject(hdc, Pen)
' Create a brush
' A brush is the filling for a shape
' I need to set it to a null brush so that it doesn't edit anything
Brush = GetStockObject(NULL_BRUSH)
' Select the brush
OldBrush = SelectObject(hdc, Brush)
' Select the ROP
OldROP = SetROP2(hdc, DrawModeConstants.vbInvert) ' vbInvert means, whatever is draw,
' invert those pixels. This means that I can undraw it by doing the same.
'
' The Drawing Bits
'
' Put a box around the outside of the window, using the current hDC.
' These coords are in device co-ordinates, i.e., of the hDC.
With Draw
.Left = 0
.Top = 0
.Bottom = FullWind.Bottom - FullWind.Top
.Right = FullWind.Right - FullWind.Left
Rectangle hdc, .Left, .Top, .Right, .Bottom ' Really easy to understand - draw a rectangle, hDC, and coordinates
End With
'
' The Washing Up bits
'
' This is a very important part, as it releases memory that has been taken up.
' If we don't do this, windows crashes due to a memory leak.
' You probably get a blue screen (altohugh I'm not sure)
'
' Get back the old region
SelectObject hdc, OldRegion
' Return the previous ROP
SetROP2 hdc, OldROP
' Return to the previous brush
SelectObject hdc, OldBrush
' Return the previous pen
SelectObject hdc, OldPen
' Delete the Brush I created
DeleteObject Brush
' Delete the Pen I created
DeleteObject Pen
' Delete the region I created
DeleteObject Region
' Release the hDC back to window's resource pool
ReleaseDC Myhwnd, hdc
End Sub
Private Sub UnDraw()
'
' Note, this sub is almost identical to the other one, except it doesn't go looking
' for the hWnd, it accesses the old one. Also, it doesn't clear the form.
' Otherwise, it just draws on top of the old one with an invert pen.
' 2 inverts = original
'
' If there hasn't been a border drawn, then get out of here.
If BorderDrawn = False Then Exit Sub
' Now set it
BorderDrawn = False
' If there isn't a current hWnd, then exit.
' That's why in the mouseup event we get out, because otherwise a border would be draw
' around the old window
If Myhwnd = 0 Then Exit Sub
Dim Cursor As POINTAPI ' Cursor position
Dim RetVal As Long ' Dummy returnvalue
Dim hdc As Long ' hDC that we're going to be using
Dim Pen As Long ' Handle to a GDI Pen object
Dim Brush As Long ' Handle to a GDI Brush object
Dim OldPen As Long ' Handle to previous Pen object (to restore it)
Dim OldBrush As Long ' Handle to previous brush object (to restore it)
Dim OldROP As Long ' Value of the previous ROP
Dim Region As Long ' Handle to a GDI Region object that I create
Dim OldRegion As Long ' Handle to previous Region object for the hDC
Dim FullWind As RECT ' the bounding rectangle of the window in screen coords
Dim Draw As RECT ' The drawing rectangle
'
' Getting all of the ingredients ready
'
' Get the full Rect of the window in screen co-ords
GetWindowRect Myhwnd, FullWind
' Create a region with width and height of the window
Region = CreateRectRgn(0, 0, FullWind.Right - FullWind.Left, FullWind.Bottom - FullWind.Top)
' Create an hDC for the hWnd
' Note: GetDC retrieves the CLIENT AREA hDC. We want the WHOLE WINDOW, including Non-Client
' stuff like title bar, menu, border, etc.
hdc = GetWindowDC(Myhwnd)
' Save the old region
RetVal = GetClipRgn(hdc, OldRegion)
' Retval = 0: no region 1: Region copied -1: error
' Select the new region
RetVal = SelectObject(hdc, Region)
' Create a pen
Pen = CreatePen(DrawStyleConstants.vbSolid, 6, 0) ' Draw Solid lines, width 6, and color black
' Select the pen
' A pen draws the lines
OldPen = SelectObject(hdc, Pen)
' Create a brush
' A brush is the filling for a shape
' I need to set it to a null brush so that it doesn't edit anything
Brush = GetStockObject(NULL_BRUSH)
' Select the brush
OldBrush = SelectObject(hdc, Brush)
' Select the ROP
OldROP = SetROP2(hdc, DrawModeConstants.vbInvert) ' vbInvert means, whatever is draw,
' invert those pixels. This means that I can undraw it by doing the same.
'
' The Drawing Bits
'
' Put a box around the outside of the window, using the current hDC.
' These coords are in device co-ordinates, i.e., of the hDC.
With Draw
.Left = 0
.Top = 0
.Bottom = FullWind.Bottom - FullWind.Top
.Right = FullWind.Right - FullWind.Left
Rectangle hdc, .Left, .Top, .Right, .Bottom ' Really easy to understand - draw a rectangle, hDC, and coordinates
End With
'
' The Washing Up bits
'
' This is a very important part, as it releases memory that has been taken up.
' If we don't do this, windows crashes due to a memory leak.
' You probably get a blue screen (altohugh I'm not sure)
'
' Get back the old region
SelectObject hdc, OldRegion
' Return the previous ROP
SetROP2 hdc, OldROP
' Return to the previous brush
SelectObject hdc, OldBrush
' Return the previous pen
SelectObject hdc, OldPen
' Delete the Brush I created
DeleteObject Brush
' Delete the Pen I created
DeleteObject Pen
' Delete the region I created
DeleteObject Region
' Release the hDC back to window's resource pool
ReleaseDC Myhwnd, hdc
End Sub