This code will show how to use the Windows TaskBar application button as a ProgressBar.
Available colors are red, green, yellow, and a green marquee.
Usefull to show a long process progression.
Pierre
Code: Select all
'Windows TaskBar application button as ProgressBar
#Lang "fb"
#Define unicode
#Include Once "windows.bi"
#Include Once "win\shobjidl.bi"
Const AppName = "TaskBar ProgressBar"
Const StaticInfo = 101
Const ButtonStart = 201
Const TimerOne = 301
Dim Shared As HINSTANCE hInstance : hInstance = GetModuleHandle(NULL)
'_____________________________________________________________________________
Function WndProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer
Static pITaskBarList3 As ITaskBarList3 Pointer
Dim HR As HRESULT
Static hButtonStart As HWND
Static hStaticInfo As HWND
Static hFont As HFONT
Static ProgressPos As LongInt
Static ProgressMax As LongInt
Static WM_TaskbarButtonCreated As DWORD
Static ProgressState As Long
Static Delta As Long
Static TimerStarted As BOOLEAN
Select Case (uMsg)
Case WM_CREATE
Function = 0
hFont = GetStockObject(DEFAULT_GUI_FONT)
hStaticInfo = _
CreateWindowEx(0, "Static", AppName, _'ExStyle, ClassName, WindowName,
WS_CHILD Or WS_VISIBLE Or SS_CENTER Or SS_CENTERIMAGE Or _
SS_NOPREFIX Or SS_NOTIFY, _ 'Style,
5, 25, 265, 15, _ 'PosX, PosY, Width, Height,
hWnd, Cast(HMENU, StaticInfo), _ 'hParent, id/hMenu,
hInstance, NULL) 'hInstance, lpParam
SendMessage(hStaticInfo, WM_SETFONT, Cast(UInteger, hFont), TRUE)
hButtonStart = _
CreateWindowEx(0, "Button", "&Start", _ 'ExStyle, ClassName, WindowName,
WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_GROUP Or _
BS_CENTER Or BS_VCENTER, _ 'Style,
100, 65, 80, 25, _ 'PosX, PosY, Width, Height,
hWnd, Cast(HMENU, ButtonStart), _ 'hParent, id/hMenu,
hInstance, NULL) 'hInstance, lpParam
SendMessage(hButtonStart, WM_SETFONT, Cast(UInteger, hFont), TRUE)
ProgressPos = 000
ProgressMax = 100
ProgressState = TBPF_NORMAL
Delta = 001
'A message will be received at WM_TaskBarId after registration and after the creation of the taskbar button
WM_TaskbarButtonCreated = RegisterWindowMessage("TaskbarButtonCreated")
Case WM_TaskbarButtonCreated 'Message sent by Windows after the creation of the taskbar button
CoInitialize(NULL)
HR = CoCreateInstance(@CLSID_TaskBarList, NULL, CLSCTX_INPROC_SERVER, _
@IID_ITaskBarList3, @pITaskBarList3)
If (SUCCEEDED(HR)) Then
pITaskBarList3->lpVtbl->HrInit(pITaskBarList3) 'Initialize
pITaskBarList3->lpVtbl->SetProgressState(pITaskBarList3, hWnd, TBPF_INDETERMINATE) 'Set green marquee
End If
Case WM_COMMAND
Select Case LoWord(wParam)
Case ButtonStart
If HiWord(wParam) = BN_CLICKED Then
If WM_TaskbarButtonCreated Then
If TimerStarted = FALSE Then
TimerStarted = TRUE
SetTimer(hWnd, TimerOne, 10, ByVal NULL)
SetDlgItemText(hWnd, ButtonStart, "&Stop")
SetDlgItemText(hWnd, StaticInfo, "TBPF_NORMAL")
Else
TimerStarted = FALSE
KillTimer(hWnd, TimerOne)
SetDlgItemText(hWnd, ButtonStart, "&Start")
SetDlgItemText(hWnd, StaticInfo, "TBPF_INDETERMINATE")
pITaskBarList3->lpVtbl->SetProgressState(pITaskBarList3, hWnd, TBPF_INDETERMINATE) 'Green marquee
End If
Else
MessageBox(hWnd, "Need at least Windows Se7ven !", AppName, MB_ICONINFORMATION Or MB_OK)
End If
EndIf
End Select
Case WM_TIMER
If WPARAM = TimerOne Then
ProgressPos += Delta
pITaskBarList3->lpVtbl->SetProgressValue(pITaskBarList3, hWnd, ProgressPos, ProgressMax)
If ProgressPos = ProgressMax Then Delta = - 1
If ProgressPos = 0 Then
Delta = 1
If ProgressState = TBPF_NORMAL Then
ProgressState = TBPF_ERROR
SetDlgItemText(hWnd, StaticInfo, "TBPF_ERROR") 'Red
ElseIf ProgressState = TBPF_ERROR Then
ProgressState = TBPF_PAUSED
SetDlgItemText(hWnd, StaticInfo, "TBPF_PAUSED") 'Yellow
Else
ProgressState = TBPF_NORMAL
SetDlgItemText(hWnd, StaticInfo, "TBPF_NORMAL") 'Green
End If
pITaskBarList3->lpVtbl->SetProgressState(pITaskBarList3, hWnd, ProgressState) 'Green marquee
End If
End If
Case WM_DESTROY
DeleteObject(hFont) 'Clean up
If WM_TaskbarButtonCreated Then
If TimerStarted Then KillTimer(hWnd, TimerOne)
CoUninitialize()
End If
PostQuitMessage(0)
End Select
Function = DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function
'_____________________________________________________________________________
Function WinMain(ByVal hInstance As HINSTANCE, ByVal hPrevInst As HINSTANCE, _
ByVal CmdLine As WString Ptr, ByVal CmdShow As Integer) As UINT
Dim WinClass As WNDCLASS
Dim wMsg As MSG
Dim hWnd As HWND
Dim hIco As HICON
Dim WindowSize As SIZEL
Dim wsAppName As WString * 128
CoInitialize(NULL) 'Initialize COM library
wsAppName = AppName & " - " & SizeOf(UInteger) * 8
WindowSize.cx = 280
WindowSize.cy = 150
hIco = ExtractIcon(hInstance, "Shell32.dll", 27)
WinClass.style = CS_HREDRAW Or CS_VREDRAW
WinClass.lpfnWndProc = ProcPtr(WndProc)
WinClass.cbClsExtra = 0
WinClass.cbWndExtra = 0
WinClass.hInstance = hInstance
WinClass.hIcon = hIco
WinClass.hCursor = LoadCursor(NULL, IDC_ARROW)
WinClass.hbrBackground = Cast(HGDIOBJ, COLOR_BTNFACE + 1)
WinClass.lpszMenuName = NULL
WinClass.lpszClassName = VarPtr(wsAppName)
If (RegisterClass(@WinClass)) Then
hWnd = CreateWindowEx(WS_EX_WINDOWEDGE, _ 'ExStyle
wsAppName, wsAppName, _ 'ClassName, WindowName
WS_CLIPCHILDREN Or WS_DLGFRAME Or WS_BORDER Or WS_VISIBLE Or WS_CAPTION Or _
WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SYSMENU , _ 'Style
(GetSystemMetrics(SM_CXSCREEN) - WindowSize.cx) / 2, _ 'PosX
(GetSystemMetrics(SM_CYSCREEN) - WindowSize.cy) / 2, _ 'PosY
WindowSize.cx, WindowSize.cy, _ 'Width, height
NULL, NULL, hInstance, NULL) 'hWndParent, hMenu, hInstance, lpParam
While GetMessage(@wMsg, ByVal NULL, 0, 0) > 0 'Message loop
If IsDialogMessage(hWnd, @wMsg) = 0 Then
TranslateMessage(@wMsg)
DispatchMessage(@wMsg)
End If
Wend
End If
DestroyIcon(hIco)
CoUninitialize
Function = wMsg.message
Dim As HDC hDc = GetDC(hWnd)
End Function
'_____________________________________________________________________________
End WinMain(hInstance, NULL, Command(), SW_NORMAL) 'Call main() and return a code to the OS
'_____________________________________________________________________________
'