You've already forked lazarus-ccr
ExCtrls: New component: TProgressBarEx (https://forum.lazarus.freepascal.org/index.php/topic,62848.0.html)
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8779 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -22,7 +22,7 @@ implementation
|
||||
{$R exctrlsreg.res}
|
||||
|
||||
uses
|
||||
ExButtons, ExCheckCtrls, ExEditCtrls, ExCombo, ExCheckCombo, ExShape;
|
||||
ExButtons, ExCheckCtrls, ExEditCtrls, ExCombo, ExCheckCombo, ExShape, ExProgressBar;
|
||||
|
||||
function TFloatSIPropertyEditor.GetValue: ansistring;
|
||||
begin
|
||||
@@ -54,6 +54,7 @@ begin
|
||||
TButtonEx, TCheckboxEx, TRadioButtonEx, TCheckGroupEx, TRadioGroupEx,
|
||||
TFloatSISpinEditEx, TCurrSpinEditEx,
|
||||
TColumnComboBoxEx, TCheckComboBoxEx,
|
||||
TProgressBarEx,
|
||||
TShapeEx
|
||||
]);
|
||||
|
||||
|
||||
Binary file not shown.
416
components/exctrls/source/exprogressbar.pas
Normal file
416
components/exctrls/source/exprogressbar.pas
Normal file
@@ -0,0 +1,416 @@
|
||||
unit ExProgressbar;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, Types, Controls, ExtCtrls, ComCtrls;
|
||||
|
||||
type
|
||||
TProgressbarDrawStyle = (pdsFlat, pdsGradient, pdsRounded, pdsShiny, pdsBevel);
|
||||
|
||||
TProgressbarEx = class(TGraphicControl)
|
||||
private
|
||||
const
|
||||
DEFAULT_BACKCOLOR = $E6E6E6;
|
||||
DEFAULT_BARCOLOR = $06B025;
|
||||
DEFAULT_GRADIENTENDCOLOR = $00FFFF;
|
||||
DEFAULT_BORDERCOLOR = clSilver;
|
||||
DEFAULT_MARQUEELENGTH = 120;
|
||||
DEFAULT_MARQUEESPEED = 8;
|
||||
private
|
||||
FCaption: String;
|
||||
FColors: array[0..3] of TColor;
|
||||
FDrawStyle: TProgressbarDrawStyle;
|
||||
FMarqueePosition: Integer;
|
||||
FMarqueeLength: Integer;
|
||||
FMarqueeSpeed: Integer;
|
||||
FMax: Integer;
|
||||
FMin: Integer;
|
||||
FOrientation: TProgressBarOrientation; // (pbHorizontal, pbVertical, pbRightToLeft, pbTopDown)
|
||||
FPosition: Integer;
|
||||
FStyle: TProgressBarStyle; // (pbstNormal, pbstMarquee)
|
||||
FTimer: TTimer;
|
||||
function GetColors(AIndex: Integer): TColor;
|
||||
procedure SetCaption(AValue: String);
|
||||
procedure SetColors(AIndex: Integer; AValue: TColor);
|
||||
procedure SetDrawStyle(AValue: TProgressbarDrawStyle);
|
||||
procedure SetMax(AValue: Integer);
|
||||
procedure SetMin(AValue: Integer);
|
||||
procedure SetOrientation(AValue: TProgressbarOrientation);
|
||||
procedure SetPosition(AValue: Integer);
|
||||
procedure SetStyle(AValue: TProgressbarStyle);
|
||||
procedure TimerHandler(Sender: TObject);
|
||||
protected
|
||||
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
||||
const AXProportion, AYProportion: Double); override;
|
||||
function GetBarRect: TRect;
|
||||
class function GetControlClassDefaultSize: TSize; override;
|
||||
function IsHorizontal(AOrientation: TProgressbarOrientation): Boolean;
|
||||
procedure Paint; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
property BackColor: TColor index 0 read GetColors write SetColors default DEFAULT_BACKCOLOR;
|
||||
property BorderColor: TColor index 1 read GetColors write SetColors default DEFAULT_BORDERCOLOR;
|
||||
property BarColor: TColor index 2 read GetColors write SetColors default DEFAULT_BARCOLOR;
|
||||
property GradientEndColor: TColor index 3 read GetColors write SetColors default DEFAULT_GRADIENTENDCOLOR;
|
||||
property Caption: String read FCaption write SetCaption;
|
||||
property DrawStyle: TProgressbarDrawStyle read FDrawStyle write SetDrawStyle default pdsFlat;
|
||||
property MarqueeLength: Integer read FMarqueeLength write FMarqueeLength default DEFAULT_MARQUEELENGTH;
|
||||
property MarqueeSpeed: Integer read FMarqueeSpeed write FMarqueeSpeed default DEFAULT_MARQUEESPEED;
|
||||
property Max: Integer read FMax write SetMax default 100;
|
||||
property Min: Integer read FMin write SetMin default 0;
|
||||
property Orientation: TProgressbarOrientation read FOrientation write SetOrientation default pbHorizontal;
|
||||
property Position: Integer read FPosition write SetPosition default 0;
|
||||
property Style: TProgressbarStyle read FStyle write SetStyle default pbstNormal;
|
||||
|
||||
property Align;
|
||||
property Anchors;
|
||||
property BorderSpacing;
|
||||
property Constraints;
|
||||
property Font;
|
||||
property Hint;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property ShowHint;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
GraphUtil;
|
||||
|
||||
constructor TProgressbarEx.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FCaption := '';
|
||||
FColors[0] := DEFAULT_BACKCOLOR;
|
||||
FColors[1] := DEFAULT_BORDERCOLOR;
|
||||
FColors[2] := DEFAULT_BARCOLOR;
|
||||
FColors[3] := DEFAULT_GRADIENTENDCOLOR;
|
||||
FMarqueeLength := DEFAULT_MARQUEELENGTH;
|
||||
FMarqueeSpeed := DEFAULT_MARQUEESPEED;
|
||||
FMax := 100;
|
||||
FStyle := pbstNormal;
|
||||
FTimer := TTimer.Create(self);
|
||||
FTimer.Interval := 25;
|
||||
FTimer.OnTimer := @TimerHandler;
|
||||
with GetControlClassDefaultSize do
|
||||
SetInitialBounds(0, 0, CX, CY);
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
||||
const AXProportion, AYProportion: Double);
|
||||
begin
|
||||
inherited;
|
||||
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
|
||||
FMarqueeLength := round(DEFAULT_MARQUEELENGTH * AXProportion);
|
||||
end;
|
||||
|
||||
function TProgressBarEx.GetBarRect: TRect;
|
||||
var
|
||||
fraction: Double;
|
||||
begin
|
||||
Result := Rect(1, 1, Width-1, Height-1);
|
||||
fraction := (FPosition - FMin) / (FMax - FMin);
|
||||
case FStyle of
|
||||
pbstNormal:
|
||||
begin
|
||||
if FMax = FMin then
|
||||
exit(Rect(0, 0, 0, 0));
|
||||
case FOrientation of
|
||||
pbHorizontal: Result.Right := round(fraction * (Width - 2));
|
||||
pbRightToLeft: Result.Left := Result.Right - round(fraction * (Width - 2));
|
||||
pbVertical: Result.Top := Result.Bottom - round(fraction * (Height - 2));
|
||||
pbTopDown: Result.Bottom := round(fraction * (Height - 2));
|
||||
end;
|
||||
end;
|
||||
pbstMarquee:
|
||||
case FOrientation of
|
||||
pbHorizontal:
|
||||
begin
|
||||
Result.Right := FMarqueePosition;
|
||||
Result.Left := Result.Right - FMarqueeLength;
|
||||
end;
|
||||
pbRightToLeft:
|
||||
begin
|
||||
Result.Left := Result.Right - FMarqueePosition;
|
||||
Result.Right := Result.Left + FMarqueelength;
|
||||
end;
|
||||
pbVertical:
|
||||
begin
|
||||
Result.Top := Result.Bottom - FMarqueePosition;
|
||||
Result.Bottom := Result.Top + FMarqueeLength;
|
||||
end;
|
||||
pbTopDown:
|
||||
begin
|
||||
Result.Bottom := FMarqueePosition;
|
||||
Result.Top := Result.Bottom - FMarqueeLength;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if IsHorizontal(FOrientation) then
|
||||
begin
|
||||
if Result.Right >= Width - 1 then Result.Right := Width - 1;
|
||||
if Result.Left < 1 then Result.Left := 1;
|
||||
end else
|
||||
begin
|
||||
if Result.Bottom >= Height - 1 then Result.Bottom := Height - 1;
|
||||
if Result.Top < 1 then Result.Top := 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TProgressbarEx.GetColors(AIndex: Integer): TColor;
|
||||
begin
|
||||
Result := FColors[AIndex];
|
||||
end;
|
||||
|
||||
class function TProgressbarEx.GetControlClassDefaultSize: TSize;
|
||||
begin
|
||||
Result.CX := 200;
|
||||
Result.CY := 20;
|
||||
end;
|
||||
|
||||
function TProgressbarEx.IsHorizontal(AOrientation: TProgressbarOrientation): Boolean;
|
||||
begin
|
||||
Result := (AOrientation in [pbHorizontal, pbRightToLeft]);
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.Paint;
|
||||
var
|
||||
R, R1, R2: TRect;
|
||||
FontAngle: Integer;
|
||||
txtSize: TSize;
|
||||
isHor: Boolean;
|
||||
col1, col2, col3: TColor;
|
||||
begin
|
||||
isHor := IsHorizontal(FOrientation);
|
||||
|
||||
// Draw background with border
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.Brush.Color := BackColor;
|
||||
Canvas.Pen.Color := BorderColor;
|
||||
Canvas.Rectangle(0, 0, Width, Height);
|
||||
|
||||
// Draw bar
|
||||
R := GetBarRect;
|
||||
if isHor then
|
||||
FontAngle := 0
|
||||
else
|
||||
FontAngle := 900;
|
||||
case FDrawStyle of
|
||||
pdsFlat:
|
||||
begin
|
||||
Canvas.Brush.Color := BarColor;
|
||||
Canvas.FillRect(R);
|
||||
end;
|
||||
pdsGradient:
|
||||
begin
|
||||
case FOrientation of
|
||||
pbHorizontal:
|
||||
Canvas.GradientFill(R, BarColor, GradientEndColor, gdHorizontal);
|
||||
pbVertical:
|
||||
Canvas.GradientFill(R, GradientEndColor, barColor, gdVertical);
|
||||
pbRightToLeft:
|
||||
Canvas.GradientFill(R, GradientEndColor, BarColor, gdHorizontal);
|
||||
pbTopDown:
|
||||
Canvas.GradientFill(R, BarColor, GradientEndColor, gdVertical);
|
||||
end;
|
||||
end;
|
||||
pdsRounded:
|
||||
begin
|
||||
col2 := BarColor;
|
||||
col1 := GetHighlightColor(col2, 60);
|
||||
col3 := GetShadowColor(col2, -60);
|
||||
R1 := R;
|
||||
R2 := R;
|
||||
if isHor then
|
||||
begin
|
||||
R1.Bottom := R.Top + R.Height div 2;
|
||||
R2.Top := R1.Bottom;
|
||||
Canvas.GradientFill(R1, col1, col2, gdVertical);
|
||||
Canvas.GradientFill(R2, col2, col3, gdVertical);
|
||||
end else
|
||||
begin
|
||||
R1.Right := R.Left + R.Width div 2;
|
||||
R2.Left := R1.Right;
|
||||
Canvas.GradientFill(R1, col1, col2, gdHorizontal);
|
||||
Canvas.GradientFill(R2, col2, col3, gdHorizontal);
|
||||
end;
|
||||
end;
|
||||
pdsShiny:
|
||||
begin
|
||||
col1 := GetHighlightColor(BarColor, 50);
|
||||
col2 := GetHighlightColor(BarColor, 25);
|
||||
col3 := GetShadowColor(BarColor, -20);
|
||||
R1 := R;
|
||||
R2 := R;
|
||||
if isHor then
|
||||
begin
|
||||
R1.Bottom := R.Top + R.Height div 3;
|
||||
R2.Top := R1.Bottom ;
|
||||
Canvas.GradientFill(R1, col1, col2, gdVertical);
|
||||
Canvas.GradientFill(R2, BarColor, col3, gdVertical);
|
||||
end else
|
||||
begin
|
||||
R1 := R;
|
||||
R1.Right := R.Left + R.Width div 3;
|
||||
R2.Left := R1.Right;
|
||||
Canvas.GradientFill(R1, col1, col2, gdHorizontal);
|
||||
Canvas.GradientFill(R2, BarColor, col3, gdHorizontal);
|
||||
end;
|
||||
end;
|
||||
pdsBevel:
|
||||
begin
|
||||
col1 := BarColor;
|
||||
Canvas.Brush.Color := col1;
|
||||
inc(R.Right);
|
||||
Canvas.FillRect(R);
|
||||
col2 := GetShadowColor(col1, -30);
|
||||
col1 := GetHighlightColor(col1, 30);
|
||||
R1 := R;
|
||||
InflateRect(R1, -1, -1);
|
||||
R2 := R;
|
||||
InflateRect(R2, -2, -2);
|
||||
Canvas.Pen.Color := col1;
|
||||
Canvas.Line(R1.Right, R1.Top, R1.Left, R1.Top);
|
||||
Canvas.Line(R2.Right, R2.Top, R2.Left, R2.Top);
|
||||
Canvas.Line(R1.Left, R.Top, R1.Left, R1.Bottom);
|
||||
Canvas.Line(R2.Left, R2.Top, R2.Left, R2.Bottom);
|
||||
Canvas.Pen.Color := col2;
|
||||
Canvas.Line(R1.Left, R1.Bottom, R1.Right, R1.Bottom);
|
||||
Canvas.Line(R2.Left, R2.Bottom, R2.Right, R2.Bottom);
|
||||
Canvas.Line(R1.Right, R1.Bottom, R1.Right, R1.Top);
|
||||
Canvas.Line(R2.Right, R2.Bottom, R2.Right, R2.Top);
|
||||
end;
|
||||
else
|
||||
raise Exception.Create('DrawStyle not implemented.');
|
||||
end;
|
||||
|
||||
// Draw text
|
||||
if FCaption <> '' then
|
||||
begin
|
||||
txtSize := Canvas.TextExtent(FCaption);
|
||||
Canvas.Font.Assign(Font);
|
||||
Canvas.Font.Orientation := fontAngle;
|
||||
Canvas.Brush.Style := bsClear;
|
||||
R := Rect(0, 0, Width, Height);
|
||||
if isHor then
|
||||
Canvas.TextOut((Width - txtSize.CX) div 2, (Height - txtSize.CY) div 2, FCaption)
|
||||
else
|
||||
Canvas.TextOut((Width - txtSize.CY) div 2, R.Bottom - (Height - txtSize.CX) div 2, FCaption);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.SetCaption(AValue: String);
|
||||
begin
|
||||
if FCaption = AValue then
|
||||
exit;
|
||||
FCaption := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.SetColors(AIndex: Integer; AValue: TColor);
|
||||
begin
|
||||
if FColors[AIndex] = AValue then
|
||||
exit;
|
||||
FColors[AIndex] := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.SetDrawStyle(AValue: TProgressbarDrawStyle);
|
||||
begin
|
||||
if FDrawStyle = AValue then
|
||||
exit;
|
||||
FDrawStyle := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.SetMax(AValue: Integer);
|
||||
begin
|
||||
if FMax = AValue then
|
||||
exit;
|
||||
FMax := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.SetMin(AValue: Integer);
|
||||
begin
|
||||
if FMin = AValue then
|
||||
exit;
|
||||
FMin := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.SetOrientation(AValue: TProgressbarOrientation);
|
||||
var
|
||||
rotate: Boolean;
|
||||
begin
|
||||
if FOrientation = AValue then
|
||||
exit;
|
||||
rotate := IsHorizontal(AValue) xor IsHorizontal(FOrientation);
|
||||
FOrientation := AValue;
|
||||
if rotate then
|
||||
SetBounds(Left, Top, Height, Width)
|
||||
else
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.SetPosition(AValue: Integer);
|
||||
begin
|
||||
if FPosition = AValue then
|
||||
exit;
|
||||
if AValue > FMax then
|
||||
FPosition := FMax
|
||||
else if AValue < FMin then
|
||||
FPosition := FMin
|
||||
else
|
||||
FPosition := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.SetStyle(AValue: TProgressbarStyle);
|
||||
begin
|
||||
if FStyle = AValue then
|
||||
exit;
|
||||
FStyle := AValue;
|
||||
case FStyle of
|
||||
pbstNormal:
|
||||
begin
|
||||
FPosition := FMin;
|
||||
FTimer.Enabled := false;
|
||||
end;
|
||||
pbstMarquee:
|
||||
begin
|
||||
FMarqueePosition := 0;
|
||||
FTimer.Enabled := true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.TimerHandler(Sender: TObject);
|
||||
begin
|
||||
inc(FMarqueePosition, FMarqueeSpeed);
|
||||
if IsHorizontal(FOrientation) then
|
||||
begin
|
||||
if (FMarqueePosition - FMarqueeLength > Width) and (FMarqueeSpeed > 0) then
|
||||
FMarqueePosition := 0
|
||||
else
|
||||
if (FMarqueePosition < 0) and (FMarqueeSpeed < 0) then
|
||||
FMarqueePosition := Width + FMarqueeLength;
|
||||
end else
|
||||
begin
|
||||
if (FMarqueePosition - FMarqueeLength > Height) and (FMarqueeSpeed > 0) then
|
||||
FMarqueePosition := 0
|
||||
else
|
||||
if (FMarqueePosition < 0) and (FMarqueeSpeed < 0) then
|
||||
FMarqueePosition := Height + FMarqueeLength;
|
||||
end;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user