📄 frmmouseselect.frm
字号:
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -