ステータスバーの作成(T) <TOP>
ステータスバーを作成します。
InitCommonControls コモンコントロールの初期化
CreateStatusWindow ステータスバーの作成
GetClientRect ウィンドウのクライアント領域の座標を取得
MoveWindow ウィンドウの位置とサイズを変更
DestroyWindow
ウィンドウの破棄
SendMessage (Api_SendMessageByAny)パーツの個数設定
SendMessage (Api_SendMessageByString)パーツにテキストを設定
メインフォームは可視なしに設定し、フォーム表面色を設定後表示しています。メインフォームはサイズの変更ができるように設定します。
サイズグリップを摘んでリサイズしてもステータスバーのサイズがついていきます。
矩形位置の計算
Parts(0) = ((rctClnt.Right - rctSBar.Left) - 120) + 50
Parts(1) = ((rctClnt.Right - rctSBar.Left) - 120) + 100
'================================================================ '= ステータスバーを作成(T) '= (CreateStatusWindow2.bas) '================================================================ #include "Windows.bi" Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type 'コモンコントロールの初期化 Declare Sub Api_InitCommonControls Lib "Comctl32" Alias "InitCommonControls" () 'ステータスウィンドウの作成 Declare Function Api_CreateStatusWindow& Lib "Comctl32" Alias "CreateStatusWindowA" (ByVal Style&, ByVal lpszText$, ByVal hWndParent&, ByVal wID&) ' ウィンドウのクライアント領域の座標を取得 Declare Function Api_GetClientRect& Lib "user32" Alias "GetClientRect" (ByVal hWnd&, lpRect As RECT) ' 指定されたウィンドウの位置およびサイズを変更 Declare Function Api_MoveWindow& Lib "user32" Alias "MoveWindow" (ByVal hWnd&, ByVal x&, ByVal y&, ByVal nWidth&, ByVal nHeight&, ByVal bRepaint&) ' CreateWindowExの解放 Declare Function Api_DestroyWindow& Lib "user32" Alias "DestroyWindow" (ByVal hWnd&) ' ウィンドウにメッセージを送信 Declare Function Api_SendMessageByAny& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any) Declare Function Api_SendMessageByString& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam$) #define WM_USER &H400 'ユーザーが定義できるメッセージの使用領域を表すだけでこれ自体に意味はない #define WS_CHILD &H40000000 '親ウインドウを持つコントロール(子ウインドウ)を作成する #define WS_VISIBLE &H10000000 '可視状態のウィンドウを作成する #define WS_BORDER &H800000 'フォームの枠線がある #define SBARS_SIZEGRIP &H100 'サイズグリップ #define CCS_BOTTOM &H3 'ウィンドウを親ウィンドウの下端に配置 #define SB_SETTEXTA &H401 'WM_USER + 1 #define SB_SETPARTS &H404 'WM_USER + 4 Var Shared SBhWnd As Long Var Shared lpszTitle$ As String '================================================================ '= '================================================================ Declare Sub MainForm_Start edecl () Sub MainForm_Start() Var rgbColor As Long '表面色を設定 rgbColor = RGB(236, 233, 216) 'MainFormを取得色で塗り SetBackColor rgbColor '画面を消去し Cls 'MainFormを表示 ShowWindow -1 Api_InitCommonControls 'ステータスバーの追加 SBhWnd = Api_CreateStatusWindow(WS_CHILD Or WS_VISIBLE Or WS_BORDER Or CCS_BOTTOM Or SBARS_SIZEGRIP, lpszTitle$, GethWnd, 101) End Sub '================================================================ '= '================================================================ Declare Sub MainForm_Resize edecl () Sub MainForm_Resize() Var rctSBar As RECT 'スクロールバー矩形 Var rctClnt As RECT 'フォーム矩形 Var Parts(1) As Long 'スクロールバー部品数 Var Res As Long 'メインフォームの矩形を取得 Res = Api_GetClientRect(GethWnd, rctClnt) 'ステータスバーウィンドウの矩形を取得 Res = Api_GetClientRect(SBhWnd, rctSBar) Parts(0) = ((rctClnt.Right - rctSBar.Left) - 120) + 50 Parts(1) = ((rctClnt.Right - rctSBar.Left) - 120) + 100 'パーツを2個に設定 Res = Api_SendMessageByAny(SBhWnd, SB_SETPARTS, 2, Parts(0)) 'テキスト(パーツ0) Res = Api_SendMessageByString(SBhWnd, SB_SETTEXTA, 0, "CreateStatusWindow") 'テキスト(パーツ1) Res = Api_SendMessageByString(SBhWnd, SB_SETTEXTA, 1, "TOKO") 'ステータスバーのサイズを調整 Res = Api_MoveWindow(SBhWnd, 0, rctClnt.Bottom - rctSBar.Bottom, 0, 0, True) End Sub '================================================================ '= '================================================================ Declare Sub MainForm_QueryClose edecl (Cancel%) Sub MainForm_QueryClose(cancel%) Var Res As Long If Cancel% = 0 Then 'ステータスバーをアンロード Res = Api_DestroyWindow(SBhWnd) End If End Sub '================================================================ '= '================================================================ While 1 WaitEvent Wend Stop End