16

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.

1

3 Answers 3

23

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;
2
  • 1
    Thanks for the code. Much appreciated. I will try this out today and let the results be known.
    – Edelcom
    Apr 29, 2011 at 4:26
  • This code works. Sorry for the delay, took me some time to find the time to work on the code where I needed this, but this works. Thanks again.
    – Edelcom
    May 13, 2011 at 15:48
5

Also you can try my unit (Tested in Delphi 7):

{*******************************************************************************

                      Windows 7 TaskBar Progress Unit File

                           File Version: 0.0.0.3

                       https://github.com/tarampampam

*******************************************************************************}


unit Win7TaskBarProgressUnit;

interface

uses
  Windows, ActiveX;

type
  ITaskbarList = interface(IUnknown)
    ['{56FDF342-FD6D-11D0-958A-006097C9A090}']
    function HrInit: HRESULT; stdcall;
    function AddTab(hwnd: LongWord): HRESULT; stdcall;
    function DeleteTab(hwnd: LongWord): HRESULT; stdcall;
    function ActivateTab(hwnd: LongWord): HRESULT; stdcall;
    function SetActiveAlt(hwnd: LongWord): HRESULT; stdcall;
  end;

  ITaskbarList2 = interface(ITaskbarList)
    ['{602D4995-B13A-429B-A66E-1935E44F4317}']
    function MarkFullscreenWindow(hwnd: LongWord;
      fFullscreen: LongBool): HRESULT; stdcall;
  end;

  ITaskbarList3 = interface(ITaskbarList2)
    ['{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}']
    procedure SetProgressValue(hwnd: LongWord; ullCompleted: UInt64; ullTotal: UInt64); stdcall;
    procedure SetProgressState(hwnd: LongWord; tbpFlags: Integer); stdcall;
  end;

type
  TTaskBarProgressStyle = (tbpsNone, tbpsIndeterminate, tbpsNormal, tbpsError, tbpsPaused);

  TWin7TaskProgressBar = class
    glHandle: LongWord;
    glMin: Byte;
    glMax,
    glValue: Integer;
    glStyle: TTaskBarProgressStyle;
    glVisible,
    glMarquee: Boolean;
    glTaskBarInterface: ITaskbarList3;
  private
    procedure SetProgress(const Value: Integer);
    procedure SetMax(const Value: Integer);
    procedure SetStyle(const Style: TTaskBarProgressStyle);
    procedure SetVisible(const IsVisible: Boolean);
    procedure SetMarquee(const IsMarquee: Boolean);
  published
    constructor Create(const Handle: LongWord);
    property Max: Integer read glMax write SetMax default 100;
    property Min: Byte read glMin default 0;
    property Progress: Integer read glValue write SetProgress default 0;
    property Marquee: Boolean read glMarquee write SetMarquee default False;
    property Style: TTaskBarProgressStyle read glStyle write SetStyle default tbpsNone;
    property Visible: Boolean read glVisible write SetVisible default False;
    destructor Destroy; override;
  end;

implementation

procedure TWin7TaskProgressBar.SetMax(const Value: Integer);
begin
  glMax := Value;
  SetProgress(glValue);
end;

procedure TWin7TaskProgressBar.SetProgress(const Value: Integer);
begin
  if (glTaskBarInterface <> nil) and (glHandle <> 0) then begin
    glValue := Value;
    if not glMarquee then
      glTaskBarInterface.SetProgressValue(glHandle, UInt64(glValue), UInt64(glMax));
  end;
end;

procedure TWin7TaskProgressBar.SetStyle(const Style: TTaskBarProgressStyle);
const
  Flags: array[TTaskBarProgressStyle] of Cardinal = (0, 1, 2, 4, 8);
begin
  if (glTaskBarInterface <> nil) and (glHandle <> 0) then
    glTaskBarInterface.SetProgressState(glHandle, Flags[Style]);

  glStyle := Style;
end;

procedure TWin7TaskProgressBar.SetVisible(const IsVisible: Boolean);
begin
  if IsVisible then begin
    if (glStyle <> tbpsNormal) then
      SetStyle(tbpsNormal)
  end else
    SetStyle(tbpsNone);

  glVisible := IsVisible;
end;

procedure TWin7TaskProgressBar.SetMarquee(const IsMarquee: Boolean);
begin
  if IsMarquee then
    SetStyle(tbpsIndeterminate)
  else begin
    SetStyle(tbpsNone);
    if glVisible then begin
      SetProgress(glValue);
      SetStyle(tbpsNormal);
    end;
  end;

  glMarquee := IsMarquee;
end;

constructor TWin7TaskProgressBar.Create(const Handle: LongWord);
const
  CLSID_TaskbarList: TGUID = '{56FDF344-FD6D-11d0-958A-006097C9A090}';
var
  OSVersionInfo : TOSVersionInfo;
begin
  OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
  if (Handle <> 0) and GetVersionEx(OSVersionInfo) then
    if OSVersionInfo.dwMajorVersion >= 6 then try
      glHandle := Handle;
      CoCreateInstance(CLSID_TaskbarList, nil, CLSCTX_INPROC, ITaskbarList3, glTaskBarInterface);

      if (glTaskBarInterface <> nil) then
        glTaskBarInterface.SetProgressState(glHandle, 0);

      glMin := 0;
      glMax := 100;
      glValue := 10;
      glStyle := tbpsNormal;

      SetStyle(glStyle);
      SetVisible(glVisible);
    except
      glTaskBarInterface := nil;
    end;
end;


destructor TWin7TaskProgressBar.Destroy;
begin
  if (glTaskBarInterface <> nil) then begin
    glTaskBarInterface.SetProgressState(glHandle, 0);
    glTaskBarInterface := nil;
  end;
end;

end.
0
5

There are some complete solutions like TaskBarList component.

TTaskbarListProgress is a Pascal wrapper class for displaying progress in the taskbar.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.