tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板) [ツリー表示へ]   [Home]
一括表示(VB.NET VB2005)
タイトルマウス直下の文字読み取り
記事No11508
投稿日: 2015/10/22(Thu) 22:29
投稿者おおしろ
お世話になっています。
先日も書き込ませていただきましたが、以下のURLを参考にマウス直下の文字読み取るVB6のコードを.NETへと移行しています。
http://hpcgi1.nifty.com/MADIA/VBBBS/wwwlng.cgi?print+200803/08030016.txt (先頭にhをつけて下さい)


現状のソースは以下です。
コンパイルエラーは起きないのですが、ブラウザの画面が真っ白になってしまいます。
リファレンスの閲覧、検索等など行ったのですが行き詰ってしまいました。
どなたかご教授いただけないでしょうか。


________________________________________________

Option Explicit On

Imports System.Runtime.InteropServices

Public Class Form1

    Private Structure POINTAPI
        Dim x As Integer
        Dim y As Integer
    End Structure


    Private Declare Function GetCursorPos Lib "user32" _
       (ByRef xyScreen As Long) As Long

    <DllImport("oleacc.dll", CharSet:=CharSet.Auto)> _
    Private Shared Function AccessibleObjectFromPoint( _
     ByVal x As Integer, _
     ByVal y As Integer, _
    ByRef ppoleAcc As Accessibility.IAccessible, _
    ByRef pvarElement As Object) As Integer
    End Function

    Private Sub Form_Load()
        Timer1.Interval = 250
        Timer1.Enabled = True
        WebBrowser1.Navigate("hhttps://www.microsoft.com/ja-jp/dev/default.aspx")
    End Sub

    Private Sub Timer1_Timer()
        Dim xy(1) As Integer

        GetCursorPos(xy(0))

        Dim objAcc As Accessibility.IAccessible

        Dim child As Object
        AccessibleObjectFromPoint(xy(0), xy(1), objAcc, child)

        List1.Items.Clear()
        On Error Resume Next
        Dim ltwh(3) As Integer
        objAcc.accLocation(ltwh(0), ltwh(1), ltwh(2), ltwh(3), child)
        List1.Items.Add("Pos:" _
            & "Left" & CStr(ltwh(0)) & "," _
            & "Top" & CStr(ltwh(1)) & "," _
            & "Width" & CStr(ltwh(2)) & "," _
            & "Height" & CStr(ltwh(3)))
        List1.Items.Add("Name=" & objAcc.accName(child))
        List1.Items.Add("Value=" & objAcc.accValue(child))
        List1.Items.Add("Description=" & objAcc.accDescription(child))
    End Sub
End Class

_____________________________________________________________________________

[ツリー表示へ]
タイトルRe: マウス直下の文字読み取り
記事No11509
投稿日: 2015/10/22(Thu) 23:18
投稿者花ちゃん
>     Private Declare Function GetCursorPos Lib "user32" _
>        (ByRef xyScreen As Long) As Long
前回も言いましたが、関数の型が間違ったままですよ



>     Private Sub Form_Load()
これは、VB6.0 のイベントの宣言のままですよ

>     Private Sub Timer1_Timer()
こちらも、

>List1.Items.Clear()
ListBox1 ではないのですか? 変更しているのですか?

この辺をきちんと .NET 系のコードに書き直せば動作しますよ(動作確認済み)

[ツリー表示へ]
タイトルRe^2: マウス直下の文字読み取り
記事No11510
投稿日: 2015/10/23(Fri) 00:53
投稿者おおしろ
前回に続いてありがとうございます。
正常に動作致しました。助かりました。

[ツリー表示へ]
タイトルRe^2: マウス直下の文字読み取り
記事No11511
投稿日: 2015/10/23(Fri) 01:07
投稿者おおしろ
重ねて失礼致します。


現在このプログラムではマウス以下の文章を取得しているようにかんじるのですが、
これを1単語取得(英文を想定しています)というのはどのように制作したらよいのでしょうか?


別ツリーに書き込んだほうが良いのならそうします。
よろしくお願いいたします。

[ツリー表示へ]
タイトルRe^3: マウス直下の文字読み取り
記事No11512
投稿日: 2015/10/23(Fri) 08:22
投稿者花ちゃん
> 現在このプログラムではマウス以下の文章を取得しているようにかんじるのですが、
> これを1単語取得(英文を想定しています)というのはどのように制作したらよいのでしょうか?

どのような文書の中のどのような単語(貴方の言う単語の定義)を取得したいのかで方法も色々
考えられますが、まず、キチンとしたものを一発で取得する事は困難かと(最終的には人間の目で見て
判断しないと)

大まかには、下記のような文字列関数や正規表現等を使って取得(抜き出す)する事になるかと思います。
http://hanatyan.sakura.ne.jp/vb2005/vb2013function05.htm

[ツリー表示へ]
タイトルRe^4: マウス直下の文字読み取り
記事No11515
投稿日: 2015/10/23(Fri) 16:00
投稿者おおしろ
花ちゃんさん


返信ありがとうございます。
英文をマウスオーバーすると単語部分が翻訳されるという物を作りたかったのですが、無理そうですか、、、

英文をダブルクリックすると単語だけ選択されるので
それを上手く使えないかだとか、
Accessibleで取得した文章の改行で何とか区切って座標から単語を出すだとか、
色々試行錯誤してみたのですが無理そうでした。
ありがとうございました。

[ツリー表示へ]
タイトルRe^5: マウス直下の文字読み取り
記事No11518
投稿日: 2015/10/23(Fri) 16:28
投稿者魔界の仮面弁士
> 英文をマウスオーバーすると単語部分が翻訳されるという物を作りたかったのですが、無理そうですか、、、
操作対象のアプリは限定されていますか?

たとえば、操作対象が RichEdit(RichTextBox) のコントロールであれば、
EM_CHARFROMPOS メッセージを送出することで、座標から文字の位置情報を取得できます。

操作対象のコントロールまで明確に分かっているのであれば、
UI Automation で辿ってみても良いかも知れません。
https://msdn.microsoft.com/ja-jp/library/ms788733.aspx


> 英文をダブルクリックすると単語だけ選択されるので
> それを上手く使えないかだとか、

選択された文字列が相手なら、おそらく拾えると思います。
(操作対象のアプリの実装状況にもよるので確証は持てませんが)

対象が Internet Explorer なら、createTextRange からでも得られそうですね。

少し手間を増やしても良いのなら、単語を「コピー」してもらい
クリップボードチェインからそのテキストを読み出すという選択肢もあるかも。

[ツリー表示へ]
タイトルRe^6: マウス直下の文字読み取り
記事No11519
投稿日: 2015/10/25(Sun) 00:06
投稿者おおしろ
返信有り難うございます。

> 操作対象のアプリは限定されていますか?
現在詳詳細は決まっていません。
クッリクやドラックなしにマウスオーバーで翻訳したいと思っているだけです。


色々と助かります。
もう少し頑張ってみようと思います。
またわからないことがあれば宜しくお願い致します。

[ツリー表示へ]
タイトルRe^3: マウス直下の文字読み取り
記事No11514
投稿日: 2015/10/23(Fri) 11:14
投稿者魔界の仮面弁士
> これを1単語取得(英文を想定しています)というのはどのように制作したらよいのでしょうか?

アプリケーションあるいは対象コントロールの作成者が、
単語単位のユーザー補助オブジェクトを公開していないかぎり、
UI Automation や Accessible Object 経由では判断できないでしょう。


ひとまず、文章を単語単位で区切るだけなら何とでもなりますが(下記参照)、
その単語がマウス座標下にあるものかどうかの判断まで必要となると厳しいですね。


Imports System.Text.RegularExpressions
Public Class Form1

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim 英文 As String = TextBox1.Text

        ListBox1.Items.Clear()
        For Each m As Match In Regex.Matches(英文, "\w+", RegexOptions.Multiline)
            ListBox1.Items.Add(m.Value)
        Next
    End Sub
End Class


どうしても特定座標下にある単語を抽出したいのなら、画像解析してみるとか。
http://www.slideshare.net/TakeshiHasegawa1/20151016ssmjpikalog

[ツリー表示へ]
タイトルRe^4: マウス直下の文字読み取り
記事No11516
投稿日: 2015/10/23(Fri) 16:03
投稿者おおしろ
魔界の仮面弁士さん


返信ありがとうございます。
やはり取得は厳しそうですか。。。
URLの画像認識も拝見させていただきましたが、
とても自分の手に負える作業ではなさそうです(笑
ありがとうございました。

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


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

.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

[ツリー表示へ]
タイトルRe^2: マウス直下の文字読み取り
記事No11517
投稿日: 2015/10/23(Fri) 16:04
投稿者おおしろ
> 掲示板に表示される際には、自動的に補われるので気にしなくて OK です。
そうなんですね。覚えておきます。


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

ありがとうございます!
とても参考になります!

[ツリー表示へ]