You've already forked lazarus-ccr
ExCtrls/TProgressBarEx: Add border styles, AutoSize, improved captions.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8782 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -5,10 +5,13 @@ unit ExProgressbar;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, Types, Controls, ExtCtrls, ComCtrls;
|
||||
LCLIntf, LCLType, Classes, SysUtils, Graphics, Types, Controls,
|
||||
ExtCtrls, ComCtrls;
|
||||
|
||||
type
|
||||
TProgressBarBorderStyle = (bsNone, bsFlat, bsSunken, bsRaised, bsEtched);
|
||||
TProgressbarDrawStyle = (pdsFlat, pdsGradient, pdsRounded, pdsShiny, pdsBevel);
|
||||
TProgressbarTextMode = (tmNone, tmValue, tmPercent, tmCustom);
|
||||
|
||||
TProgressbarEx = class(TGraphicControl)
|
||||
private
|
||||
@@ -20,9 +23,10 @@ type
|
||||
DEFAULT_MARQUEELENGTH = 120;
|
||||
DEFAULT_MARQUEESPEED = 8;
|
||||
private
|
||||
FBorderStyle: TProgressBarBorderStyle;
|
||||
FCaption: String;
|
||||
FColors: array[0..3] of TColor;
|
||||
FDrawStyle: TProgressbarDrawStyle;
|
||||
FDrawStyle: TProgressBarDrawStyle;
|
||||
FMarqueePosition: Integer;
|
||||
FMarqueeLength: Integer;
|
||||
FMarqueeSpeed: Integer;
|
||||
@@ -31,8 +35,10 @@ type
|
||||
FOrientation: TProgressBarOrientation; // (pbHorizontal, pbVertical, pbRightToLeft, pbTopDown)
|
||||
FPosition: Integer;
|
||||
FStyle: TProgressBarStyle; // (pbstNormal, pbstMarquee)
|
||||
FTextMode: TProgressBarTextMode;
|
||||
FTimer: TTimer;
|
||||
function GetColors(AIndex: Integer): TColor;
|
||||
procedure SetBorderStyle(AValue: TProgressBarBorderStyle);
|
||||
procedure SetCaption(AValue: String);
|
||||
procedure SetColors(AIndex: Integer; AValue: TColor);
|
||||
procedure SetDrawStyle(AValue: TProgressbarDrawStyle);
|
||||
@@ -41,6 +47,7 @@ type
|
||||
procedure SetOrientation(AValue: TProgressbarOrientation);
|
||||
procedure SetPosition(AValue: Integer);
|
||||
procedure SetStyle(AValue: TProgressbarStyle);
|
||||
procedure SetTextMode(AValue: TProgressBarTextMode);
|
||||
procedure TimerHandler(Sender: TObject);
|
||||
protected
|
||||
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
||||
@@ -49,11 +56,13 @@ type
|
||||
class function GetControlClassDefaultSize: TSize; override;
|
||||
function IsHorizontal(AOrientation: TProgressbarOrientation): Boolean;
|
||||
procedure Paint; override;
|
||||
procedure SetAutoSize(AValue: Boolean); 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 BorderStyle: TProgressbarBorderStyle read FBorderSTyle write SetBorderStyle default bsFlat;
|
||||
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;
|
||||
@@ -65,9 +74,11 @@ type
|
||||
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 TextMode: TProgressBarTextMode read FTextMode write SetTextMode default tmNone;
|
||||
|
||||
property Align;
|
||||
property Anchors;
|
||||
property AutoSize;
|
||||
property BorderSpacing;
|
||||
property Constraints;
|
||||
property Font;
|
||||
@@ -90,6 +101,8 @@ begin
|
||||
inherited;
|
||||
ControlStyle := ControlStyle - [csSetCaption];
|
||||
|
||||
FBorderStyle := bsFlat;
|
||||
|
||||
FCaption := '';
|
||||
FColors[0] := DEFAULT_BACKCOLOR;
|
||||
FColors[1] := DEFAULT_BORDERCOLOR;
|
||||
@@ -121,7 +134,12 @@ function TProgressBarEx.GetBarRect: TRect;
|
||||
var
|
||||
fraction: Double;
|
||||
begin
|
||||
Result := Rect(1, 1, Width-1, Height-1);
|
||||
Result := Rect(0, 0, Width, Height);
|
||||
case FBorderStyle of
|
||||
bsNone: ;
|
||||
bsEtched: InflateRect(Result, -2, -2);
|
||||
else InflateRect(Result, -1, -1);
|
||||
end;
|
||||
fraction := (FPosition - FMin) / (FMax - FMin);
|
||||
case FStyle of
|
||||
pbstNormal:
|
||||
@@ -129,10 +147,10 @@ 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));
|
||||
pbHorizontal: Result.Right := round(fraction * (Width - 1));
|
||||
pbRightToLeft: Result.Left := Result.Right - round(fraction * (Width - 1));
|
||||
pbVertical: Result.Top := Result.Bottom - round(fraction * (Height - 1));
|
||||
pbTopDown: Result.Bottom := round(fraction * (Height - 1));
|
||||
end;
|
||||
end;
|
||||
pbstMarquee:
|
||||
@@ -190,6 +208,8 @@ procedure TProgressbarEx.Paint;
|
||||
var
|
||||
R, R1, R2: TRect;
|
||||
FontAngle: Integer;
|
||||
posValue: Double;
|
||||
txt: String;
|
||||
txtSize: TSize;
|
||||
isHor: Boolean;
|
||||
col1, col2, col3: TColor;
|
||||
@@ -199,8 +219,30 @@ begin
|
||||
// Draw background with border
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.Brush.Color := BackColor;
|
||||
Canvas.Pen.Color := BorderColor;
|
||||
Canvas.Rectangle(0, 0, Width, Height);
|
||||
R := Rect(0, 0, Width, Height);
|
||||
if FBorderStyle = bsNone then
|
||||
Canvas.FillRect(R)
|
||||
else
|
||||
if FBorderStyle = bsFlat then
|
||||
begin
|
||||
Canvas.Pen.Color := BorderColor;
|
||||
Canvas.Rectangle(R);
|
||||
end else
|
||||
begin
|
||||
case FBorderStyle of
|
||||
bsSunken:
|
||||
DrawEdge(Canvas.Handle, R, BDR_SUNKENOUTER, BF_RECT);
|
||||
bsRaised:
|
||||
DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_RECT);
|
||||
bsEtched:
|
||||
begin
|
||||
DrawEdge(Canvas.Handle, R, EDGE_ETCHED, BF_RECT);
|
||||
InflateRect(R, -1, -1);
|
||||
end;
|
||||
end;
|
||||
InflateRect(R, -1, -1);
|
||||
Canvas.FillRect(R);
|
||||
end;
|
||||
|
||||
// Draw bar
|
||||
R := GetBarRect;
|
||||
@@ -298,22 +340,74 @@ begin
|
||||
end;
|
||||
|
||||
// Draw text
|
||||
if FCaption <> '' then
|
||||
if FTextMode <> tmNone then
|
||||
begin
|
||||
txtSize := Canvas.TextExtent(FCaption);
|
||||
case FTextMode of
|
||||
tmValue:
|
||||
if FCaption = '' then
|
||||
txt := IntToStr(FPosition)
|
||||
else
|
||||
txt := Format(FCaption, [1.0*FPosition]);
|
||||
tmPercent:
|
||||
if FMax <> FMin then
|
||||
begin
|
||||
posValue := (FPosition - FMin) / (FMax - FMin) * 100.0;
|
||||
if (FCaption = '') then
|
||||
txt := Format('%.1f%%', [posValue])
|
||||
else
|
||||
txt := Format(FCaption, [posValue]);
|
||||
end else
|
||||
exit;
|
||||
tmCustom:
|
||||
txt := FCaption;
|
||||
end;
|
||||
txtSize := Canvas.TextExtent(txt);
|
||||
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)
|
||||
Canvas.TextOut((Width - txtSize.CX) div 2, (Height - txtSize.CY) div 2, txt)
|
||||
else
|
||||
Canvas.TextOut((Width - txtSize.CY) div 2, R.Bottom - (Height - txtSize.CX) div 2, FCaption);
|
||||
Canvas.TextOut((Width - txtSize.CY) div 2, R.Bottom - (Height - txtSize.CX) div 2, txt);
|
||||
end;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TProgressBarEx.SetAutoSize(AValue: Boolean);
|
||||
var
|
||||
bmp: TBitmap;
|
||||
fh: Integer;
|
||||
begin
|
||||
inherited;
|
||||
if AutoSize then
|
||||
begin
|
||||
bmp := TBitmap.Create;
|
||||
try
|
||||
bmp.SetSize(1, 1);
|
||||
bmp.Canvas.Font.Assign(Font);
|
||||
fh := bmp.Canvas.TextHeight('Tg');
|
||||
finally
|
||||
bmp.Free;
|
||||
end;
|
||||
inc(fh, 8);
|
||||
if IsHorizontal(FOrientation) then
|
||||
Height := fh
|
||||
else
|
||||
Width := fh;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProgressBarEx.SetBorderStyle(AValue: TProgressBarBorderStyle);
|
||||
begin
|
||||
if FBorderStyle = AValue then
|
||||
exit;
|
||||
FBorderStyle := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.SetCaption(AValue: String);
|
||||
begin
|
||||
if FCaption = AValue then
|
||||
@@ -400,6 +494,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProgressBarEx.SetTextMode(AValue: TProgressBarTextMode);
|
||||
begin
|
||||
if FTextMode = AValue then
|
||||
exit;
|
||||
FTextMode := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TProgressbarEx.TimerHandler(Sender: TObject);
|
||||
begin
|
||||
inc(FMarqueePosition, FMarqueeSpeed);
|
||||
|
||||
Reference in New Issue
Block a user