'================================================================
'= タブコントロールをコードで作成(�U)
'=    (CreateWindowEx4_2.bas)
'================================================================
#include "Windows.bi"

#define ICC_TAB_CLASSES &H8             'タブコントロール、ツールチップ

Type INITCOMMONCONTROLSEX
    dwSize As Long
    dwICC  As Long
End Type

#define TCIF_TEXT &H1                   'pdzTextにデータが含まれる
#define TCM_FIRST &H1300
#define TCM_INSERTITEMA &H1307          '(&H1300 + 7)
#define TCM_SETITEMSIZE &H1329          '
#define TCM_GETITEMRECT &H130A          '

#define WC_TABCONTROL "SysTabControl32" 'タブコントロール
#define WS_CHILD &H40000000             '親ウィンドウを持つコントロール(子ウィンドウ)を作成する
#define WS_CLIPSIBLINGS &H4000000       '兄弟関係にある子ウィンドウをクリップする
#define WS_VISIBLE &H10000000           '可視状態のウィンドウを作成する

#define TCS_HOTTRACK &H40               'マウスカーソルの下のタブを強調表示
#define TCS_TOOLTIPS &H4000             'ツールヒントコントロールが作成されTTN_NEEDTEXTを発行

#define WM_SETFONT &H30                 '論理フォントを設定する
#define DEFAULT_GUI_FONT 17             '
#define COLOR_BTNFACE 15                '3Dオブジェクトの表面色

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

Type RECT
    Left   As Long            '
    Top    As Long            '
    Right  As Long            '
    Bottom 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 Button1 As Object
Var Shared Button2 As Object

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

Var Shared hTabs As Long

'================================================================
'=
'================================================================
Declare Function MAKELPARAM(ByVal wHigh As Integer, ByVal wLow As Integer) As Long
Function MAKELPARAM(ByVal wHigh As Integer, ByVal wLow As Integer) As Long
    '下位BYTE値と16ビット左シフトした上位BYTE値の論理和
    MAKELPARAM = CLng(wLow) * (2 ^ 16) Or CLng(wHigh)
End Function

'================================================================
'=
'================================================================
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

    Button2.EnableWindow 0
End Sub

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

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

    Api_InitCommonControls

    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)
    End If

    Button1.EnableWindow 0
    Button2.EnableWindow -1
End Sub

'================================================================
'=
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var lCurSel As Long
    Var rc As RECT
    Var X As Integer
    Var Y As Integer
    Var ItemSize As Long
    Var Ret As Long

    'タブ座標を取得するタブインデックスを指定
    lCurSel = 0

    '指定したインデックスのタブ座標を取得
    Ret = Api_SendMessage(hTabs, TCM_GETITEMRECT, lCurSel, rc)

    'タブ座標からタブサイズを取得
    '幅を取得
    X = rc.Right - rc.Left

    '高さを取得し2倍
    Y = (rc.Bottom - rc.Top) * 2

    '取得したタブサイズからLPARAMを生成
    ItemSize = MAKELPARAM(X, Y)

    '新しいタブサイズを設定
    Ret = Api_SendMessage(hTabs, TCM_SETITEMSIZE, 0, ByVal ItemSize)

    Button2.EnableWindow 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