【解決時500Point】他のアプリからVB6のプログラムにフォーカスが切り替わるときに処理をしたい!


Form_Activateでは無理でした。
ぐぐってみたら、以下のサイトに参考になりそうな情報があったのですが、
私には理解できません。解決できない問題ですので、
問題解決に直結する回答には500ポイント進呈します。
回答宜しくお願いします。

http://hpcgi1.nifty.com/MADIA/VBBBS/wwwlng.cgi?print+200910/09100007.txt

(解決時Point(500Point)の評価は基本一人です。
ただし、方法以外にも解りやすい説明を加えてくれる方には大いにお礼したいと思います。)

回答の条件
  • URL必須
  • 1人2回まで
  • 13歳以上
  • 登録:2010/10/29 23:57:15
  • 終了:2010/11/01 11:34:45

ベストアンサー

id:heke2mee No.3

heke2mee回答回数162ベストアンサー獲得回数432010/10/30 14:57:46

ポイント500pt

こちらを参考に作ってみました

http://homepage1.nifty.com/rucio/main/tyukyu/tyukyu9.htm

サブクラス化してるので

BeginSubClassとEndSubClassはペアで使用してください。

フォームのロード時にBeginSubClass、クローズ時にEndSubClassを呼び出すように

変更してください

詳しくは先ほどのURLを読んでください


こちらはForm1に作成
ボタン2つとテキストボックスを画面に貼り付けています。


Private Sub Command1_Click()
    Call BeginSubClass(Form1)
End Sub

Private Sub Command2_Click()
    Call EndSubClass(Form1)
End Sub



こちらは標準モジュール


'□API関数
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'□SetWindowLongで使用
Private Const GWL_WNDPROC = -4

'□メッセージ
Private Const WM_CONTEXTMENU = &H7B '右クリック
Public Const WM_ACTIVE As Long = &H6

Public Const WA_INACTIVE As Long = &H0
Public Const WA_ACTIVE As Long = &H1
Public Const WA_CLICKACTIVE As Long = &H2



'□コレクション すべてウィンドウハンドルがキー
Dim colDProc As Collection '現在サブクラス化されているコントロールの元のWindowsProcのアドレス
'■WindowProc
'■機能:メッセージを横取りする。
'■備考:この関数はコールバック関数なので定義を変えてはいけない!
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim DefaultProc As Long
    Dim HiWord As Integer
    Dim LowWord As Integer

    Select Case uMsg

        Case WM_CONTEXTMENU '右クリック
            Exit Function
            
                             
        Case WM_ACTIVE
            Call DWordToWord(wParam, HiWord, LowWord)
            Select Case LowWord
            Case WA_INACTIVE
                    Form1.Text1.Text = "WA_INACTIVE"
            Case WA_ACTIVE
                    Form1.Text1.Text = "WA_ACTIVE"
            Case WA_CLICKACTIVE
                    Form1.Text1.Text = "WA_CLICKACTIVE"
            End Select

    End Select

CONTINUE:
    '引当のWindowProcへメッセージを回す。
    DefaultProc = colDProc(CStr(hWnd))
    WindowProc = CallWindowProc(DefaultProc, hWnd, uMsg, wParam, lParam)

End Function


Private Sub DWordToWord(DoubleWord As Long, HiWord As Integer, LowWord As Integer)
 
    If (DoubleWord And &HFFFF&) > &H7FFF Then
        LowWord = (DoubleWord And &HFFFF&) - &H10000
    Else
        LowWord = DoubleWord And &HFFFF&
    End If
 
    HiWord = (DoubleWord And &HFFFF0000) \ &H10000
 
End Sub


'■BeginSubClass
'■機能:サブクラス化を開始する。
Public Sub BeginSubClass(frm As Form)

    Static bAlready As Boolean
    Dim DefaultProc As Long

    If Not bAlready Then
        Set colDProc = New Collection
        bAlready = True
    End If

    'サブクラス化実行
    DefaultProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf WindowProc)

    '元のWindowProcのアドレスを保存
    colDProc.Add DefaultProc, CStr(frm.hWnd)

End Sub
'■EndSubClass
'■機能:サブクラス化を終了します。
Public Sub EndSubClass(frm As Form)

    Dim Ret As Long
    Dim DefaultProc As Long

    'WindowProcのアドレスを元に戻す。
    DefaultProc = colDProc(CStr(frm.hWnd))
    Ret = SetWindowLong(frm.hWnd, GWL_WNDPROC, DefaultProc)
    colDProc.Remove CStr(frm.hWnd)

End Sub

id:harunoharuno

回答ありがとうございます。

問題は解決しました。助かりました。

VBでもシステムフックができたのですね。

教えていただいたコーディングを参考に今後、他のWindowsイベントを読み取る

こともできそうだと感じました。

2010/11/01 11:09:52

その他の回答(5件)

id:windofjuly No.1

うぃんど回答回数2625ベストアンサー獲得回数11492010/10/30 08:36:52

ポイント100pt

コメント欄非表示なので回答欄で失礼します

(VB6環境は準備できません。ごめんなさい)

 

Form_Activate()ではなくForm_GotFocus()を試してみてください

 

URLは同じサイトでのやりとりです

http://hpcgi1.nifty.com/MADIA/VBBBS/wwwlng.cgi?print+200508/0508...

id:harunoharuno

回答ありがとうございます。

残念ながら

Form_GotFocusでは解決できませんでした。

2010/11/01 10:40:25
id:tasklight No.2

tasklight回答回数323ベストアンサー獲得回数402010/10/30 08:50:25

ポイント100pt

「他のアプリからVB6のプログラムにフォーカスが切り替わるとき」の条件がよく分からないのですが、そのプログラムのフォームがアクティブになる(ウィンドウが最前面に来る)時を調べたいのであれば、ターゲットのフォームのTopMost プロパティ がTRUEかどうかで判断します。

id:harunoharuno

回答ありがとうございます。

しかし、プロパティの判定方法にはループを使いますよね。

PCの負担を抑えたいし、繰り返しの待ちは書いたことがないのでループし続けるのには若干抵抗を感じるのですが、

実現方法が見つからない場合に試してみるのも手ですね。

2010/10/30 11:05:33
id:heke2mee No.3

heke2mee回答回数162ベストアンサー獲得回数432010/10/30 14:57:46ここでベストアンサー

ポイント500pt

こちらを参考に作ってみました

http://homepage1.nifty.com/rucio/main/tyukyu/tyukyu9.htm

サブクラス化してるので

BeginSubClassとEndSubClassはペアで使用してください。

フォームのロード時にBeginSubClass、クローズ時にEndSubClassを呼び出すように

変更してください

詳しくは先ほどのURLを読んでください


こちらはForm1に作成
ボタン2つとテキストボックスを画面に貼り付けています。


Private Sub Command1_Click()
    Call BeginSubClass(Form1)
End Sub

Private Sub Command2_Click()
    Call EndSubClass(Form1)
End Sub



こちらは標準モジュール


'□API関数
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'□SetWindowLongで使用
Private Const GWL_WNDPROC = -4

'□メッセージ
Private Const WM_CONTEXTMENU = &H7B '右クリック
Public Const WM_ACTIVE As Long = &H6

Public Const WA_INACTIVE As Long = &H0
Public Const WA_ACTIVE As Long = &H1
Public Const WA_CLICKACTIVE As Long = &H2



'□コレクション すべてウィンドウハンドルがキー
Dim colDProc As Collection '現在サブクラス化されているコントロールの元のWindowsProcのアドレス
'■WindowProc
'■機能:メッセージを横取りする。
'■備考:この関数はコールバック関数なので定義を変えてはいけない!
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim DefaultProc As Long
    Dim HiWord As Integer
    Dim LowWord As Integer

    Select Case uMsg

        Case WM_CONTEXTMENU '右クリック
            Exit Function
            
                             
        Case WM_ACTIVE
            Call DWordToWord(wParam, HiWord, LowWord)
            Select Case LowWord
            Case WA_INACTIVE
                    Form1.Text1.Text = "WA_INACTIVE"
            Case WA_ACTIVE
                    Form1.Text1.Text = "WA_ACTIVE"
            Case WA_CLICKACTIVE
                    Form1.Text1.Text = "WA_CLICKACTIVE"
            End Select

    End Select

CONTINUE:
    '引当のWindowProcへメッセージを回す。
    DefaultProc = colDProc(CStr(hWnd))
    WindowProc = CallWindowProc(DefaultProc, hWnd, uMsg, wParam, lParam)

End Function


Private Sub DWordToWord(DoubleWord As Long, HiWord As Integer, LowWord As Integer)
 
    If (DoubleWord And &HFFFF&) > &H7FFF Then
        LowWord = (DoubleWord And &HFFFF&) - &H10000
    Else
        LowWord = DoubleWord And &HFFFF&
    End If
 
    HiWord = (DoubleWord And &HFFFF0000) \ &H10000
 
End Sub


'■BeginSubClass
'■機能:サブクラス化を開始する。
Public Sub BeginSubClass(frm As Form)

    Static bAlready As Boolean
    Dim DefaultProc As Long

    If Not bAlready Then
        Set colDProc = New Collection
        bAlready = True
    End If

    'サブクラス化実行
    DefaultProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf WindowProc)

    '元のWindowProcのアドレスを保存
    colDProc.Add DefaultProc, CStr(frm.hWnd)

End Sub
'■EndSubClass
'■機能:サブクラス化を終了します。
Public Sub EndSubClass(frm As Form)

    Dim Ret As Long
    Dim DefaultProc As Long

    'WindowProcのアドレスを元に戻す。
    DefaultProc = colDProc(CStr(frm.hWnd))
    Ret = SetWindowLong(frm.hWnd, GWL_WNDPROC, DefaultProc)
    colDProc.Remove CStr(frm.hWnd)

End Sub

id:harunoharuno

回答ありがとうございます。

問題は解決しました。助かりました。

VBでもシステムフックができたのですね。

教えていただいたコーディングを参考に今後、他のWindowsイベントを読み取る

こともできそうだと感じました。

2010/11/01 11:09:52
id:ardarim No.4

ardarim回答回数892ベストアンサー獲得回数1422010/10/30 15:34:42

ポイント500pt

Form_Activateは、同じVB内のフォームの切り替えのときのみ発生するので、他のアプリとの切り替えには使えません。

またForm_GotFocusは、フォーム内に入力フォーカスを持つコントロール(例えばエディットコントロールなど)が存在しないときだけ、発生します。


以上のようにVBが提供する機能だけでは完全な解決は難しいので、Windowsのネイティブ機能(Win32 APIレベル)を利用せざるを得ません。

VBユーザには難しいかもしれませんが、以下のように書けば実現できるはずです。


簡単に説明すると、フォームのイベントを処理するWindowsネイティブ処理(ウィンドウプロシージャと呼びます)をVBの処理から自分のFunctionにフック(横取り)して、WM_SETFOCUSというフォームにフォーカスが当たったときの処理を行います。(Windowsの用語ではウィンドウのサブクラス化と呼びます)

よくわからない場合は、とりあえず呪文だと思ってそのままコピペして必要な部分(フォーカスが当たったときの処理)だけを注意深く変更してください。よくわからないまま色々いじってしまうと、アプリケーションがフリーズしたり異常終了したりする危険がありますので注意してください。


コードモジュール部分(フォーム上ではなく、*.basの部分)に以下のコードを書きます。

Public Declare Function GetWindowLongW Lib "user32" (ByVal hwd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLongW Lib "user32" (ByVal hwd As Long, ByVal nIndex As Long, ByVal dt As Long) As Long
Public Declare Function CallWindowProcW Lib "user32" (ByVal oldproc As Long, ByVal hwd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Const WM_SETFOCUS As Long = &H7
Public Const GWL_WNDPROC As Long = -4

Public OldWndProc As Long

Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    If message = WM_SETFOCUS Then
        'フォーカスを受け取ったときの処理をここに書く
    End If

    If OldWndProc <> 0 Then
        '元のVBのウィンドウプロシージャに制御を渡す
        WndProc = CallWindowProcW(OldWndProc, hwnd, uMsg, wParam, lParam)
    End If

End Function

Form_Loadに以下の処理を追加します。

    'フォームのウィンドウプロシージャをVBから自製のWndProcに変更する
    '元のVBのウィンドウプロシージャはOldWndProcに保存する
    OldWndProc = SetWindowLongW(Hwnd, GWL_WNDPROC, AddressOf WndProc)
    If OldWndProc = 0 Then
        'エラー処理
    End If

またForm_Unloadに以下の処理を追加します。

    If SetWindowLongW(Hwnd, GWL_WNDPROC, OldWndProc) = 0 Then
        'エラー処理
    Else
        OldWndProc = 0
    End If

フォームが複数ある場合は、OldWndProc、WndProcをフォームの数だけ別々に用意する必要があります。


なおすみませんが、もはや手元にVB6環境がないので動作確認はできていません。Excel VBAでは一部変更して確認はしましたが完全にVB6と一緒ではないので確信はできません。

フォローはできると思いますので質問の設定でコメント欄をオープンにしておいていただけるとよいと思います。


こちらに解説がありますが、Win32の知識がないと完全な理解は難しいかもしれません。

VB テクニック編31 - サブクラスコントロール、フックプロシジャ、メッセージ処理 - SAK Streets

VB テクニック編35 - メッセージ送受信処理、RegisterWindowMessage - SAK Streets

下のリンク先では、VBのコードサンプル(subcluss.lzh)がダウンロードできます。

id:harunoharuno

丁寧に解説をが添えて回答いただきありがとうございます。。

heke2mee様に既に回答いただいていましたが

ソースコードも大変参考になりました。

複数画面にはそれぞれWndProcが必要なんですね。なるほど。

Form_GotFocusについてもコメントいただきありがたいです。

2010/11/01 11:30:36
id:k-tan2 No.5

k-tan2回答回数401ベストアンサー獲得回数482010/10/30 22:15:21

ポイント200pt

質問文のURLの最後に書いてるように、WindowsAPIのWndProcをつかって

直接メッセージを取得しない限りできません。

どんなにがんばってもVBだけではできません。

以下を参考にしてみてください。

http://tokyo.cool.ne.jp/kanain/APIHTM/GetMsg.html

まずはサンプルのようにタイトルバーのクリックの場合が動作することを確認して見てください。

基本は同じです。

id:harunoharuno

回答ありがとうございます。

2010/11/01 11:33:13
id:hgijgbnfhfg No.6

hgijgbnfhfg回答回数116ベストアンサー獲得回数02010/10/30 22:59:52

(はてなにより削除しました)
  • id:harunoharuno
    heke2mee様
    動作するものを作っていただきありがとうございました。
    とりあえず500Pointで評価しましたが、不十分と思えるので
    後日+500Point送付いたします。たいへん助かりました。
    今後とも宜しくお願いします。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません