サンプル投稿用掲示板 VB2005 〜 用トップページ VB6.0 用 トップページ
- 日時： 2010/01/07 12:27
- 名前： 花ちゃん
- ***********************************************************************************
* カテゴリー：[グリッド関係][マウス][] *
* キーワード：MSHFlexGrid,イベント,マウスホイール,スクロール,ホイールマウス *
***********************************************************************************
タイトル ： Re: WebBrowser Control 上で Click イベントを取得したい。
記 事 No ： 13597
投 稿 日 ： 2009/04/15(Wed) 23:01
投 稿 者 ： 魔界の仮面弁士
上記の魔界の仮面弁士さんの投稿を見て面白そうだったので試して見ました。
プロジェクト→参照設定で DirectX 8 for Visual Basic Type Library にチェックを入れて
おいて下さい。
尚、Vista 環境では、dx8vb.dll が入っていないようなので、下記サイトの記載要領で実行
する事ができます。
Microsoft ダウンロード センター
http://www.microsoft.com/downloads/details.aspx?FamilyID=d473b1e4-967a-47d0-96f0-6d70569c9800&DisplayLang=ja
http://shadowwarehouse.tuzikaze.com/MyProg/vista.htm
http://www.google.co.jp/search?hl=ja&q=Vista+DX8VB.DLL&lr=lang_ja
(上記関して詳しくは知りませんので、各自の責任の元で実施願います。)
一応、VB6.0(SP6) WindowsXP(SP2)/Windows Vista で動作を確認しております。
-----------------------------------------------------------------------------------
投稿日 ： 2009/04/19(Sun) 14:30
回答者 ： 花ちゃん
-----------------------------------------------------------------------------------
Form に MSFlexGrid1 を貼り付けて下記コードを試して見て下さい。
(動作確認用のコードなので、最低限のエラーチェックしかしておりませんし、簡易モード
での設定となっております)
Option Explicit
Implements DirectXEvent8
Private oDX As DxVBLibA.DirectX8
Private oDI As DxVBLibA.DirectInput8
Private oDIDevM As DxVBLibA.DirectInputDevice8
Private hEvent As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Const WM_VSCROLL = &H115
Private Const SB_LINEUP = 0&
Private Const SB_LINEDOWN = 1&
Private Sub Form_Load()
With MSFlexGrid1
.Cols = 8
.Rows = 100
.RowHeightMin = 300
End With
Dim i As Long
For i = 1 To MSFlexGrid1.Rows - 1
MSFlexGrid1.TextMatrix(i, 0) = i
Next i
Set oDX = New DxVBLibA.DirectX8
Set oDI = oDX.DirectInputCreate()
Set oDIDevM = oDI.CreateDevice("GUID_SysMouse")
oDIDevM.SetCommonDataFormat DIFORMAT_MOUSE2
oDIDevM.SetCooperativeLevel Me.hWnd, DISCL_NONEXCLUSIVE Or DISCL_FOREGROUND
Dim diprop As DxVBLibA.DIPROPLONG
With diprop
.lHow = DIPH_DEVICE
.lObj = 0
.lData = 8
End With
oDIDevM.SetProperty "DIPROP_BUFFERSIZE", diprop
hEvent = oDX.CreateEvent(Me)
oDIDevM.SetEventNotification hEvent
End Sub
Private Sub DirectXEvent8_DXCallback(ByVal EventId As Long)
If EventId <> hEvent Then
Exit Sub
End If
Dim devdata(7) As DxVBLibA.DIDEVICEOBJECTDATA
Dim datacnt As Long
On Error Resume Next
datacnt = oDIDevM.GetDeviceData(devdata, DIGDD_DEFAULT)
If Err.Number <> 0 Then
datacnt = 0
oDIDevM.Acquire
End If
On Error GoTo 0
Dim i As Long
For i = 0 To datacnt - 1
If devdata(i).lOfs = DIMOFS_Z Then
Dim j As Long
For j = 1 To 3
If devdata(i).lData < 0 Then
SendMessage MSFlexGrid1.hWnd, WM_VSCROLL, SB_LINEDOWN, ByVal 0&
Else
SendMessage MSFlexGrid1.hWnd, WM_VSCROLL, SB_LINEUP, ByVal 0&
End If
Next j
End If
Next i
End Sub
Private Sub MSFlexGrid1_GotFocus()
If Not oDIDevM Is Nothing Then
oDIDevM.Acquire
End If
End Sub
Private Sub MSFlexGrid1_LostFocus()
If Not oDIDevM Is Nothing Then
oDIDevM.Unacquire
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
oDIDevM.Unacquire
oDX.DestroyEvent hEvent
hEvent = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set oDIDevM = Nothing
Set oDI = Nothing
Set oDX = Nothing
End Sub
尚、上記とは別に、下記の現象の場合は、下記アドインが用意されています。
--------------------------------------------------------------------------------
IDE 上（VB の開発環境で）でマウス ホイール イベントが機能しない 場合の回避方法
サンプル投稿用掲示板のサポート技術情報の中で紹介しておりますが、意外と知られて
いないようなので、こちらでも紹介しておきます。
ご自分の開発環境でホィールマウスが利かない方はぜひお試し下さい。
---------------------------------------------------------------------------------
文書番号 : 837910 Visual Basic 6.0 IDE でマウス ホイール イベントが機能しない
http://support.microsoft.com/default.aspx?scid=kb;ja;837910
---------------------------------------------------------------------------------
 |
MSFlexGrid でマウスホイールによるスクロール操作を実装(VB6.0)_1