pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

ExCtrls/ProgressBarEx: Add TextMode tmValueAndPercent

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8783 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-03-29 18:03:46 +00:00
parent 3b94b13c57
commit 6cd7bf9902
3 changed files with 89 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

65
components/exctrls/source/exprogressbar.pas
View File

@ -11,7 +11,7 @@ uses
type
TProgressBarBorderStyle = (bsNone, bsFlat, bsSunken, bsRaised, bsEtched);
TProgressbarDrawStyle = (pdsFlat, pdsGradient, pdsRounded, pdsShiny, pdsBevel);
TProgressbarTextMode = (tmNone, tmValue, tmPercent, tmCustom);
TProgressbarTextMode = (tmNone, tmValue, tmPercent, tmValueAndPercent, tmCustom);
TProgressbarEx = class(TGraphicControl)
private
@ -53,6 +53,7 @@ type
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
function GetBarRect: TRect;
function GetCaptionText: String;
class function GetControlClassDefaultSize: TSize; override;
function IsHorizontal(AOrientation: TProgressbarOrientation): Boolean;
procedure Paint; override;
@ -188,6 +189,47 @@ begin
end;
end;
function TProgressbarEx.GetCaptionText: String;
var
posValue: Double;
begin
if FStyle = pbstMarquee then
Result := FCaption
else
begin
Result := '';
case FTextMode of
tmValue:
if FCaption = '' then
Result := IntToStr(FPosition)
else
Result := Format(FCaption, [FPosition]);
tmPercent:
if FMax <> FMin then
begin
posValue := (FPosition - FMin) / (FMax - FMin) * 100.0;
if (FCaption = '') then
Result := Format('%.0f%%', [posValue])
else
Result := Format(FCaption, [posValue]);
end else
exit;
tmValueAndPercent:
if FMax <> FMin then
begin
posValue := (FPosition - FMin) / (FMax - FMin) * 100.0;
if FCaption = '' then
Result := Format('%0:d (%1:.0f%%)', [FPosition, posValue])
else
Result := Format(FCaption, [FPosition, posValue]);
end else
exit;
tmCustom:
Result := FCaption;
end;
end;
end;
function TProgressbarEx.GetColors(AIndex: Integer): TColor;
begin
Result := FColors[AIndex];
@ -208,7 +250,6 @@ procedure TProgressbarEx.Paint;
var
R, R1, R2: TRect;
FontAngle: Integer;
posValue: Double;
txt: String;
txtSize: TSize;
isHor: Boolean;
@ -342,25 +383,7 @@ begin
// Draw text
if FTextMode <> tmNone then
begin
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;
txt := GetCaptionText;
txtSize := Canvas.TextExtent(txt);
Canvas.Font.Assign(Font);
Canvas.Font.Orientation := fontAngle;