タブコントロール作りにチャレンジ

概要

タブコントロール
今回のサンプルの実行画面
皆さんこんにちは。
今回はコモンコントロールの中のタブコントロールを作ってみたいと思います。
タブコントロールがどの位便利かということについては、もはや説明は不要でしょう。

VBのコントロールにも当然タブコントロールはありますが、今回はあえて自分で作ってみましょう。

タブコントロールの作成

タブコントロールを作るにはCreateWindowEx()関数を使います。
ウィンドウクラスはWC_TABCONTROLを指定します。
一般的にタブコントロールは子ウィンドウなのでWS_CHILDを指定します。
あとはWS_VISIBLEを忘れずに。コードは下のようになります。
'タブコントロール作成
hTabWnd = CreateWindowEx(0, WC_TABCONTROL, "", _
    WS_VISIBLE Or WS_TABSTOP Or WS_CHILD, _
    0, 0, Me.ScaleWidth, Me.ScaleHeight, Me.hWnd, IDM_TAB1, App.hInstance, 0)

作成直後のタブコントロールは空っぽなのでタブを追加していきます。
それぞれのタブを定義するのにはTCITEM構造体を使います。

Type TCITEM
    mask As Long                'どのパラメータを有効にするかのマスクフラグ
    dwState As Long             '現在のタグの状態を取得
    dwStateMask As Long         'dwStateのマスクフラグ
    pszText As String           'タブ内に表示する文字列
    cchTextMax As Long          '同、バイト数
    iImage As Long              '同、イメージ(不要のとき-1)
    lParam As Long              'アプリケーション定義の値
End Type
この構造体のmaskに格納される値によってdwState,pszText,iImage,lParamの各フィールドに
含まれる値が有効かどうかが決まります。
maskに指定できる定数は以下のように定義されています。
この値を1つまたは組み合わせて使います。
Public Const TCIF_TEXT = &H1                'pdzTextにデータが含まれる
Public Const TCIF_IMAGE = &H2               'hImageにデータが含まれる
Public Const TCIF_STATE = &H10              'dwStateにデータが含まれる
Public Const TCIF_PARAM = &H8               'lParamにデータが含まれる
タグを作成するときはdwStateは使いません。
iImageはイメージコントロール内のインデックスを指定します。
今回のサンプルではイメージを関連付けていませんが、方法だけ概説しておきます。
@イメージコントロールを別途作成する
Aイメージを追加する
BTCM_SETIMAGELISTメッセージを使ってタブコントロールに関連付ける

具体的なサンプルは特に用意していません。
難しくはないので興味があったら調べてみてください。

メッセージの送信

タブコントロールに決められた定数を送ると、さまざまな情報を取得したり設定したりすることができます。
それらの定数はSendMessage()関数で送ればいいだけなのですが、マクロが定義されているのでそれを使うのが一般的です。
今回はよく使うマクロだけリストアップしてVBに変換してみました。
Public Sub TabCtrl_Adjustrect _
    (ByVal hTabWnd As Long, ByVal operation As Boolean, lpRect As RECT)
    'タブコントロールの表示領域のサイズを取得
    'operation=true     タブコントロール領域の表示領域を渡す
    'operation=false    ウィンドウ矩形のサイズを取得する
    Call SendMessageAny(hTabWnd, TCM_ADJUSTRECT, operation, lpRect)
End Sub

Public Function TabCtrl_DeleteAllItems(ByVal hTabWnd As Long) As Long 'タブコントロールのすべてのアイテムの削除 TabCtrl_DeleteAllItems = SendMessage(hTabWnd, TCM_DELETEALLITEMS, 0, 0) End Function
Public Function TabCtrl_DeleteItem _ (ByVal hTabWnd As Long, ByVal nIndex As Long) As Long 'タブコントロールのアイテムを削除 TabCtrl_DeleteItem = SendMessage(hTabWnd, TCM_DELETEITEM, nIndex, 0) End Function
Public Function TabCtrl_GetCurSel(ByVal hTabWnd As Long) As Long '現在選択されているアイテムのインデックスを取得する TabCtrl_GetCurSel = SendMessage(hTabWnd, TCM_GETCURSEL, 0, 0) End Function
Public Function TabCtrl_GetItemCount(ByVal hTabWnd As Long) As Long 'タブコントロール内のアイテム数を取得 TabCtrl_GetItemCount = SendMessage(hTabWnd, TCM_GETITEMCOUNT, 0, 0) End Function
Public Function TabCtrl_InsertItem _ (ByVal hTabWnd As Long, ByVal nIndex As Long, lpTCITEM As TCITEM) As Long 'タブコントロールの指定の位置にアイテムを挿入する TabCtrl_InsertItem = SendMessageAny(hTabWnd, TCM_INSERTITEM, nIndex, lpTCITEM) End Function
Public Function TabCtrl_SetCursel _ (ByVal hTabWnd As Long, ByVal nIndex As Long) As Long '指定のアイテムを選択する TabCtrl_SetCursel = SendMessage(hTabWnd, TCM_SETCURSEL, nIndex, 0) End Function
Public Function TabCtrl_SetItem _ (ByVal hTabWnd As Long, ByVal nIndex As Long, lpTCITEM As TCITEM) As Long '指定のアイテムについての情報を設定する TabCtrl_SetItem = SendMessageAny(hTabWnd, TCM_SETITEM, nIndex, lpTCITEM) End Function

メッセージの横取り

メッセージが送信できればタブコントロールを作ることはできますが、メッセージを受け取ることはできません。
例えば、マウスがクリックされたとかタブページが切り替えられたなどです。
特に後者はそのメッセージが取得できないと致命的です。

ところが困ったことにVBにはメッセージを取得する仕組みがありません。
何故かって?実はメッセージの処理をすると凄く面倒だからです。
そのため、VBではウィンドウに送られてくるメッセージは全てVBが受け取って処理してしまいます。

フックの説明
フック処理の説明図
そこで今回はメッセージをフック(=横取り)することにしました。
いくつか方法はありますが、今回は一番簡単な方法でフックします。
まずFormのウィンドウに関連付けられているウィンドウプロシージャのアドレスをSetWindowLong()関数で書き換えします。
そのときに戻り値で前に設定されていた値、つまりVBのFormの本来のウィンドウプロシージャのアドレスが戻るので、グローバル変数に格納しておきます。

こうすれば自前で定義したウィンドウプロシージャにメッセージが送られてきます。
そのメッセージを元に処理したあと、CallWindowProc()関数でVBに処理を渡します。

最後にウィンドウが閉じられるときにウィンドウプロシージャのアドレスを最初に設定されていたアドレスに設定しなおせば終了です。
これをコードにすると次のようになります。
Private Sub Form_Load()
    'ウィンドウプロシージャのアドレスを変更する
    hOrgWndProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, ChangeAddressOf(AddressOf WndProc))
End Sub

Private Sub Form_Unload(Cancel As Integer) 'ウィンドウプロシージャのアドレスを元に戻す Call SetWindowLong(Me.hWnd, GWL_WNDPROC, hOrgWndProc) End Sub
Public Function WndProc(ByVal hWnd As Long, ByVal msg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long : (自前の処理をする) : WndProc = CallWindowProc(hOrgWndProc, hWnd, msg, wParam, lParam) End Function

メッセージを受け取る

タブコントロールからのメッセージはWM_NOTIFYメッセージで送られてきます。
lParamにはNMHDR構造体のアドレスが送られてくるので、CopyMemory()関数でコピーして内容を取得します。

送られてくるメッセージもいくつか定義されていますが、今回はシンプルにタブが切り替わったときだけ処理することにします。
タブが切り替わったときに送られてくるメッセージはTCN_SELCHANGEです。
このメッセージの受信をコードにすると下のようになります。
Public Function WndProc(ByVal hWnd As Long, ByVal msg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    'ユーザー定義のウィンドウプロシージャ
    Select Case msg
        Case WM_NOTIFY
            Dim lpNMHDR As NMHDR, num As Long
            Call CopyMemory(lpNMHDR, ByVal lParam, Len(lpNMHDR))
            If lpNMHDR.code = TCN_SELCHANGE Then
                     msgbox "ページが切り替わった"
            End If
     End Select
     WndProc = CallWindowProc(hOrgWndProc, hWnd, msg, wParam, lParam)
End Function

サンプルコード

ここではタブコントロールを使った簡単なプログラムを紹介します。
ここまでの説明を理解するうえで最低限必要なコードの部分だけを紹介します。
全部のコードを見たい場合には、ページ下部からダウンロードして下さい。
実行画面
今回のサンプルの実行画面

Form1
Private Const IDM_TAB1 = &H100                      'TABコントロールのID
Private Sub Form_Load()
    '============================
    '   ウィンドウの初期化
    '============================
    Dim hTabWnd As Long
    Dim tci As TCITEM
    
    'タブコントロール作成
    hTabWnd = CreateWindowEx(0, WC_TABCONTROL, "", _
            WS_VISIBLE Or WS_TABSTOP Or WS_CHILD, _
            0, 0, Me.ScaleWidth, Me.ScaleHeight, Me.hWnd, IDM_TAB1, App.hInstance, 0)
    
    'アイテムの追加
    tci.mask = TCIF_TEXT
    tci.iImage = -1
    
    tci.pszText = "1ページ"
    Call TabCtrl_InsertItem(hTabWnd, 0, tci)

    tci.pszText = "2ページ"
    Call TabCtrl_InsertItem(hTabWnd, 1, tci)

    tci.pszText = "3ページ"
    Call TabCtrl_InsertItem(hTabWnd, 2, tci)
    
    'ウィンドウプロシージャのアドレスを変更する
    hOrgWndProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, ChangeAddressOf(AddressOf WndProc))
End Sub

Private Sub Form_Unload(Cancel As Integer) '============================ ' ウィンドウの破棄 '============================ 'ウィンドウプロシージャのアドレスを元に戻す Call SetWindowLong(Me.hWnd, GWL_WNDPROC, hOrgWndProc) End Sub
Module2
Public Function WndProc(ByVal hWnd As Long, ByVal msg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    'ユーザー定義のウィンドウプロシージャ
    Select Case msg
        Case WM_NOTIFY
            Dim lpNMHDR As NMHDR, num As Long
            Call CopyMemory(lpNMHDR, ByVal lParam, Len(lpNMHDR))
            If lpNMHDR.code = TCN_SELCHANGE Then
                'タブコントロールのアイテム選択が変化した
                num = TabCtrl_GetCurSel(lpNMHDR.hwndFrom)
                Call OutMessage(lpNMHDR.hwndFrom, 40, 100, _
                        (num + 1) & "ページ目が選択されました")
           End If
    End Select
    WndProc = CallWindowProc(hOrgWndProc, hWnd, msg, wParam, lParam)
End Function

Public Sub OutMessage(ByVal hWnd As Long, ByVal x As Long, _ ByVal y As Long, ByVal lpText As String) '指定のウィンドウのデバイスコンテキストに文字列を描画 Dim hdc As Long hdc = GetDC(hWnd) Call SetBkColor(hdc, RGB(255, 255, 255)) Call TextOut(hdc, 40, 100, _ lpText, LenB(StrConv(lpText, vbFromUnicode))) Call ReleaseDC(hWnd, hdc) End Sub

ダウンロード(TabControl.lzh 3.98KB)