Progress Bar Sample

unit ProgressBar;

interface

uses
  Winapi.Windows, System.Classes, System.SysUtils,
  Vcl.Controls, Vcl.Graphics;

type
  TCustomProgresBar = class;

  TProgressBarOrientation = (poLeftToRight, poRightToLeft, poBottomToTop, poTopToBottom);

  TProgressBarDisplay = (pdNone, pdPercent, pdCurrent, pdCurrentTotal, pdCustom);

  TCustomProgresBar = class(TCustomControl)
  private
    FMax: Integer;
    FMin: Integer;
    FPosition: Integer;
    FOrientation: TProgressBarOrientation;
    FForeColor: TColor;
    FBackColor: TColor;
    FDisplay: TProgressBarDisplay;
    procedure SetMax(const Value: Integer);
    procedure SetMin(const Value: Integer);
    procedure SetPosition(const Value: Integer);
    procedure SetOrientation(const Value: TProgressBarOrientation);
    procedure SetBackColor(const Value: TColor);
    procedure SetForeColor(const Value: TColor);
    procedure SetDisplay(const Value: TProgressBarDisplay);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Min: Integer read FMin write SetMin;
    property Max: Integer read FMax write SetMax;
    property Position: Integer read FPosition write SetPosition;
    property Orientation: TProgressBarOrientation read FOrientation write SetOrientation;
    property Display: TProgressBarDisplay read FDisplay write SetDisplay;
    property BackColor: TColor read FBackColor write SetBackColor;
    property ForeColor: TColor read FForeColor write SetForeColor;

    property Align;
    property Anchors;
    property Caption;
    property Font;
  end;


implementation

{ TCustomProgresBar }

constructor TCustomProgresBar.Create(AOwner: TComponent);
begin
  inherited;
  Width:= 200;
  Height:= 25;
  FMin:= 0;
  FMax:= 100;
  FPosition:= 0;
  FBackColor:= clGray;
  FForeColor:= clNavy;
  Font.Color:= clWhite;
  Font.Style:= [fsBold];
end;

destructor TCustomProgresBar.Destroy;
begin

  inherited;
end;

procedure TCustomProgresBar.SetBackColor(const Value: TColor);
begin
  FBackColor := Value;
  Invalidate;
end;

procedure TCustomProgresBar.SetDisplay(const Value: TProgressBarDisplay);
begin
  FDisplay := Value;
  Invalidate;
end;

procedure TCustomProgresBar.SetForeColor(const Value: TColor);
begin
  FForeColor := Value;
  Invalidate;
end;

procedure TCustomProgresBar.SetMax(const Value: Integer);
begin
  FMax := Value;
  Invalidate;
end;

procedure TCustomProgresBar.SetMin(const Value: Integer);
begin
  FMin := Value;
  Invalidate;
end;

procedure TCustomProgresBar.SetOrientation(const Value: TProgressBarOrientation);
begin
  FOrientation := Value;
  Invalidate;
end;

procedure TCustomProgresBar.SetPosition(const Value: Integer);
begin
  FPosition := Value;
  if FPosition > FMax then FPosition:= FMax;
  if FPosition < FMin then FPosition:= FMin;
  Invalidate;
end;

procedure TCustomProgresBar.Paint;
var
  R: TRect;
  D: Single;
  TW, TH: Integer;
  S: String;
begin
  //Calculation
  R:= Canvas.ClipRect;
  D:= FPosition / FMax;

  //Background
  Canvas.Brush.Style:= bsSolid;
  Canvas.Pen.Style:= psClear;
  Canvas.Brush.Color:= FBackColor;
  Canvas.FillRect(Canvas.ClipRect);

  //Foreground
  case FOrientation of
    poLeftToRight: R.Right:= Trunc(ClientWidth * D);
    poRightToLeft: R.Left:= R.Width - Trunc(ClientWidth * D);
    poBottomToTop: R.Top:= R.Height - Trunc(ClientHeight * D);
    poTopToBottom: R.Bottom:= Trunc(ClientHeight * D);
  end;
  Canvas.Brush.Color:= FForeColor;
  Canvas.FillRect(R);

  //Display Text
  case FDisplay of
    pdPercent: begin
      S:= FormatFloat('0%', (D * 100));
    end;
    pdCurrent: begin
      S:= IntToStr(FPosition);
    end;
    pdCurrentTotal: begin
      S:= IntToStr(FPosition) + ' of ' + IntToStr(FMax);
    end;
    pdCustom: begin
      S:= Caption;
    end;
  end;
  Canvas.Font.Assign(Font);
  TW:= Canvas.TextWidth(S);
  TH:= Canvas.TextHeight(S);
  R.Left:= (ClientWidth div 2) - (TW div 2);
  R.Width:= TW;
  R.Top:= (ClientHeight div 2) - (TH div 2);
  R.Height:= TH;
  Canvas.Brush.Style:= bsClear;

  DrawText(Canvas.Handle, S, Length(S), R, 0);

end;

end.













Test Form:



unit uProgBarTest;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  ProgressBar;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    FProg: TCustomProgresBar;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown:= True;
  FProg:= TCustomProgresBar.Create(Self);
  FProg.Parent:= Self;
  FProg.Position:= 25;
  FProg.Display:= TProgressBarDisplay.pdCurrentTotal;
end;

end.