unit NewProgressBar;

{
  Inno Setup
  Copyright (C) 1997-2006 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  TNewProgressBar component - a smooth TProgressBar for Delphi 2 and a 32 bit
  TProgressBar for Delphi 2 and all platforms

  Note: themed Vista and newer animate progress bars and don't immediately show changes.
  This applies both to Position and State. For example if you set State while the
  progress bar is still moving towards a new Position, the new State doesnt show until
  the moving animation has finished.

  $jrsoftware: issrc/Components/NewProgressBar.pas,v 1.7 2009/09/15 15:21:09 mlaan Exp $
}

interface

uses
  Messages, Classes, Controls, ComCtrls;

type
  TNewProgressBarState = (npbsNormal, npbsError, npbsPaused);

  TNewProgressBar = class(TWinControl)
  private
    FMin: LongInt;
    FMax: LongInt;
    FPosition: LongInt;
    FState: TNewProgressBarState;
    procedure SetMin(Value: LongInt);
    procedure SetMax(Value: LongInt);
    procedure SetPosition(Value: LongInt);
    procedure SetState(Value: TNewProgressBarState);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Min: LongInt read FMin write SetMin;
    property Max: LongInt read FMax write SetMax;
    property Position: LongInt read FPosition write SetPosition default 0;
    property State: TNewProgressBarState read FState write SetState default npbsNormal;   
  end;

procedure Register;

implementation

uses
  Windows, CommCtrl;

var
  Vista: Boolean;

procedure Register;
begin
  RegisterComponents('JR', [TNewProgressBar]);
end;

constructor TNewProgressBar.Create(AOwner: TComponent);
begin
  inherited;
  Width := 150;
  Height := GetSystemMetrics(SM_CYVSCROLL);
  FMin := 0;
  FMax := 100;
end;

procedure TNewProgressBar.CreateParams(var Params: TCreateParams);
const
  PBS_SMOOTH = 1;
begin
  InitCommonControls;
  inherited;
  CreateSubClass(Params, PROGRESS_CLASS);
  Params.Style := Params.Style or PBS_SMOOTH;
end;

procedure TNewProgressBar.CreateWnd;
begin
  inherited CreateWnd;
  SendMessage(Handle, PBM_SETRANGE, 0, MAKELPARAM(0, 65535));
  SetPosition(FPosition);
  SetState(FState);
end;

procedure TNewProgressBar.SetMin(Value: LongInt);
begin
  FMin := Value;
  SetPosition(FPosition);
end;

procedure TNewProgressBar.SetMax(Value: LongInt);
begin
  FMax := Value;
  SetPosition(FPosition);
end;

procedure TNewProgressBar.SetPosition(Value: LongInt);
begin
  if Value < FMin then
    Value := FMin
  else if Value > FMax then
    Value := FMax;
  FPosition := Value;
  if HandleAllocated then
    SendMessage(Handle, PBM_SETPOS, MulDiv(Value - FMin, 65535, FMax - FMin), 0);
end;

procedure TNewProgressBar.SetState(Value: TNewProgressBarState);
const
  PBST_NORMAL = $0001;
  PBST_ERROR = $0002;
  PBST_PAUSED = $0003;
  PBM_SETSTATE = WM_USER+16;
  States: array[TNewProgressBarState] of UINT = (PBST_NORMAL, PBST_ERROR, PBST_PAUSED);
begin
  if Vista then begin
    FState := Value;
    if HandleAllocated then
      SendMessage(Handle, PBM_SETSTATE, States[Value], 0);
  end;
end;

procedure TNewProgressBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  { Bypass TWinControl's default WM_ERASEBKGND handling.
    On Windows Vista with COMCTL32 v6, a WM_ERASEBKGND message is sent every
    time a progress bar's position changes. TWinControl.WMEraseBkgnd does a
    FillRect on the whole client area, which results in ugly flickering.
    Previous versions of Windows only sent a WM_ERASEBKGND message when a
    progress bar moved backwards, so flickering was rarely apparent. }
  DefaultHandler(Message);
end;

var
  OSVersionInfo: TOSVersionInfo;

initialization
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  Vista := GetVersionEx(OSVersionInfo) and (OSVersionInfo.dwMajorVersion >= 6);
end.
