tagCANDY CGI VBレスキュー(花ちゃん) - MSFlexGrid でマウスホイールによるスクロール操作を実装(VB6.0) - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
MSFlexGrid でマウスホイールによるスクロール操作を実装(VB6.0)
元に戻る スレッド一覧へ 記事閲覧
このページ内の検索ができます。(AND 検索や OR 検索のような複数のキーワードによる検索はできません。)

MSFlexGrid でマウスホイールによるスクロール操作を実装(VB6.0) [No.228の個別表示]
     サンプル投稿用掲示板  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

---------------------------------------------------------------------------------
メンテ

Page: 1 |

MSFlexGrid でマウスホイールによるスクロール操作を実装(VB6.0)_1  (No.1の個別表示) [スレッド一覧へ]
日時: 2009/04/20 17:21
名前: 魔界の仮面弁士

***********************************************************************************
* カテゴリー:[グリッド関係][マウス][]                                            *
* キーワード:MSHFlexGrid,イベント,マウスホイール,スクロール,ホイールマウス       *
***********************************************************************************


> 上記の魔界の仮面弁士さんの投稿を見て面白そうだったので試して見ました。
> -----------------------------------------------------------------------------------
> 投稿日 : 2009/04/19(Sun) 14:30
> 回答者 : 花ちゃん  

さらに手を加えて、回転速度を検出できるタイプのマウスをサポートしてみました。
同じ量を回転させた場合は、素早く回すほど、より多くスクロールします。


> 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

    Const WHEEL_DELTA As Long = 120
    Dim i As Long
    For i = 0 To datacnt - 1
        If devdata(i).lOfs = DIMOFS_Z Then
            Dim direction As Long
            direction = IIf(devdata(i).lData < 0, SB_LINEDOWN, SB_LINEUP)
            Dim count As Long
            count = Abs(devdata(i).lData) \ WHEEL_DELTA
            Dim j As Long
            For j = 1 To count
                SendMessage MSFlexGrid1.hWnd, WM_VSCROLL, direction, ByVal 0&
            Next
        End If
    Next i

> End Sub
メンテ

Page: 1 |

 投稿フォーム               スレッド一覧へ
題  名 スレッドをトップへソート
名  前
パスワード (記事メンテ時に使用)
投稿キー (投稿時 投稿キー を入力してください)
コメント

   クッキー保存   
スレッド一覧へ