ステータスバーの作成(U) <TOP>
タイマーを使用してマウス位置を表示させてみました。ステータスバーの表示・非表示、サイズグリップの表示非表示を切り替えています。
InitCommonControls コモンコントロールの初期化
CreateStatusWindow ステータスバーの作成
GetClientRectウィンドウのクライアント領域の座標を取得
MoveWindow ウィンドウの位置とサイズを変更
DestroyWindow
ウィンドウの破棄
SendMessage (Api_SendMessageByAny)パーツの個数設定
SendMessage (Api_SendMessageByString)パーツにテキストを設定
矩形位置の計算
Parts(0) = ((rctClnt.Right - rctSBar.Left) - 170) + 50
Parts(1) = ((rctClnt.Right - rctSBar.Left) - 170) + 150
'================================================================ '= ステータスバーを作成(U)
'= タイマー使用でXYの位置を表示
'= (CreateStatusWindow.bas) '================================================================ #include "Windows.bi" Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Type POINTAPI X As Long Y As Long End Type ' マウスカーソル(マウスポインタ)の現在の位置に相当するスクリーン座標を取得 Declare Function Api_GetCursorPos& Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) ' コモンコントロールライブラリからコモンコントロールのウィンドウクラスを登録して初期化 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 Title As String Var Shared Check1 As Object Var Shared Check2 As Object Var Shared Timer1 As Object Check1.Attach GetDlgItem("Check1") : Check1.SetFontSize 14 Check2.Attach GetDlgItem("Check2") : Check2.SetFontSize 14 Timer1.Attach GetDlgItem("Timer1") '================================================================ '= '================================================================ Declare Sub DspOnOff() Sub DspOnOff() Var rctSBar As RECT 'ステータスバー矩形 Var rctClnt As RECT 'フォーム矩形 Var Parts(1) As Long 'ステータスバー部品数 Var Ret As Long 'ステータスバーをアンロード Ret = Api_DestroyWindow(SBhWnd) If Check1.GetCheck = 0 Then 'ステータスバー非表示 'サイズグリップ変更不許可 Check2.EnableWindow 0 Else If Check1.GetCheck = 1 Then 'ステータスバー表示 If Check2.GetCheck = 0 Then SBhWnd = Api_CreateStatusWindow(WS_CHILD Or WS_VISIBLE Or WS_BORDER Or CCS_BOTTOM, Title, GethWnd, 101) Else SBhWnd = Api_CreateStatusWindow(WS_CHILD Or WS_VISIBLE Or WS_BORDER Or CCS_BOTTOM Or SBARS_SIZEGRIP, Title, GethWnd, 101) End If 'サイズグリップ変更許可 Check2.EnableWindow -1 End If 'メインフォームの矩形を取得 Ret = Api_GetClientRect(GethWnd, rctClnt) 'ステータスバーウィンドウの矩形を取得 Ret = Api_GetClientRect(SBhWnd, rctSBar) Parts(0) = ((rctClnt.Right - rctSBar.Left) - 170) + 50 Parts(1) = ((rctClnt.Right - rctSBar.Left) - 170) + 150 'パーツを2個に設定 Ret = Api_SendMessageByAny(SBhWnd, SB_SETPARTS, 2, Parts(0)) 'ステータスバーのサイズを調整 Ret = Api_MoveWindow(SBhWnd, 0, rctClnt.Bottom - rctSBar.Bottom, 0, 0, True) End Sub '================================================================ '= '================================================================ Declare Sub Mainform_Start edecl () Sub Mainform_Start() Var rc As RECT Var cBrush As Long Var rgbColor As Long Var Ret As Long '表面色を設定 rgbColor = RGB(236, 233, 216) 'Mainformを取得色で塗り SetBackColor rgbColor 'Mainformを表示 ShowWindow -1 '画面を消去 Cls Api_InitCommonControls Timer1.SetInterval 10 Timer1.Enable -1 End Sub '================================================================ '= '================================================================ Declare Sub Mainform_Resize edecl () Sub Mainform_Resize() DspOnOff End Sub '================================================================ '= '================================================================ Declare Sub Timer1_Timer edecl () Sub Timer1_Timer() Var lpPoint As POINTAPI Var Ret As Long Ret = Api_GetCursorPos(lpPoint) 'テキスト Ret = Api_SendMessageByString(SBhWnd, SB_SETTEXTA, 0, "ステータスバーテスト") Ret = Api_SendMessageByString(SBhWnd, SB_SETTEXTA, 1, "x=" & Trim$(Str$(lpPoint.x)) & " / y=" & Trim$(Str$(lpPoint.y))) End Sub '================================================================ '= '================================================================ Declare Sub Check1_ON edecl () Sub Check1_ON() DspOnOff End Sub '================================================================ '= '================================================================ Declare Sub Check2_ON edecl () Sub Check2_ON() DspOnOff End Sub '================================================================ '= '================================================================ Declare Sub Mainform_QueryClose edecl (Cancel%) Sub Mainform_QueryClose(cancel%) Var Ret As Long If Cancel% = 0 Then 'ステータスバーをアンロード Ret = Api_DestroyWindow(SBhWnd) End If End Sub '================================================================ '= '================================================================ While 1 WaitEvent Wend Stop End