'================================================================
'= プログレスバーの色を変える
'=    (ProgressBar2.bas)
'================================================================
#include "Windows.bi"

Type tagINITCOMMONCONTROLSEX
    dwSize As Long                                '構造体のバイト数
    dwICC  As Long                                'ロードするクラスを指定する
End Type

' ウインドウ（コントロール）を作成
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&)

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

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

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

' ウィンドウスタイルの定数
#define WS_CHILD &H40000000                      '親ウインドウを持つｺﾝﾄﾛｰﾙ(子ウインドウ)を作成する
#define WS_VISIBLE &H10000000                    'Visibleである
#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 ICC_PROGRESS_CLASS &H20                  'プログレスバーコントロール
#define PROGRESS_CLASS "msctls_progress32"       'プログレスバーコントロールクラス

#define CCM_FIRST &H2000
#define CCM_SETBKCOLOR &H2001
#define PBM_SETBKCOLOR &H2001                    '背景色の設定(IE3以降)
#define PBM_SETBARCOLOR &H409                    'バーの色設定(IE4以降)

Var Shared Text1 As Object
Var Shared Check1 As Object
Var Shared Group1 As Object
Var Shared Edit(2) As Object
Var Shared Radio(2) As Object
Var Shared Timer1 As Object
Var Shared Button1 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
For i = 0 To 2
    Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1))) : Edit(i).SetFontSize 14
    Radio(i).Attach GetDlgItem("Radio" & Trim$(Str$(i + 1))) : Radio(i).SetFontSize 14
Next i
Check1.Attach GetDlgItem("Check1") : Check1.SetFontSize 14
Timer1.Attach GetDlgItem("Timer1")
Group1.Attach GetDlgItem("Group1") : Group1.setFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'プログレスバーのハンドル保存用
Var Shared pBarhWnd As Long
Var Shared Cnt As Long
Var Shared Flg As Byte
Var Shared ColorRef As Long

'================================================================
'=
'================================================================
Declare Function BkRGB(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte) As Long
Function BkRGB(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte) As Long
    'シフト演算した値の論理和
    BkRGB = CLng(b) * (2 ^ 16) Or CLng(g) * (2 ^ 8) Or CLng(r)
End Function

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

'================================================================
'=
'================================================================
Declare Function Index bdecl () As Integer
Function Index() As Integer
    Index = Val(Mid$(GetDlgRadioSelect("Radio1"), 6)) - 1
End Function

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

    ShowWindow -1
End Sub

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

    'プログレスバーのカウント
    Cnt = Cnt + 1
    Ret = Api_SendMessage(pBarhWnd, PBM_SETPOS, Cnt, 0)
    Text1.SetWindowText Str$(Cnt) & "%"

    If Cnt > 99 Then
        Cnt = 0
        Timer1.Enable 0
        Button1.EnableWindow -1
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var cc As tagINITCOMMONCONTROLSEX
    Var BkColor As Long
    Var bR As Byte
    Var bG As Byte
    Var bB As Byte
    Var Ret As Long

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

    If Check1.GetCheck = 0 Then
        'プログレスバー作成(段階表示)
        pBarhWnd = Api_CreateWindowEx(0, PROGRESS_CLASS, "Progress Bar", WS_CHILD Or WS_VISIBLE Or WS_BORDER, 14, 8, 238, 20, GethWnd, 0, GethInst, 0)
    Else
        'プログレスバー作成(スムーズ表示)
        pBarhWnd = Api_CreateWindowEx(0, PROGRESS_CLASS, "Progress Bar", WS_CHILD Or WS_VISIBLE Or WS_BORDER Or &HB, 14, 8, 238, 20, GethWnd, 0, GethInst, 0)
    End If

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

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

    '背景色(RGB)を取得
    bR = Val(Edit(0).GetWindowText)
    bG = Val(Edit(1).GetWindowText)
    bB = Val(Edit(2).GetWindowText)

    BkColor = BkRGB(bR, bG, bB)

    'プログレスバーの背景色を設定
    Ret = Api_SendMessage(pBarhWnd, PBM_SETBKCOLOR, 0, ByVal BkColor)

    Select Case Index
        Case 0    
            ColorRef = RGB(255, 0, 0)
        Case 1
            ColorRef = RGB(0, 255, 0)
        Case 2
            ColorRef = RGB(0, 0, 255)
    End Select

    'プログレスバーの色を設定
    Ret = Api_SendMessage(pBarhWnd, PBM_SETBARCOLOR, 0, ColorRef)

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

    Timer1.Enable -1

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

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