ExCtrls/ProgressBarEx: Add TextMode tmValueAndPercent

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8783 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2023-03-29 18:03:46 +00:00 · 2023-03-29 18:03:46 +00:00 · 6cd7bf9902
commit 6cd7bf9902
parent 3b94b13c57
3 changed files with 89 additions and 64 deletions
--- 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
--- 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);
--- 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;