ewsdr/FlatProgressBar.pas

{
  Copyright (C)
  2026 - Uladzimir Karpenka, EW8BAK

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either version 2
  of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
}

unit FlatProgressBar;

{ Custom progress bar with canvas rendering.
  Use instead of TProgressBar where native widgetset styling is undesirable. }

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Controls, Graphics, Math, AppTheme;

type
  TFlatProgressBar = class(TGraphicControl)
  private
    FMin:      Integer;
    FMax:      Integer;
    FPosition: Integer;
    FClrBG:     TColor;
    FClrTrack:  TColor;
    FClrFill:   TColor;
    FClrBorder: TColor;
    procedure SetMin(V: Integer);
    procedure SetMax(V: Integer);
    procedure SetPosition(V: Integer);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetAppTheme(const T: TAppTheme);

    property Min:      Integer read FMin      write SetMin;
    property Max:      Integer read FMax      write SetMax;
    property Position: Integer read FPosition write SetPosition;
    property Align;
    property Anchors;
    property Enabled;
    property Visible;
  end;

implementation

constructor TFlatProgressBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width  := 200;
  Height := 22;
  FMin      := 0;
  FMax      := 100;
  FPosition := 0;
  FClrBG     := TColor($00181818);
  FClrTrack  := TColor($00323232);
  FClrFill   := TColor($00205018);
  FClrBorder := TColor($00444444);
end;

procedure TFlatProgressBar.SetAppTheme(const T: TAppTheme);
begin
  FClrBG     := T.Panel;
  FClrTrack  := T.SliderTrackEmpty;
  FClrFill   := T.SliderTrackFill;
  FClrBorder := T.BtnBorderNorm;
  Invalidate;
end;

procedure TFlatProgressBar.SetMin(V: Integer);
begin
  if FMin = V then Exit;
  FMin := V;
  if FPosition < FMin then FPosition := FMin;
  Invalidate;
end;

procedure TFlatProgressBar.SetMax(V: Integer);
begin
  if FMax = V then Exit;
  FMax := V;
  if FPosition > FMax then FPosition := FMax;
  Invalidate;
end;

procedure TFlatProgressBar.SetPosition(V: Integer);
var C: Integer;
begin
  C := EnsureRange(V, FMin, FMax);
  if FPosition = C then Exit;
  FPosition := C;
  Invalidate;
end;

procedure TFlatProgressBar.Paint;
var
  R: TRect;
  Range, TrackW, FillW: Integer;
begin
  R := ClientRect;

  Canvas.Brush.Color := FClrBG;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Style   := psClear;
  Canvas.FillRect(R);

  Canvas.Brush.Color := FClrTrack;
  Canvas.Pen.Color   := FClrBorder;
  Canvas.Pen.Style   := psSolid;
  Canvas.Pen.Width   := 1;
  Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);

  Range := FMax - FMin;
  if (Range > 0) and (FPosition > FMin) then
  begin
    TrackW := Width - 2;
    FillW  := (TrackW * (FPosition - FMin)) div Range;
    FillW  := EnsureRange(FillW, 0, TrackW);
    if FillW > 0 then
    begin
      Canvas.Brush.Color := FClrFill;
      Canvas.Pen.Style   := psClear;
      Canvas.FillRect(Rect(1, 1, 1 + FillW, Height - 1));
    end;
  end;
end;

end.