Search code examples
delphiprogress-bardelphi-7

How do I show progress in status/task bar button using Delphi 7?


If you copy files under Windows 7, you will see the progress of the copy in a sort of progress bar begin displayed in the status or task bar button of the application.

Can this be achieved using Delphi 7 ?

I have some lengthy operation which would be ideally suited to show it's progress this way.

sample of such a button using copy with Total Commander

sample of such a button using copy with Total Commander.


Solution

  • Use the ITaskbarList3 interface for that, specifically its SetProgressState and SetProgressValue methods. Use CoCreateInstance() specifying CLSID_TaskbarList and IID_ITaskbarList3 to access the interface.

    For example:

    type
      ITaskbarList = interface(IUnknown) 
        ['{56FDF342-FD6D-11D0-958A-006097C9A090}']
        function HrInit: HRESULT; stdcall;
        function AddTab(hwnd: HWND): HRESULT; stdcall;
        function DeleteTab(hwnd: HWND): HRESULT; stdcall;
        function ActivateTab(hwnd: HWND): HRESULT; stdcall;
        function SetActiveAlt(hwnd: HWND): HRESULT; stdcall;
      end;
    
      ITaskbarList2 = interface(ITaskbarList) 
        ['{602D4995-B13A-429B-A66E-1935E44F4317}']
        function MarkFullscreenWindow(hwnd: HWND; 
          fFullscreen: BOOL): HRESULT; stdcall;
      end;
    
      THUMBBUTTON = record 
        dwMask: DWORD;
        iId: UINT;
        iBitmap: UINT;
        hIcon: HICON;
        szTip: packed array[0..259] of WCHAR;
        dwFlags: DWORD;
      end;
      TThumbButton = THUMBBUTTON;
      PThumbButton = ^TThumbButton;
    
      ITaskbarList3 = interface(ITaskbarList2) 
        ['{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}']
        function SetProgressValue(hwnd: HWND; ullCompleted: ULONGLONG; 
          ullTotal: ULONGLONG): HRESULT; stdcall;
        function SetProgressState(hwnd: HWND; 
          tbpFlags: Integer): HRESULT; stdcall;
        function RegisterTab(hwndTab: HWND; hwndMDI: HWND): HRESULT; stdcall;
        function UnregisterTab(hwndTab: HWND): HRESULT; stdcall;
        function SetTabOrder(hwndTab: HWND; 
          hwndInsertBefore: HWND): HRESULT; stdcall;
        function SetTabActive(hwndTab: HWND; hwndMDI: HWND; 
          tbatFlags: Integer): HRESULT; stdcall;
        function ThumbBarAddButtons(hwnd: HWND; cButtons: UINT;
          pButton: PThumbButton): HRESULT; stdcall;
        function ThumbBarUpdateButtons(hwnd: HWND; cButtons: UINT;
          pButton: PThumbButton): HRESULT; stdcall;
        function ThumbBarSetImageList(hwnd: HWND; 
          himl: HIMAGELIST): HRESULT; stdcall;
        function SetOverlayIcon(hwnd: HWND; hIcon: HICON; 
          pszDescription: LPCWSTR): HRESULT; stdcall;
        function SetThumbnailTooltip(hwnd: HWND; 
          pszTip: LPCWSTR): HRESULT; stdcall;
        function SetThumbnailClip(hwnd: HWND; 
          var prcClip: TRect): HRESULT; stdcall;
      end;
    
    const
      CLSID_TaskbarList: TGUID = '{56FDF344-FD6D-11d0-958A-006097C9A090}';
      TBPF_NOPROGRESS    = 0; 
      TBPF_INDETERMINATE = $1; 
      TBPF_NORMAL        = $2; 
      TBPF_ERROR         = $4; 
      TBPF_PAUSED        = $8; 
    
    var
      TBL: ITaskbarList3;
      I: Integer;
    begin
      CoCreateInstance(CLSID_TaskbarList, nil, CLSCTX_INPROC, ITaskbarList3, TBL);
    
      if (TBL <> nil) then 
        TBL.SetProgressState(Application.Handle, TBPF_INDETERMINATE);
      try
        for I := 0 to 100 do
        begin
          if (TBL <> nil) then 
            TBL.SetProgressValue(Application.Handle, I, 100);
          Sleep(1000);
        end;
      finally
        if (TBL <> nil) then 
          TBL.SetProgressState(Application.Handle, TBPF_NOPROGRESS);
      end;
    end;