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