goo blog サービス終了のお知らせ 

Visual Studio VB.NET Tips 集

プログラミング集です。
メインはVisual Basic .NET でございます。

MSFlexGridでマウススクロール実現

2011-04-02 13:16:20 | 日記
Visual Basic6.0(VB6.0)でMSFlexGridのスクロールを有効にしたいという方は
こちらのサンプルを参考にされてみてはいかがでしょうか。
【仕組み】
1、WinProc(WindowProc)関数をオーバーライドさせます。
2、マウススクロールのメッセージを取得して
3、フォーム上のMSFぇxGridにスクロールさせるメッセージを送ります。
※AddressOfについて「適切でない」というエラーメッセージが出る場合がありますが、
 AddressOfの対象関数(今回はWinProc)は.basファイルに記述しなければなりません。
 VB6.0はbasから直接フォームが参照できるので使用に関しては特に問題はありません。

Option Explicit
'----------------------------------------------------------------------------------------
'@() 使用方法(AddressOf が適切ではありません。
'' アドレスOfで指定する関数はBasに記述(Form_Loadに書けばOK)
' oad = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)
' フォーム側にはここを書くのみ
'----------------------------------------------------------------------------------------
'WinProc オーバーライド
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal PWF&, ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam As Long) As Long
'親フォームにWinProcを割当てる
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&) 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
'スクロールバーUP
Private Const SB_LINEUP = 0&
'スクロールバーDown
Private Const SB_LINEDOWN = 1&

Public Const GWL_WNDPROC = (-4)
'左ボタンクリック
Public Const WM_NCLBUTTONDOWN = &HA1
'右ボタンアップ
Public Const WM_RBUTTONUP = &H205
'マウスホイール
Public Const WM_MOUSEWHELL = &H20A

'親フォームハンドル
Public oad As Long

'WinProc 本体
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If uMsg = WM_NCLBUTTONDOWN Then
'Debug.Print "非クライアント領域(タイトルバーなど)がクリックされました"
frmAdoGridInCode.Caption = "Click"
End If

'--------------------------------------------------------------------------
'右クリックされました
'--------------------------------------------------------------------------
If uMsg = WM_RBUTTONUP Or wParam = WM_RBUTTONUP Then
frmAdoGridInCode.Caption = "→Click"
End If

'--------------------------------------------------------------------------
'マウスホイール
'--------------------------------------------------------------------------
If uMsg = WM_MOUSEWHELL Then
If wParam < 0 Then
SendMessage frmAdoGridInCode.MSHFlexGrid1.hWnd, WM_VSCROLL, SB_LINEDOWN, ByVal 2&
Else
SendMessage frmAdoGridInCode.MSHFlexGrid1.hWnd, WM_VSCROLL, SB_LINEUP, ByVal 2&
End If
End If

'--------------------------------------------------------------------------
'通常の処理
'--------------------------------------------------------------------------
WindowProc = CallWindowProc(oad, hWnd, uMsg, wParam, lParam)
End Function

最新の画像もっと見る