tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
[ツリー表示へ]　 [ワード検索]　 [Home]

タイトル ： Re: マウス直下の文字読み取り
投稿日： 2015/10/23(Fri) 10:24
投稿者： 魔界の仮面弁士
> (先頭にhをつけて下さい)
掲示板に表示される際には、自動的に補われるので気にしなくて OK です。


> 以下のURLを参考にマウス直下の文字読み取るVB６のコード

.NET Framework の標準クラスだけで実装してみました。
元のコードとは動作が異なりますけど。


Public Class Form1

#Region "サンプル画面構築処理"
    Private WithEvents Timer1 As System.Windows.Forms.Timer
    Private WithEvents SplitContainer1 As System.Windows.Forms.SplitContainer
    Private WithEvents SplitContainer2 As System.Windows.Forms.SplitContainer
    Private WithEvents PropertyGrid1 As System.Windows.Forms.PropertyGrid
    Private WithEvents TextBox1 As System.Windows.Forms.TextBox
    Private WithEvents TextBox2 As System.Windows.Forms.TextBox

    ''' <summary>
    ''' サンプル画面を作るためのコード。
    ''' 通常はデザイナで同じ画面を構築しておけばOK。
    ''' </summary>
    Private Sub InitForm()
        If Me.components Is Nothing Then
            Me.components = New System.ComponentModel.Container()
        End If
        Me.Timer1 = New System.Windows.Forms.Timer(Me.components)
        Me.Timer1.Interval = 100
        Me.SplitContainer1 = New System.Windows.Forms.SplitContainer()
        Me.SplitContainer1.Orientation = Orientation.Vertical
        Me.SplitContainer1.Dock = DockStyle.Fill
        Me.SplitContainer2 = New System.Windows.Forms.SplitContainer()
        Me.SplitContainer2.Orientation = Orientation.Horizontal
        Me.SplitContainer2.Dock = DockStyle.Fill
        Me.TextBox1 = New System.Windows.Forms.TextBox()
        Me.TextBox1.Multiline = True
        Me.TextBox1.ScrollBars = ScrollBars.Both
        Me.TextBox1.Dock = DockStyle.Fill
        Me.TextBox1.ReadOnly = True
        Me.TextBox2 = New System.Windows.Forms.TextBox()
        Me.TextBox2.Multiline = True
        Me.TextBox2.ScrollBars = ScrollBars.Both
        Me.TextBox2.Dock = DockStyle.Fill
        Me.TextBox2.ReadOnly = True
        Me.PropertyGrid1 = New System.Windows.Forms.PropertyGrid()
        Me.PropertyGrid1.Dock = DockStyle.Fill
        Me.SplitContainer1.Panel1.Controls.Add(Me.SplitContainer2)
        Me.SplitContainer1.Panel2.Controls.Add(Me.PropertyGrid1)
        Me.SplitContainer2.Panel1.Controls.Add(Me.TextBox1)
        Me.SplitContainer2.Panel2.Controls.Add(Me.TextBox2)
        Me.Controls.Add(Me.SplitContainer1)
    End Sub
#End Region

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.InitForm()
        Me.Timer1.Start()
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        Dim posScreen = System.Windows.Forms.Cursor.Position
        If Me.Bounds.Contains(posScreen) Then
            Return
        End If

        Dim windowForm = Me.AccessibilityObject
        Dim clientDesktop = windowForm.Parent
        Dim windowDesktop = clientDesktop.Parent
        Dim hitObject = windowDesktop.HitTest(posScreen.X, posScreen.Y)

        Dim targetObject = hitObject
        Dim depth = 0
        Do Until targetObject Is Nothing OrElse depth > 32
            Dim childObject = targetObject.HitTest(posScreen.X, posScreen.Y)
            If childObject Is Nothing Then
                Exit Do
            Else
                targetObject = childObject
                depth += 1
            End If
        Loop

        Me.PropertyGrid1.SelectedObject = targetObject
        Me.TextBox1.BackColor = Color.Empty
        Me.TextBox2.BackColor = Color.Empty
        If targetObject Is Nothing Then
            Me.TextBox1.Clear()
            Me.TextBox2.Clear()
        Else
            Try
                Me.TextBox1.Text = targetObject.Name
            Catch ex As Exception
                Me.TextBox1.BackColor = Color.LightYellow
                Me.TextBox1.Text = ex.ToString()
            End Try
            Try
                Me.TextBox2.Text = targetObject.Value
            Catch ex As Exception
                Me.TextBox2.BackColor = Color.LightYellow
                Me.TextBox2.Text = ex.ToString()
            End Try
        End If
    End Sub

End Class
- 関連一覧ツリー （ をクリックするとツリー全体を一括表示します）

古いスレッドにレスはつけられません。