タブコントロールをコードで作成

タブコントロールをコードで作成(Ⅰ) <TOP>

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

SendMessageByLong ウィンドウにメッセージを送信　 '================================================================ '= タブコントロールをコードで作成 '= (CreateWindowEx4.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 TCIF_IMAGE &H2 'hImageにデータが含まれる #define TCIF_STATE &H10 'dwStateにデータが含まれる #define TCIF_PARAM &H8 'lParamにデータが含まれる #define TCM_FIRST &H1300 #define TCM_INSERTITEMA (&H1300 + 7) #define TCM_INSERTITEMW (&H1300 + 62) #define TCM_INSERTITEM TCM_INSERTITEMA #define TCM_GETCURSEL &H130B #define WC_TABCONTROL "SysTabControl32" 'タブコントロール #define WS_CHILD &H40000000 '親ウィンドウを持つコントロール(子ウィンドウ)を作成する #define WS_CLIPCHILDREN &H2000000 '親ウィンドウ内部を描画するとき、子ウィンドウが占める領域を除外する #define WS_CLIPSIBLINGS &H4000000 '兄弟関係にある子ウィンドウをクリップする #define WS_OVERLAPPED &H0 'オーバーラップウィンドウを作成する #define WS_TABSTOP &H10000 'ユーザーがTabキーを押すと入力フォーカスを受け取るコントロールを指定する #define WS_VISIBLE &H10000000 '可視状態のウィンドウを作成する #define WS_TABS (WS_CLIPCHILDREN Or WS_CLIPSIBLINGS Or WS_OVERLAPPED Or WS_VISIBLE Or WS_CHILD) #define WS_EX_LEFT &H0 '左揃えされたプロパティを持つウィンドウを作成(デフォルト) #define WS_EX_LTRREADING &H0 '左から右への読み取り順序を持つプロパティを持ったウィンドウを作成(デフォルト) #define WS_EX_RIGHTSCROLLBAR &H0 '垂直スクロールバーがクライアント領域の右側に置かれる(デフォルト) #define WS_EX_TABS &H0 '(WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR) #define IDM_TAB1 &H100 'TABコントロールのID #define TCS_BOTTOM &H2 'タブの位置を下にする #define TCS_BUTTONS &H100 'タブをプッシュボタンとして表示 #define TCS_FIXEDWIDTH &H400 '全てのタブを同じサイズで表示 #define TCS_FLATBUTTONS &H8 'タブ項目をフラットで表示 #define TCS_FOCUSNEVER &H8000 'タブは入力フォーカスを受けない #define TCS_FOCUSONBUTTONDOWN &H1000 'タブは、選択されと入力フォーカスを受ける #define TCS_FORCEICONLEFT &H10 'タブアイコンを左詰めにし、テキストをセンタリング #define TCS_FORCELABELLEFT &H20 'アイコンとテキストを左詰 #define TCS_HOTTRACK &H40 'マウスカーソルの下のタブを強調表示 #define TCS_MULTILINE &H200 '幅に対し、一行で全てのタブを表示できない場合タブを改行し、複数行で表示 #define TCS_OWNERDRAWFIXED &H2000 'オーナー描画タブ #define TCS_RAGGEDRIGHT &H800 'タブを左詰めで表示 #define TCS_RIGHT &H2 'タブを右側に表示｢TCS_VERTICAL｣と同時に使用 #define TCS_RIGHTJUSTIFY 0 '全てのタブの合計の幅が、タブコントロール全体のサイズになるまで拡大 #define TCS_SCROLLOPPOSITE 1 '選択されていないタブを反対に移動 #define TCS_SINGLELINE 0 'タブが一行で表示されるデフォルトではこのスタイルが用いられる #define TCS_TABS 0 'タブはデフォルトスタイルで表示 #define TCS_TOOLTIPS &H4000 'ツールヒントコントロールが作成されTTN_NEEDTEXTを発行 #define TCS_VERTICAL &H80 'タブを右側に表示｢TCS_RIGHT｣と同時に使用 #define TCN_SELCHANGE -551 '選択されているタブが変更されたことを通知 #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 ' システムの背景色を取得 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 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 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 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