form1.frm

本文件包含200个visual baisc实例

VERSION 5.00
Begin VB.Form form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "获取运行程序（控件）名称和内容"
   ClientHeight    =   1665
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5190
   LinkTopic       =   "Form1"
   ScaleHeight     =   111
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   346
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command2 
      Caption         =   "取消"
      Height          =   345
      Left            =   3195
      TabIndex        =   6
      Top             =   1260
      Width           =   870
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      Height          =   345
      Left            =   4065
      TabIndex        =   5
      Top             =   1260
      Width           =   870
   End
   Begin VB.CommandButton Command1 
      Caption         =   "获取"
      Height          =   345
      Left            =   2325
      TabIndex        =   4
      Top             =   1260
      Width           =   870
   End
   Begin VB.TextBox text2 
      Height          =   270
      Left            =   1680
      TabIndex        =   1
      Top             =   900
      Width           =   3255
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   1680
      TabIndex        =   0
      Top             =   525
      Width           =   3255
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "点击“获取”按钮，然后按住鼠标左键一直拖到所需程序的控件上，即可获得以下信息"
      Height          =   360
      Left            =   75
      TabIndex        =   7
      Top             =   75
      Width           =   5040
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "获取对象内容："
      Height          =   180
      Left            =   375
      TabIndex        =   3
      Top             =   960
      Width           =   1260
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "获取对象类型："
      Height          =   180
      Left            =   375
      TabIndex        =   2
      Top             =   585
      Width           =   1260
   End
End
Attribute VB_Name = "form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim IsDragging As Boolean

Private 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
    
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, _
    lpPoint As POINTAPI) As Long

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, _
    ByVal yPoint As Long) As Long
    
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
    
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
    ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Const WM_GETTEXT = &HD

Private Type POINTAPI
  X As Long
  Y As Long
End Type

Public Function GetX() As Long
  Dim n As POINTAPI
  GetCursorPos n
  GetX = n.X
End Function

Public Function GetY() As Long
  Dim n As POINTAPI
  GetCursorPos n
  GetY = n.Y
End Function

Private Sub Form_Load()
  Dim rtn As Long
  rtn = SetWindowPos(Me.hWnd, -1, 0, 0, 0, 0, 3)
  IsDragging = False
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     Dim rtn As Long, curwnd As Long
     Dim mystr As String
     Dim newstr As Long
     Dim mouse As POINTAPI
     
  If IsDragging = True Then
     SetCapture (Me.hWnd)
     mouse.X = X
     mouse.Y = Y
     If ClientToScreen(Me.hWnd, mouse) = 0 Then Exit Sub
     curwnd = WindowFromPoint(mouse.X, mouse.Y)
     mystr = Space(255)
     newstr = Len(mystr)
'获得对象的类型
     rtn = GetClassName(curwnd, mystr, newstr)
     If rtn = 0 Then Exit Sub
     mystr = Trim(mystr)
     Text1.Text = mystr
     mystr = Space(255)
     newstr = Len(mystr)
'    获得对象的内容
     rtn = SendMessage(curwnd, WM_GETTEXT, newstr, mystr)
     mystr = Trim(mystr)
     text2.Text = mystr
  End If
End Sub

Private Sub Command1_Click()
  IsDragging = True
  Screen.MousePointer = 2
  Dim rtn As Long
' 获得窗体的位置
  rtn = SetWindowPos(Me.hWnd, -1, 0, 0, 0, 0, 3)
  SetCapture (Me.hWnd)
  
End Sub

Private Sub Command2_Click()
  Screen.MousePointer = vbDefault
  IsDragging = False
End Sub

Private Sub Command3_Click()
  End
End Sub