タブコントロールの選択インデックスを取得 <TOP>
GetSysColor システムの背景色を取得
CreateWindowEx ウィンドウ(コントロール)を作成
GetStockObject ストックオブジェクトのハンドルを取得
DestroyWindow CreateWindowExの解放
InitCommonControls コモンコントロールライブラリからコモンコントロールのウィンドウクラスを登録して初期化
SendMessage ウィンドウにメッセージを送信
SendMessageByLong ウィンドウにメッセージを送信
TCM_GETCURSEL(&H130B) 選択されているタブインデックス取得
'================================================================ '= タブコントロールの選択インデックスを取得 '= (CreateWindowEx4_7.bas) '================================================================ #include "Windows.bi" #define COLOR_BTNFACE 15 '3Dオブジェクトの表面色 #define DEFAULT_GUI_FONT 17 'ユーザーインターフェイス用のデフォルトフォント #define IDM_TAB1 &H100 'TABコントロールのID #define TCIF_TEXT &H1 'pdzTextにデータが含まれる #define TCM_INSERTITEMA &H1307 'タブ項目を追加 #define TCM_SETCURSEL &H130C 'タブを選択 #define TCM_GETCURSEL &H130B '選択されているタブインデックス取得 #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 Text1 As Object Var Shared Button1 As Object Text1.Attach GetDlgItem("Text1") : Text1.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 Var tci As TCITEM Var index As Long Var Ret As Long 'Buttonの表面色を取得(F0F0F0) rgbColor = Api_GetSysColor(COLOR_BTNFACE) 'MainFormを取得色で塗り SetBackColor rgbColor '画面を消去 Cls 'MainFormを表示 ShowWindow -1 Api_InitCommonControls hTabs = Api_CreateWindowEx(0, WC_TABCONTROL, "", WS_CHILD Or WS_CLIPSIBLINGS Or WS_VISIBLE Or TCS_HOTTRACK Or TCS_TOOLTIPS, 10, 10, 214, 60, 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 Button1_on edecl () Sub Button1_on() Var CurSel As Long '選択タブインデックスを取得 CurSel = Api_SendMessage(hTabs, TCM_GETCURSEL, 0, ByVal 0) '結果を表示 Text1.SetWindowtext "Tab" & Str$(CurSel + 1) & " が選択されました" 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