From 6cd7bf9902ddd74be412b831773b43e2021bd806 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 29 Mar 2023 18:03:46 +0000 Subject: [PATCH] ExCtrls/ProgressBarEx: Add TextMode tmValueAndPercent git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8783 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../exctrls/examples/ProgressBarEx/main.lfm | 61 ++++++++--------- .../exctrls/examples/ProgressBarEx/main.pas | 27 ++++---- components/exctrls/source/exprogressbar.pas | 65 +++++++++++++------ 3 files changed, 89 insertions(+), 64 deletions(-) diff --git a/components/exctrls/examples/ProgressBarEx/main.lfm b/components/exctrls/examples/ProgressBarEx/main.lfm index d0b7fa081..c5281d5ba 100644 --- a/components/exctrls/examples/ProgressBarEx/main.lfm +++ b/components/exctrls/examples/ProgressBarEx/main.lfm @@ -1,21 +1,21 @@ object Form1: TForm1 Left = 261 - Height = 567 + Height = 511 Top = 130 - Width = 473 + Width = 528 Caption = 'TProgressBarEx Demo' - ClientHeight = 567 - ClientWidth = 473 + ClientHeight = 511 + ClientWidth = 528 OnCreate = FormCreate LCLVersion = '2.3.0.0' object GroupBox1: TGroupBox Left = 106 Height = 136 Top = 88 - Width = 347 + Width = 409 Caption = 'Style' ClientHeight = 116 - ClientWidth = 343 + ClientWidth = 405 TabOrder = 0 object rbNormalStyle: TRadioButton AnchorSideTop.Control = ScrollBar1 @@ -46,7 +46,7 @@ object Form1: TForm1 Left = 136 Height = 17 Top = 4 - Width = 201 + Width = 257 BorderSpacing.Top = 4 PageSize = 0 TabOrder = 2 @@ -58,7 +58,7 @@ object Form1: TForm1 Left = 136 Height = 23 Top = 29 - Width = 201 + Width = 257 BorderSpacing.Top = 8 OnChange = Edit1Change TabOrder = 3 @@ -110,7 +110,7 @@ object Form1: TForm1 end end object btnFont: TButton - Left = 310 + Left = 374 Height = 25 Top = 344 Width = 75 @@ -121,13 +121,13 @@ object Form1: TForm1 object ProgressBar1: TProgressBar Left = 13 Height = 20 - Top = 32 + Top = 40 Width = 450 TabOrder = 2 Visible = False end object clbBackColor: TColorButton - Left = 305 + Left = 369 Height = 25 Top = 232 Width = 146 @@ -140,7 +140,7 @@ object Form1: TForm1 OnColorChanged = clbBackColorColorChanged end object clbBarColor: TColorButton - Left = 304 + Left = 368 Height = 25 Top = 259 Width = 146 @@ -153,7 +153,7 @@ object Form1: TForm1 OnColorChanged = clbBarColorColorChanged end object clbGradientEndColor: TColorButton - Left = 304 + Left = 368 Height = 25 Top = 287 Width = 146 @@ -166,7 +166,7 @@ object Form1: TForm1 OnColorChanged = clbGradientEndColorColorChanged end object clbBorderColor: TColorButton - Left = 304 + Left = 368 Height = 25 Top = 315 Width = 146 @@ -191,7 +191,7 @@ object Form1: TForm1 Left = 105 Height = 64 Top = 232 - Width = 190 + Width = 235 AutoFill = True Caption = 'Orientation' ChildSizing.LeftRightSpacing = 6 @@ -202,7 +202,7 @@ object Form1: TForm1 ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 2 ClientHeight = 44 - ClientWidth = 186 + ClientWidth = 231 Columns = 2 ItemIndex = 0 Items.Strings = ( @@ -217,8 +217,8 @@ object Form1: TForm1 object rgDrawingStyle: TRadioGroup Left = 105 Height = 81 - Top = 304 - Width = 185 + Top = 312 + Width = 237 AutoFill = True Caption = 'Drawing style' ChildSizing.LeftRightSpacing = 6 @@ -229,7 +229,7 @@ object Form1: TForm1 ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 2 ClientHeight = 61 - ClientWidth = 181 + ClientWidth = 233 Columns = 2 ItemIndex = 0 Items.Strings = ( @@ -243,10 +243,10 @@ object Form1: TForm1 TabOrder = 5 end object RadioGroup1: TRadioGroup - Left = 105 - Height = 64 - Top = 392 - Width = 185 + Left = 104 + Height = 88 + Top = 408 + Width = 235 AutoFill = True Caption = 'Caption' ChildSizing.LeftRightSpacing = 6 @@ -256,23 +256,24 @@ object Form1: TForm1 ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 2 - ClientHeight = 44 - ClientWidth = 181 + ClientHeight = 68 + ClientWidth = 231 Columns = 2 ItemIndex = 0 Items.Strings = ( 'None' 'Position' 'Percentage' + 'Position+Percentage' 'Custom text' ) OnClick = RadioGroup1Click TabOrder = 6 end object RadioGroup2: TRadioGroup - Left = 304 - Height = 80 - Top = 376 + Left = 374 + Height = 88 + Top = 408 Width = 140 AutoFill = True Caption = 'Border' @@ -283,7 +284,7 @@ object Form1: TForm1 ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 2 - ClientHeight = 60 + ClientHeight = 68 ClientWidth = 136 Columns = 2 ItemIndex = 1 @@ -309,7 +310,7 @@ object Form1: TForm1 object FontDialog1: TFontDialog MinFontSize = 0 MaxFontSize = 0 - Left = 408 + Left = 456 Top = 344 end end diff --git a/components/exctrls/examples/ProgressBarEx/main.pas b/components/exctrls/examples/ProgressBarEx/main.pas index 81a62954a..703420570 100644 --- a/components/exctrls/examples/ProgressBarEx/main.pas +++ b/components/exctrls/examples/ProgressBarEx/main.pas @@ -55,6 +55,7 @@ type procedure seMarqueeSpeedChange(Sender: TObject); private ProgressbarEx: TProgressbarEx; + BarHeight: Integer; public @@ -74,13 +75,14 @@ begin ProgressbarEx := TProgressbarEx.Create(self); ProgressbarEx.Left := 8; ProgressbarEx.Top := 8; - ProgressbarEx.Width := 450; - ProgressbarEx.Height := 32; + ProgressbarEx.Width := 500; + ProgressbarEx.Height := 28; ProgressbarEx.Parent := self; Progressbarex.Position := 75; Progressbar1.Left := ProgressbarEx.Left; Progressbar1.Width := ProgressbarEx.Width; + BarHeight := ProgressBar1.Height; clbBackColor.ButtonColor := ProgressbarEx.BackColor; clbBarColor.ButtonColor := ProgressbarEx.BarColor; @@ -88,9 +90,8 @@ begin clbBorderColor.ButtonColor := ProgressbarEx.BorderColor; Scrollbar1.Position := ProgressbarEx.Position; - Edit1.Hide; - Width := ProgressbarEx.Width + 2*ProgressbarEx.Left; + Width := ProgressbarEx.Width + 32; Height := Width; end; @@ -98,8 +99,9 @@ procedure TForm1.RadioGroup1Click(Sender: TObject); begin ProgressBarEx.TextMode := TProgressbarTextMode(RadioGroup1.ItemIndex); case ProgressBarEx.TextMode of - tmValue: ProgressBarEx.Caption := 'Voltage: %.0f mV'; - tmPercent: ProgressBarEx.Caption := '%.1f%% complete'; + tmValue: ProgressBarEx.Caption := 'Voltage: %d mV'; + tmPercent: ProgressBarEx.Caption := '%.0f%% complete'; + tmValueAndPercent: ProgressBarEx.Caption := '%1:.0f%% complete at position %0:d'; tmCustom: ProgressBarEx.Caption := Edit1.Text; end; end; @@ -116,16 +118,13 @@ begin ProgressbarEx.Caption := IntToStr(ProgressbarEx.Position); Scrollbar1.Position := ProgressbarEx.Position; Scrollbar1.Show; - Edit1.Hide; end; procedure TForm1.rbMarqueeStyleChange(Sender: TObject); begin Progressbar1.Style := pbstMarquee; ProgressbarEx.Style := pbstMarquee; - ProgressbarEx.Caption := Edit1.Text; Scrollbar1.Hide; - Edit1.Show; end; procedure TForm1.rgDrawingStyleClick(Sender: TObject); @@ -140,15 +139,17 @@ begin Progressbar1.Orientation := ProgressBarEx.Orientation; if Progressbar1.Orientation in [pbVertical, pbTopDown] then begin - Progressbar1.Left := 32; + Progressbar1.Left := 40; Progressbar1.Top := 8; + Progressbar1.Width := BarHeight; + ProgressBar1.Height := ProgressBarEx.Height; end else begin Progressbar1.Left := 8; - Progressbar1.Top := 32; + Progressbar1.Top := 40; + ProgressBar1.Height := BarHeight; + ProgressBar1.Width := ProgressBarEx.Width; end; - Progressbar1.Width := ProgressbarEx.Width; - Progressbar1.Height := ProgressbarEx.Height; end; procedure TForm1.Edit1Change(Sender: TObject); diff --git a/components/exctrls/source/exprogressbar.pas b/components/exctrls/source/exprogressbar.pas index 660593ed2..79311ef87 100644 --- a/components/exctrls/source/exprogressbar.pas +++ b/components/exctrls/source/exprogressbar.pas @@ -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;