タブコントロールのタブを選択          <TOP>


GetSysColor システムの背景色を取得
CreateWindowEx ウィンドウ(コントロール)を作成
GetStockObject ストックオブジェクトのハンドルを取得
DestroyWindow CreateWindowExの解放
InitCommonControls コモンコントロールライブラリからコモンコントロールのウィンドウクラスを登録して初期化
SendMessage ウィンドウにメッセージを送信
SendMessageByLong ウィンドウにメッセージを送信


タブコントロールを作成し、 タブを選択します。

 

'================================================================
'= タブコントロールのタブを選択
'=    (CreateWindowEx4_3.bas)
'================================================================
#include "Windows.bi"

Type INITCOMMONCONTROLSEX
    dwSize As Long
    dwICC  As Long
End Type

#define COLOR_BTNFACE 15                '3Dオブジェクトの表面色
#define DEFAULT_GUI_FONT 17             'ユーザーインターフェイス用のデフォルトフォント
#define ICC_TAB_CLASSES &H8             'タブコントロール、ツールチップ
#define IDM_TAB1 &H100                  'TABコントロールのID
#define TCIF_TEXT &H1                   'pdzTextにデータが含まれる
#define TCM_INSERTITEMA &H1307          'タブ項目を追加
#define TCM_SETCURSEL &H130C            'タブを選択
#define WC_TABCONTROL "SysTabControl32" 'タブコントロール
#define WM_SETFONT &H30                 '論理フォントを設定する
#define WS_CHILD &H40000000             '親ウィンドウを持つコントロール(子ウィンドウ)を作成する
#define WS_CLIPSIBLINGS &H4000000       '兄弟関係にある子ウィンドウをクリップする
#define WS_VISIBLE &H10000000           '可視状態のウィンドウを作成する
#define TCS_HOTTRACK &H40               'マウスカーソルの下のタブを強調表示
#define TCS_TOOLTIPS &H4000             'ツールヒントコントロールが作成されTTN_NEEDTEXTを発行

Type TCITEM
    mask        As Long
    dwState     As Long
    dwStateMask As Long
    pszText     As Long
    cchTextMax  As Long
    iImage      As Long
    lParam      As Long
End Type

' システムの背景色を取得
Declare Function Api_GetSysColor& Lib "user32" Alias "GetSysColor" (ByVal nIndex&)

' ウィンドウ(コントロール)を作成
Declare Function Api_CreateWindowEx& Lib "user32" Alias "CreateWindowExA" (ByVal ExStyle&, ByVal ClassName$, ByVal WinName$, ByVal Style&, ByVal x&, ByVal y&, ByVal nWidth&, ByVal nHeight&, ByVal Parent&, ByVal Menu&, ByVal Instance&, Param&)

' ストックオブジェクトのハンドルを取得
Declare Function Api_GetStockObject& Lib "gdi32" Alias "GetStockObject" (ByVal nIndex&)

' CreateWindowExの解放
Declare Function Api_DestroyWindow& Lib "user32" Alias "DestroyWindow" (ByVal hWnd&)

' コモンコントロールライブラリからコモンコントロールのウィンドウクラスを登録して初期化
Declare Sub Api_InitCommonControls Lib "comctl32" Alias "InitCommonControls" ()

' ウィンドウにメッセージを送信
Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)

' ウィンドウにメッセージを送信
Declare Function Api_SendMessageByLong& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)

Var Shared Edit1 As Object
Var Shared Button1 As Object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared hTabs As Long

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var rgbColor As Long

    'Buttonの表面色を取得(EDE9EC)
    rgbColor = Api_GetSysColor(COLOR_BTNFACE)

    'MainFormを取得色で塗り
    SetBackColor rgbColor

    '画面を消去
    Cls

    'MainFormを表示
    ShowWindow -1
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var icc As INITCOMMONCONTROLSEX
    Var tci As TCITEM
    Var index As Long
    Var Ret As Long

    'タブの選択
    index = Val(Edit1.GetWindowtext)
    If index > 3 Then Exit Sub

    icc.dwSize = Len(icc)
    icc.dwICC = ICC_TAB_CLASSES
    Api_InitCommonControls

    Ret = Api_DestroyWindow(hTabs)

    hTabs = Api_CreateWindowEx(0, WC_TABCONTROL, "", WS_CHILD Or WS_CLIPSIBLINGS Or WS_VISIBLE Or TCS_HOTTRACK Or TCS_TOOLTIPS, 10, 20, 210, 80, GethWnd, IDM_TAB1, GethInst, ByVal 0)

    If hTabs <> 0 Then
        Ret = Api_SendMessageByLong(hTabs, WM_SETFONT, Api_GetStockObject(DEFAULT_GUI_FONT), 0)

        tci.mask = TCIF_TEXT
        tci.pszText = StrAdr("Tab1" & Chr$(0))
        Ret = Api_SendMessage(hTabs, TCM_INSERTITEMA, 0, tci)

        tci.mask = TCIF_TEXT
        tci.pszText = StrAdr("tab2" & Chr$(0))
        Ret = Api_SendMessage(hTabs, TCM_INSERTITEMA, 1, tci)

        tci.mask = TCIF_TEXT
        tci.pszText = StrAdr("Tab3" & Chr$(0))
        Ret = Api_SendMessage(hTabs, TCM_INSERTITEMA, 2, tci)

        tci.mask = TCIF_TEXT
        tci.pszText = StrAdr("Tab4" & Chr$(0))
        Ret = Api_SendMessage(hTabs, TCM_INSERTITEMA, 3, tci)
    End If

    Ret = Api_SendMessage(hTabs, TCM_SETCURSEL, index, ByVal 0)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

    Ret = Api_DestroyWindow(hTabs)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End