プログレスバーの作成             <TOP>

プログレスバーを作成します。

CreateWindowEx ウインドウ（コントロール）の作成

SendMessage コントロールにメッセージを送る

　

タイマー、テキストボックス、ラジオボタン、ボタンを貼り付けます。    スケールとスムーズおよび水平と垂直は、それぞれグループ指定しています。

                                                                         起動直後の状態

 

スケール表示

pBarHwnd = Api_CreateWindowEx(0, PROGRESS_CLASS, "Progress Bar", WS_CHILD or WS_VISIBLE or WS_BORDER, 10, 10, 250, 24, GetHWnd, 0, GetHinst, 0)

垂直表示はPBS_VERTICALを追加します。

 

スムーズ表示

pBarHwnd = Api_CreateWindowEx(0, PROGRESS_CLASS, "Progress Bar", WS_CHILD or WS_VISIBLE or WS_BORDER or PBS_SMOOTH, 10, 10, 250, 24, GetHWnd, 0, GetHinst, 0)
    10,10,250,24は、プログレスバーの描画位置および寸法を表しています。
 

　

'================================================================
'= プログレスバーの作成
'=    (ProgressBar.bas)
'=    Case5の部分は、1行の文字数制限(255)に注意
'================================================================
#include "Windows.bi"

' COMCTL32.dllからコモンコントロールクラスを登録する
Type tagINITCOMMONCONTROLSEX
    dwSize As Long                         '構造体のバイト数
    dwICC As Long                          'ロードするクラスを指定する
End Type

' コモンコントロールのダイナミックリンクライブラリ(DLL)に含まれている、特定のコモンコントロールクラスを登録
Declare Function Api_InitCommonControlsEx& Lib "comctl32" Alias "InitCommonControlsEx" (lpInitCtrls As tagINITCOMMONCONTROLSEX)

' ウインドウ（コントロール）を作成
Declare Function Api_CreateWindowEx& Lib "user32" Alias "CreateWindowExA" (ByVal ExStyle&, ByVal ClassName$, ByVal WinName$, ByVal Style&, ByVal x&, ByVal y&, ByVal nWidth&, ByVal nHeight&, ByVal Parent&, ByVal Menu&, ByVal Instance&, ByVal Param&)

' CreateWindowExの解放
Declare Function Api_DestroyWindow& Lib "user32" Alias "DestroyWindow" (ByVal hWnd&)

' ウィンドウにメッセージを送信。この関数は、指定したウィンドウのウィンドウプロシージャが処理を終了するまで制御を返さない
Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)

' ウィンドウスタイルの定数
#define WS_CHILD &H40000000                '親ウインドウを持つｺﾝﾄﾛｰﾙ(子ウインドウ)を作成する
#define WS_VISIBLE &H10000000              '表示する
#define WS_BORDER &H800000                 'フォームの枠線がある

' プログレスバー関係
#define WM_USER &H400                      'ユーザーが定義できるメッセージの使用領域を表すだけでこれ自体に意味はない
#define PBM_SETRANGE &H401                 '(WM_USER + 1)範囲の設定
#define PBM_SETPOS &H402                   '(WM_USER + 2)位置の指定
#define PBM_DELTAPOS &H403                 '(WM_USER + 3)デフォルトの位置
#define PBM_SETSTEP &H404                  '(WM_USER + 4)増分の設定
#define PBS_SMOOTH &HB                     '滑らかなプログレスバー
#define PBS_VERTICAL &H4                   '垂直表示
#define ICC_PROGRESS_CLASS &H20            'プログレスバーコントロール
#define PROGRESS_CLASS "msctls_progress32" 'プログレスバーコントロールクラス

Var Shared Timer1 As Object
Var Shared Text1 As Object
Var Shared Radio1 As Object
Var Shared Radio2 As Object
Var Shared Radio3 As Object
Var Shared Radio4 As Object
Var Shared Button1 As Object
Var Shared Button2 As Object

Timer1.Attach GetDlgItem("Timer1")
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Button2.Attach GetDlgItem("Button2") : Button2.SetFontSize 14
Text1.Attach GetDlgItem("Text1")     : Text1.SetFontSize 14
Radio1.Attach GetDlgItem("Radio1")   : Radio1.SetFontSize 14
Radio2.Attach GetDlgItem("Radio2")   : Radio2.SetFontSize 14
Radio3.Attach GetDlgItem("Radio3")   : Radio3.SetFontSize 14
Radio4.Attach GetDlgItem("Radio4")   : Radio4.SetFontSize 14

' プログレスバーのハンドル保存用
Var Shared hWnd As Long
Var Shared Cnt As Long
Var Shared Style(3) As byte

'================================================================
'=
'================================================================
Declare Function GetLong&(ByVal UpperWord&, ByVal LowerWord&)
Function GetLong&(ByVal UpperWord&, ByVal LowerWord&)
    '下位・上位を与えて長整数値(32ビット値)を取得する
    GetLong = UpperWord& + LowerWord& * &H10000
End Function

'================================================================
'=
'================================================================
Declare Sub Mainform_Start edecl ()
Sub Mainform_Start()
    'タイマーセット
    Timer1.SetInterval 5
    Timer1.Enable 0

    Button2.EnableWindow 0
End Sub

'================================================================
'=
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    Var Ret As Long

    'プログレスバーのカウント
    Cnt = Cnt + 1
    Ret = Api_SendMessage(hWnd, PBM_SETPOS, Cnt, 0)
    Text1.SetWindowText Str$(Cnt) & "%"
    If Cnt > 99 Then
        Cnt = 0
        Timer1.Enable 0
        Button2.EnableWindow -1
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    'コモンコントロールを初期化する
    Var cc As tagINITCOMMONCONTROLSEX
    Var Ret As Long

    cc.dwSize = Len(cc)
    cc.dwICC = ICC_PROGRESS_CLASS

    If Radio1.GetCheck = 1 Then style(0) = 0 : style(1) = 0
    If Radio2.GetCheck = 1 Then style(0) = 0 : style(1) = 1
    If Radio3.GetCheck = 1 Then style(2) = 2 : style(3) = 0
    If Radio4.GetCheck = 1 Then style(2) = 0 : style(3) = 4

    Select Case style(0) + style(1) + style(2) + style(3)
    Case 2
        'プログレスバー作成(水平スケール表示)
        hWnd = Api_CreateWindowEx(0, PROGRESS_CLASS, "Progress Bar", WS_CHILD Or WS_VISIBLE Or WS_BORDER, 10, 10, 200, 24, GethWnd, 0, GethInst, 0)
    Case 3
        'プログレスバー作成(水平スムーズ表示)
        hWnd = Api_CreateWindowEx(0, PROGRESS_CLASS, "Progress Bar", WS_CHILD Or WS_VISIBLE Or WS_BORDER Or PBS_SMOOTH, 10, 10, 200, 24, GethWnd, 0, GethInst, 0)
    Case 4
        'プログレスバー作成(垂直スケール表示)
        hWnd = Api_CreateWindowEx(0, PROGRESS_CLASS, "Progress Bar", WS_CHILD Or WS_VISIBLE Or WS_BORDER Or PBS_VERTICAL, 10, 10, 24, 116, GethWnd, 0, GethInst, 0)
    Case 5
        'プログレスバー作成(垂直スムーズ表示)
        hWnd = Api_CreateWindowEx(0, PROGRESS_CLASS, "Progress Bar", WS_CHILD Or WS_VISIBLE Or WS_BORDER Or PBS_VERTICAL Or PBS_SMOOTH, 10, 10, 24, 116, GethWnd, 0, GethInst, 0)
    End Select

    ' 範囲の設定(0〜100)
    Ret = Api_SendMessage(hWnd, PBM_SETRANGE, 0, GetLong(0, 100))

    'ステップの設定
    Ret = Api_SendMessage(hWnd, PBM_SETSTEP, 1, 0)

    'プログレスバーの値を0にする
    Ret = Api_SendMessage(hWnd, PBM_SETPOS, 0, 0)
    Cnt = 0

    Timer1.Enable -1

    'コマンドボタンの無効化
    Button1.EnableWindow 0
    Button2.EnableWindow 0
End Sub

'================================================================
'=
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var Ret As Long

    Ret = Api_DestroyWindow(hWnd)
    Button1.EnableWindow -1
    Button2.EnableWindow 0
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End