ステータスバー - abwiki @ ウィキ (ActiveBasic非公式wiki)

ステータスバーの中にプログレスバーを入れる。

プログレスバーをステータスバーの子にして、
SB_GETRECTでサイズ調整するのがミソ。

↓プロジェクト名を"SPSP"にして、コモンコントロールを使用するにチェクを入れる。

'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Const ID_STATUS = 70
Dim hStatusWnd As DWord
Dim hpr As HWND

Randomize

'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function


'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
SPSP_DestroyObjects()
PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
Dim ic As INITCOMMONCONTROLSEX
Dim Statusbar_Sizes[2] As Long

'コモンコントロールの初期化
ic.dwSize=Len(ic)
ic.dwICC=ICC_BAR_CLASSES
InitCommonControlsEx(ic)

'ステータスバーを作成
hStatusWnd = CreateStatusWindow( _
WS_CHILD or WS_VISIBLE or CCS_BOTTOM or SBARS_SIZEGRIP, _
NULL, _
hMainWnd, _
ID_STATUS)

'ステータスバーサイズを設定
Statusbar_Sizes[0]=150
Statusbar_Sizes[1]=300
Statusbar_Sizes[2]=450
SendMessage(hStatusWnd,SB_SETPARTS,3,Statusbar_Sizes)


'ステータスバーの子ウインドウとしてプログレスバーをつくる。
hpr = CreateWindowEx(0,"msctls_progress32","prog1",
WS_CHILD or WS_VISIBLE,
0 ,0 ,0 ,0 ,hStatusWnd, 0,GetModuleHandle(0),0)

SendMessage(hpr, PBM_SETRANGE32, 0,100)'プログレスバーの範囲

'タイマー開始
SetTimer(hMainWnd,0,500,NULL)
End Sub

Sub MainWnd_Resize(SizeType As Long, cx As Integer, cy As Integer)
Dim buffer[255] As Byte

'ステータスバーにサイズ変更情報を送る
SendMessage(hStatusWnd,WM_SIZE,cx,cy)

'ステータスバーのサイズにあわせる
Dim rc As RECT
SendMessage(hStatusWnd,SB_GETRECT,2, VarPtr(rc))
MoveWindow(hpr, rc.left, rc.top, rc.right, rc.bottom, TRUE)
End Sub

Sub MainWnd_Timer(TimerID As Long)
Dim buffer[255] As Byte
Dim template[255] As Byte

'日付をステータスバーに表示
GetDateFormat(LOCALE_USER_DEFAULT, DATE_LONGDATE, ByVal 0, 0, buffer, 255)
SendMessage(hStatusWnd, SB_SETTEXT, 0, buffer)

'時刻をステータスバーに表示
lstrcpy(template,"tt hh時 mm分 ss秒")
GetTimeFormat(LOCALE_USER_DEFAULT, NULL, ByVal 0, template, buffer, 255)
SendMessage(hStatusWnd, SB_SETTEXT, 1, buffer)

'範囲内でランダムに値を変更
SendMessage(hpr, PBM_SETPOS, Rnd()*101,0)
End Sub