[リストへもどる]   [VBレスキュー(花ちゃん)]
一括表示

投稿時間:2005/06/03(Fri) 19:07
投稿者名:ダンボ
URL :
タイトル:
hWndからコントロールを知る方法
皆さんこんにちは。
VB6で作成したAPPにマウスホィール機能を付けるためにサブタスク化しています。
下記のコード(主要部のみ断片)で、多種類のコントロールに対しては対処しているのですが、
複数のコントロールに対しては使えません。(CNTがひとつしかないから)
これを改善しようとしていますが、SubClassProcにメッセージが来たときにわかるのはコントロールのhWnd。
そのhWndから対応するコントロールオブジェクトを引っ張り出す方法がわかりません。
メッセージの度に、そのフォームの全コントロールを調べてhWndの一致するものを選ぶというのも何だし。
もっとスマートな方法があると思うのですが。

Dim CNT As Control

Public Function WheelOpen(usrCNT As Control) As Long
Dim p_hWnd As Long          'original Handle
    Set CNT = usrCNT
    p_hWnd = SetWindowLong(usrCNT.hWnd, GWL_WNDPROC, AddressOf SubClassProc)
    rc = SetWindowLong(usrCNT.hWnd, GWL_USERDATA, p_hWnd)
    WheelOpen = p_hWnd
End Function

Private Function SubClassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long,
ByVal lParam As Long) As Long
        Select Case uMsg
        Case WM_MOUSEWHEEL
            If wParam < 0 Then
               WheelUp
            Else
               WheelDown
            End If
        Case Else
            SubClassProc = CallWindowProc(GetWindowLong(hWnd, GWL_USERDATA), hWnd, uMsg,
wParam, lParam)
        End Select
End Function

Private Sub WheelUp()
With CNT
Select Case TypeName(CNT)
    Case "MSFlexGrid"
        If .Rows > 1 Then
            If .Rows <= .TopRow + 1 Then
                If .Rows - 3 < 0 Then
                    .TopRow = 1
                Else
                    .TopRow = .TopRow - 3
                End If
            Else
                .TopRow = .TopRow + 1
            End If
        End If
    Case "ListBox"
    Case "PictureBox"

投稿時間:2005/06/04(Sat) 00:36
投稿者名:のびた
Eメール:
URL :
タイトル:
Re: hWndからコントロールを知る方法
結局
>メッセージの度に、そのフォームの全コントロールを調べてhWndの一致するものを選ぶというのも何だ
し。
この方法になりますが、一つの案としてコード量を少なくすますのであればCollectionオブジェクト
を利用して検索を簡略化する方法が考えられます。

フォームのロード時にCollectionオブジェクトに、ウィンドウハンドルの値をキーとして
参照したいコントロールオブジェクトを全て登録しておけばSubWindowProcでは
Collectionオブジェクトのインデックスにウィンドウハンドルの値を入れれば
コントロールオブジェクトへの参照が得られることになります。

オブジェクトのクラス名から決めうちでコントロールオブジェクトが求められるのであれば
GetClassNameでウィンドウハンドルからオブジェクトのクラス名は取得できますが。

投稿時間:2005/06/04(Sat) 14:57
投稿者名:Starfish
Eメール:
URL :
タイトル:
Re: hWndからコントロールを知る方法
 WM_MOUSEWHEELは、フォーカスを持ったコントロールに送られてくるので、ActiveControl
をスクロールする方法もあるのではないでしょうか。

投稿時間:2005/06/05(Sun) 14:16
投稿者名:K.J.K.
Eメール:akiya@koalanet.ne.jp
URL :
タイトル:
Re: hWndからコントロールを知る方法
よく使われる方法としては、SetWindowLongやSetPropでオブジェクト
を書き込んでおいて、GetWindowLongやGetPropで読み出す、といった
ところでしょうか。

投稿時間:2005/06/06(Mon) 07:17
投稿者名:ダンボ
URL :
タイトル:
【お礼】hWndからコントロールを知る方法
のびたさん、Starfishさん、K.J.K.さん どうもありがとうございました。まとめレスで失礼します。

お3人様の話からすると、「直截的にhWndからコントロール(ポインタ?)を知ることはできない」
とすると1.WheelOpen時にCNTを登録して置け。2.SubClassProcでhWndを頼りに調べなおす。
の2方針が見えてきました。で、
1.(登録制)の手段として、
(1)Collectionオブジェクト…(のびたさん)
(2)SetWindowLong…(K.J.Kさん)
(3)SetProp…(K.J.Kさん)
(4)Redim動的なコントロール配列でもいいんじゃない?…(ダンボ追加)
2.(対象を絞り込め)
(1)ActiveControlの筈…(Starfishさん)
(2)GetClassNameでクラス名はわかるよ…(のびたさん)
(3)フォーム内のコントロールコレクションを全部あたる…(ダンボ元アイデア)
というアイデアをいただきました。個々についてもう少しだけ調べてから方針を決めますが
(というかステップ小さいのだから全部試してみたら?)
たった今は、1.(3)「登録制でSetProp」かなと予感しています。

> VB6で作成したAPPにマウスホィール機能を付けるためにサブタスク化しています。
「サブタスク化」->「サブクラス化」突っ込まれなくて良かった。。。

投稿時間:2005/06/06(Mon) 14:39
投稿者名:ダンボ
URL :
タイトル:
【再質問】コントロールオブジェクトの保存・リストア
というわけでSetPropを利用してコントロールオブジェクトの保存・リストアを
試みているのですが、オブジェクト変数の扱いに苦慮しています。
SetProp/GetPropで保存・リストアできるのはLong値なので、オブジェクトそのものは
駄目ですね。実装はおそらくインスタンスへのポインタだと思うから似てはいるけれど。
下記はテストのために何通りかコーディングしてみました。

Public Function WheelOpen(usrCNT As Control) As Long
Dim p_hWnd As Long          'original Handle
Dim rc As Long
Dim XX As Control
    p_hWnd = SetWindowLong(usrCNT.hwnd, GWL_WNDPROC, AddressOf SubClassProc)
    rc = SetWindowLong(usrCNT.hwnd, GWL_USERDATA, p_hWnd)  '元hWndを保存
(a) rc = SetProp(usrCNT.hwnd, "CNT", usrCNT)  'コントロールそのものを保存したいのだが
(b) XX = GetProp(usrCNT.hwnd, "CNT")   '実行時エラー:オブジェクト変数またはWithブロック変数が設定
されていません
(c) Set XX = GetProp(usrCNT.hwnd, "CNT")  'コンパイルエラー:型が一致しません
(d) rc = GetProp(usrCNT.hwnd, "CNT")    'エラーにはならないが戻り値は0
End Function

投稿時間:2005/06/06(Mon) 15:23
投稿者名:魔界の仮面弁士
Eメール:
URL :
タイトル:
Re: 【再質問】コントロールオブジェクトの保存・リストア
> というわけでSetPropを利用してコントロールオブジェクトの保存・リストアを
> 試みているのですが、オブジェクト変数の扱いに苦慮しています。

こういう事でよいのかな。

Option Explicit

Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Object) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Object
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long

Private Sub Form_Load()
    SetProp Me.hWnd, "Orator", Me.Text1
End Sub

Private Sub Command1_Click()
    Dim C As VB.Control
    Set C = GetProp(Me.hWnd, "Orator")
    If C Is Nothing Then
        MsgBox "取得失敗", vbExclamation
    Else
        MsgBox "Name=" & C.Name & vbCrLf & "Text=" & C.Text, vbInformation
        Set C = Nothing
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    RemoveProp Me.hWnd, "Orator"
End Sub

投稿時間:2005/06/07(Tue) 10:00
投稿者名:ダンボ
URL :
タイトル:
【解決】コントロールの保存・リストア
魔界の仮面弁士さん、どうもありがとうございました。
Declareまで例示されているのを見て一瞬親切すぎると思いましたが、それがポイントだったんですね。
外部APIをどうVBコンパイラに説明するかの宣言がDeclareの目的であると。

動作確認もできましたので、今の最終コード(主要部のみ)と勝手な寸評を付けて終わりにします。

(1)Collectionオブジェクト
 最初の1回目だけオブジェクトの準備をしなければならない特異性がちょっと嫌。
 hWndを文字列にしてキーとすれば検索性が良い(バイナリはキーにできないのかな?)
(2)SetWindowLong
 シンプルで良い。hWndにつき1つしか格納できないので、複数データを保存したいとなるとMalloc等で
 メモリ取って構造体にしてと複雑になりそう。
(3)SetProp
 キーの文字列比較で遅くなりそうだが、気兼ねなく複数データを保存できる。
(4)Redim動的なコントロール配列
 リエントラント性を考慮すると厭らしくなりそう。

Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal
lpString As String, ByVal hData As Control) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal
lpString As String) As Control
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long,
ByVal lpString As String) As Long

Public Function WheelOpen(usrCNT As Control) As Long
    If GetWindowLong(usrCNT.hWnd, GWL_USERDATA) <> 0 Then Exit Function
    rc = SetWindowLong(usrCNT.hWnd, GWL_USERDATA, SetWindowLong(usrCNT.hWnd, GWL_WNDPROC,
AddressOf SubClassProc))
    rc = SetProp(usrCNT.hWnd, "CNT", usrCNT)
End Function

Public Function WheelClose(usrCNT As Control) As Long
    If GetWindowLong(usrCNT.hWnd, GWL_USERDATA) = 0 Then Exit Function
    rc = RemoveProp(usrCNT.hWnd, "CNT")
    rc = SetWindowLong(usrCNT.hWnd, GWL_WNDPROC, SetWindowLong(usrCNT.hWnd, GWL_USERDATA, 0))
End Function

Private Function SubClassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long,
ByVal lParam As Long) As Long
    Dim C As Control
        Select Case uMsg
        Case WM_MOUSEWHEEL
            Set C = GetProp(hWnd, "CNT")