ステータスバーの作成(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