タブコントロールをコードで作成(U) <TOP>
GetSysColor システムの背景色を取得
CreateWindowEx ウィンドウ(コントロール)を作成
GetStockObject ストックオブジェクトのハンドルを取得
DestroyWindow CreateWindowExの解放
InitCommonControls コモンコントロールライブラリからコモンコントロールのウィンドウクラスを登録して初期化
SendMessage ウィンドウにメッセージを送信
SendMessageByLong ウィンドウにメッセージを送信
タブコントロールを作成し、
タブサイズ(高さ)を2倍に設定
'================================================================ '= タブコントロールをコードで作成(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