Add FlatProgressBar — canvas-rendered cross-platform progress bar

Replaces TProgressBar in TWisdomProgressDialog with TFlatProgressBar, drawn entirely via Canvas (plain rectangle, no native widget styling). Dialog now receives the active TAppTheme so both dark and light themes are applied consistently to background, label, and progress bar. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-08-25 20:27:33 +00:00 · 2026-05-25 15:26:55 +03:00
parent b02f81750a
commit f87869cd91
3 changed files with 145 additions and 11 deletions
@@ -0,0 +1,124 @@
+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.