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

61
components/exctrls/examples/ProgressBarEx/main.lfm
View File

@ -1,21 +1,21 @@
object Form1: TForm1 object Form1: TForm1
Left = 261 Left = 261
Height = 567 Height = 511
Top = 130 Top = 130
Width = 473 Width = 528
Caption = 'TProgressBarEx Demo' Caption = 'TProgressBarEx Demo'
ClientHeight = 567 ClientHeight = 511
ClientWidth = 473 ClientWidth = 528
OnCreate = FormCreate OnCreate = FormCreate
LCLVersion = '2.3.0.0' LCLVersion = '2.3.0.0'
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
Left = 106 Left = 106
Height = 136 Height = 136
Top = 88 Top = 88
Width = 347 Width = 409
Caption = 'Style' Caption = 'Style'
ClientHeight = 116 ClientHeight = 116
ClientWidth = 343 ClientWidth = 405
TabOrder = 0 TabOrder = 0
object rbNormalStyle: TRadioButton object rbNormalStyle: TRadioButton
AnchorSideTop.Control = ScrollBar1 AnchorSideTop.Control = ScrollBar1
@ -46,7 +46,7 @@ object Form1: TForm1
Left = 136 Left = 136
Height = 17 Height = 17
Top = 4 Top = 4
Width = 201 Width = 257
BorderSpacing.Top = 4 BorderSpacing.Top = 4
PageSize = 0 PageSize = 0
TabOrder = 2 TabOrder = 2
@ -58,7 +58,7 @@ object Form1: TForm1
Left = 136 Left = 136
Height = 23 Height = 23
Top = 29 Top = 29
Width = 201 Width = 257
BorderSpacing.Top = 8 BorderSpacing.Top = 8
OnChange = Edit1Change OnChange = Edit1Change
TabOrder = 3 TabOrder = 3
@ -110,7 +110,7 @@ object Form1: TForm1
end end
end end
object btnFont: TButton object btnFont: TButton
Left = 310 Left = 374
Height = 25 Height = 25
Top = 344 Top = 344
Width = 75 Width = 75
@ -121,13 +121,13 @@ object Form1: TForm1
object ProgressBar1: TProgressBar object ProgressBar1: TProgressBar
Left = 13 Left = 13
Height = 20 Height = 20
Top = 32 Top = 40
Width = 450 Width = 450
TabOrder = 2 TabOrder = 2
Visible = False Visible = False
end end
object clbBackColor: TColorButton object clbBackColor: TColorButton
Left = 305 Left = 369
Height = 25 Height = 25
Top = 232 Top = 232
Width = 146 Width = 146
@ -140,7 +140,7 @@ object Form1: TForm1
OnColorChanged = clbBackColorColorChanged OnColorChanged = clbBackColorColorChanged
end end
object clbBarColor: TColorButton object clbBarColor: TColorButton
Left = 304 Left = 368
Height = 25 Height = 25
Top = 259 Top = 259
Width = 146 Width = 146
@ -153,7 +153,7 @@ object Form1: TForm1
OnColorChanged = clbBarColorColorChanged OnColorChanged = clbBarColorColorChanged
end end
object clbGradientEndColor: TColorButton object clbGradientEndColor: TColorButton
Left = 304 Left = 368
Height = 25 Height = 25
Top = 287 Top = 287
Width = 146 Width = 146
@ -166,7 +166,7 @@ object Form1: TForm1
OnColorChanged = clbGradientEndColorColorChanged OnColorChanged = clbGradientEndColorColorChanged
end end
object clbBorderColor: TColorButton object clbBorderColor: TColorButton
Left = 304 Left = 368
Height = 25 Height = 25
Top = 315 Top = 315
Width = 146 Width = 146
@ -191,7 +191,7 @@ object Form1: TForm1
Left = 105 Left = 105
Height = 64 Height = 64
Top = 232 Top = 232
Width = 190 Width = 235
AutoFill = True AutoFill = True
Caption = 'Orientation' Caption = 'Orientation'
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
@ -202,7 +202,7 @@ object Form1: TForm1
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2 ChildSizing.ControlsPerLine = 2
ClientHeight = 44 ClientHeight = 44
ClientWidth = 186 ClientWidth = 231
Columns = 2 Columns = 2
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
@ -217,8 +217,8 @@ object Form1: TForm1
object rgDrawingStyle: TRadioGroup object rgDrawingStyle: TRadioGroup
Left = 105 Left = 105
Height = 81 Height = 81
Top = 304 Top = 312
Width = 185 Width = 237
AutoFill = True AutoFill = True
Caption = 'Drawing style' Caption = 'Drawing style'
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
@ -229,7 +229,7 @@ object Form1: TForm1
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2 ChildSizing.ControlsPerLine = 2
ClientHeight = 61 ClientHeight = 61
ClientWidth = 181 ClientWidth = 233
Columns = 2 Columns = 2
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
@ -243,10 +243,10 @@ object Form1: TForm1
TabOrder = 5 TabOrder = 5
end end
object RadioGroup1: TRadioGroup object RadioGroup1: TRadioGroup
Left = 105 Left = 104
Height = 64 Height = 88
Top = 392 Top = 408
Width = 185 Width = 235
AutoFill = True AutoFill = True
Caption = 'Caption' Caption = 'Caption'
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
@ -256,23 +256,24 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2 ChildSizing.ControlsPerLine = 2
ClientHeight = 44 ClientHeight = 68
ClientWidth = 181 ClientWidth = 231
Columns = 2 Columns = 2
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
'None' 'None'
'Position' 'Position'
'Percentage' 'Percentage'
'Position+Percentage'
'Custom text' 'Custom text'
) )
OnClick = RadioGroup1Click OnClick = RadioGroup1Click
TabOrder = 6 TabOrder = 6
end end
object RadioGroup2: TRadioGroup object RadioGroup2: TRadioGroup
Left = 304 Left = 374
Height = 80 Height = 88
Top = 376 Top = 408
Width = 140 Width = 140
AutoFill = True AutoFill = True
Caption = 'Border' Caption = 'Border'
@ -283,7 +284,7 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2 ChildSizing.ControlsPerLine = 2
ClientHeight = 60 ClientHeight = 68
ClientWidth = 136 ClientWidth = 136
Columns = 2 Columns = 2
ItemIndex = 1 ItemIndex = 1
@ -309,7 +310,7 @@ object Form1: TForm1
object FontDialog1: TFontDialog object FontDialog1: TFontDialog
MinFontSize = 0 MinFontSize = 0
MaxFontSize = 0 MaxFontSize = 0
Left = 408 Left = 456
Top = 344 Top = 344
end end
end end

27
components/exctrls/examples/ProgressBarEx/main.pas
View File

@ -55,6 +55,7 @@ type
procedure seMarqueeSpeedChange(Sender: TObject); procedure seMarqueeSpeedChange(Sender: TObject);
private private
ProgressbarEx: TProgressbarEx; ProgressbarEx: TProgressbarEx;
BarHeight: Integer;
public public
@ -74,13 +75,14 @@ begin
ProgressbarEx := TProgressbarEx.Create(self); ProgressbarEx := TProgressbarEx.Create(self);
ProgressbarEx.Left := 8; ProgressbarEx.Left := 8;
ProgressbarEx.Top := 8; ProgressbarEx.Top := 8;
ProgressbarEx.Width := 450; ProgressbarEx.Width := 500;
ProgressbarEx.Height := 32; ProgressbarEx.Height := 28;
ProgressbarEx.Parent := self; ProgressbarEx.Parent := self;
Progressbarex.Position := 75; Progressbarex.Position := 75;
Progressbar1.Left := ProgressbarEx.Left; Progressbar1.Left := ProgressbarEx.Left;
Progressbar1.Width := ProgressbarEx.Width; Progressbar1.Width := ProgressbarEx.Width;
BarHeight := ProgressBar1.Height;
clbBackColor.ButtonColor := ProgressbarEx.BackColor; clbBackColor.ButtonColor := ProgressbarEx.BackColor;
clbBarColor.ButtonColor := ProgressbarEx.BarColor; clbBarColor.ButtonColor := ProgressbarEx.BarColor;
@ -88,9 +90,8 @@ begin
clbBorderColor.ButtonColor := ProgressbarEx.BorderColor; clbBorderColor.ButtonColor := ProgressbarEx.BorderColor;
Scrollbar1.Position := ProgressbarEx.Position; Scrollbar1.Position := ProgressbarEx.Position;
Edit1.Hide;
Width := ProgressbarEx.Width + 2*ProgressbarEx.Left; Width := ProgressbarEx.Width + 32;
Height := Width; Height := Width;
end; end;
@ -98,8 +99,9 @@ procedure TForm1.RadioGroup1Click(Sender: TObject);
begin begin
ProgressBarEx.TextMode := TProgressbarTextMode(RadioGroup1.ItemIndex); ProgressBarEx.TextMode := TProgressbarTextMode(RadioGroup1.ItemIndex);
case ProgressBarEx.TextMode of case ProgressBarEx.TextMode of
tmValue: ProgressBarEx.Caption := 'Voltage: %.0f mV'; tmValue: ProgressBarEx.Caption := 'Voltage: %d mV';
tmPercent: ProgressBarEx.Caption := '%.1f%% complete'; tmPercent: ProgressBarEx.Caption := '%.0f%% complete';
tmValueAndPercent: ProgressBarEx.Caption := '%1:.0f%% complete at position %0:d';
tmCustom: ProgressBarEx.Caption := Edit1.Text; tmCustom: ProgressBarEx.Caption := Edit1.Text;
end; end;
end; end;
@ -116,16 +118,13 @@ begin
ProgressbarEx.Caption := IntToStr(ProgressbarEx.Position); ProgressbarEx.Caption := IntToStr(ProgressbarEx.Position);
Scrollbar1.Position := ProgressbarEx.Position; Scrollbar1.Position := ProgressbarEx.Position;
Scrollbar1.Show; Scrollbar1.Show;
Edit1.Hide;
end; end;
procedure TForm1.rbMarqueeStyleChange(Sender: TObject); procedure TForm1.rbMarqueeStyleChange(Sender: TObject);
begin begin
Progressbar1.Style := pbstMarquee; Progressbar1.Style := pbstMarquee;
ProgressbarEx.Style := pbstMarquee; ProgressbarEx.Style := pbstMarquee;
ProgressbarEx.Caption := Edit1.Text;
Scrollbar1.Hide; Scrollbar1.Hide;
Edit1.Show;
end; end;
procedure TForm1.rgDrawingStyleClick(Sender: TObject); procedure TForm1.rgDrawingStyleClick(Sender: TObject);
@ -140,15 +139,17 @@ begin
Progressbar1.Orientation := ProgressBarEx.Orientation; Progressbar1.Orientation := ProgressBarEx.Orientation;
if Progressbar1.Orientation in [pbVertical, pbTopDown] then if Progressbar1.Orientation in [pbVertical, pbTopDown] then
begin begin
Progressbar1.Left := 32; Progressbar1.Left := 40;
Progressbar1.Top := 8; Progressbar1.Top := 8;
Progressbar1.Width := BarHeight;
ProgressBar1.Height := ProgressBarEx.Height;
end else end else
begin begin
Progressbar1.Left := 8; Progressbar1.Left := 8;
Progressbar1.Top := 32; Progressbar1.Top := 40;
ProgressBar1.Height := BarHeight;
ProgressBar1.Width := ProgressBarEx.Width;
end; end;
Progressbar1.Width := ProgressbarEx.Width;
Progressbar1.Height := ProgressbarEx.Height;
end; end;
procedure TForm1.Edit1Change(Sender: TObject); procedure TForm1.Edit1Change(Sender: TObject);

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

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