タブコントロールのタブの追加と削除 <TOP>
GetSysColor システムの背景色を取得
CreateWindowEx ウィンドウ(コントロール)を作成
GetStockObject ストックオブジェクトのハンドルを取得
DestroyWindow CreateWindowExの解放
InitCommonControls コモンコントロールライブラリからコモンコントロールのウィンドウクラスを登録して初期化
SendMessage ウィンドウにメッセージを送信
SendMessageByLong ウィンドウにメッセージを送信
タブコントロールを作成し、 タブを追加または指定タブの削除を実行します。
'================================================================ '= タブコントロールのタブの追加と削除 '= (CreateWindowEx4_4.bas) '================================================================ #include "Windows.bi" Type INITCOMMONCONTROLSEX dwSize As Long dwICC As Long End Type 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 #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_DELETEITEM &H1308 'タブの削除 #define TCM_INSERTITEMA &H1307 'タブ項目を追加 #define TCM_GETCURSEL &H130B '選択されているタブインデックス取得 #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を発行 ' システムの背景色を取得 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 Var SHared tci As TCITEM '================================================================ '= '================================================================ Declare Sub MainForm_Start edecl () Sub MainForm_Start() Var rgbColor As Long Var icc As INITCOMMONCONTROLSEX Var index As Long Var Ret As Long 'Buttonの表面色を取得(EDE9EC) rgbColor = Api_GetSysColor(COLOR_BTNFACE) 'MainFormを取得色で塗り SetBackColor rgbColor '画面を消去 Cls 'MainFormを表示 ShowWindow -1 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) End If End Sub '================================================================ '= タブを追加 '================================================================ Declare Sub Button1_on edecl () Sub Button1_on() Var Insertcindex As Long Var InsertStr As String Var Ret As Long '設定するインデックスを指定 Insertcindex = 1 '設定する文字列を指定 InsertStr = "追加" '設定する項目情報を構造体に設定 tci.mask = TCIF_TEXT tci.pszText = StrAdr(InsertStr) tci.cchTextMax = Len(InsertStr) 'タブストリップの項目を追加 Ret = Api_SendMessage(hTabs, TCM_INSERTITEMA, Insertcindex, tci) End Sub '================================================================ '= 指定したタブを削除 '================================================================ Declare Sub Button2_on edecl () Sub Button2_on() Var SelIndex As Long Var DelIndex As Long '選択タブインデックスを取得 SelIndex = Api_SendMessage(hTabs, TCM_GETCURSEL, 0, ByVal 0) '指定したタブを削除 DelIndex = Api_SendMessage(hTabs, TCM_DELETEITEM, SelIndex, 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