mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
ew8bakandClaude Sonnet 4.6
f87869cd91
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>
125 lines
2.8 KiB
ObjectPascal
125 lines
2.8 KiB
ObjectPascal
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.
|