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

components/exctrls/examples/ProgressBarEx/main.lfm

@@ -1,26 +1,28 @@
 object Form1: TForm1
   Left = 261
-  Height = 465
+  Height = 567
   Top = 130
   Width = 473
   Caption = 'TProgressBarEx Demo'
-  ClientHeight = 465
+  ClientHeight = 567
   ClientWidth = 473
   OnCreate = FormCreate
   LCLVersion = '2.3.0.0'
   object GroupBox1: TGroupBox
-    Left = 105
+    Left = 106
-    Height = 160
+    Height = 136
-    Top = 112
+    Top = 88
     Width = 347
     Caption = 'Style'
-    ClientHeight = 140
+    ClientHeight = 116
     ClientWidth = 343
     TabOrder = 0
     object rbNormalStyle: TRadioButton
+      AnchorSideTop.Control = ScrollBar1
+      AnchorSideTop.Side = asrCenter
       Left = 20
       Height = 19
-      Top = 9
+      Top = 3
       Width = 86
       Caption = 'Normal Style'
       Checked = True
@@ -29,28 +31,35 @@ object Form1: TForm1
       TabStop = True
     end
     object rbMarqueeStyle: TRadioButton
+      AnchorSideTop.Control = Edit1
+      AnchorSideTop.Side = asrCenter
       Left = 20
       Height = 19
-      Top = 45
+      Top = 31
       Width = 93
       Caption = 'Marquee Style'
       OnChange = rbMarqueeStyleChange
       TabOrder = 0
     end
     object ScrollBar1: TScrollBar
+      AnchorSideTop.Control = GroupBox1
       Left = 136
       Height = 17
-      Top = 11
+      Top = 4
       Width = 201
+      BorderSpacing.Top = 4
       PageSize = 0
       TabOrder = 2
       OnChange = ScrollBar1Change
     end
     object Edit1: TEdit
+      AnchorSideTop.Control = ScrollBar1
+      AnchorSideTop.Side = asrBottom
       Left = 136
       Height = 23
-      Top = 45
+      Top = 29
       Width = 201
+      BorderSpacing.Top = 8
       OnChange = Edit1Change
       TabOrder = 3
       Text = 'Some text...'
@@ -60,16 +69,19 @@ object Form1: TForm1
       AnchorSideTop.Side = asrCenter
       Left = 136
       Height = 15
-      Top = 76
+      Top = 62
       Width = 84
       Caption = 'Marquee length'
     end
     object seMarqueeLength: TSpinEdit
+      AnchorSideTop.Control = rbMarqueeStyle
+      AnchorSideTop.Side = asrBottom
       Left = 240
       Height = 23
-      Top = 72
+      Top = 58
       Width = 50
       Alignment = taRightJustify
+      BorderSpacing.Top = 8
       OnChange = seMarqueeLengthChange
       TabOrder = 4
       Value = 120
@@ -79,25 +91,28 @@ object Form1: TForm1
       AnchorSideTop.Side = asrCenter
       Left = 139
       Height = 15
-      Top = 108
+      Top = 89
       Width = 81
       Caption = 'Marquee speed'
     end
     object seMarqueeSpeed: TSpinEdit
+      AnchorSideTop.Control = seMarqueeLength
+      AnchorSideTop.Side = asrBottom
       Left = 240
       Height = 23
-      Top = 104
+      Top = 85
       Width = 50
       Alignment = taRightJustify
+      BorderSpacing.Top = 4
       OnChange = seMarqueeSpeedChange
       TabOrder = 5
       Value = 8
     end
   end
   object btnFont: TButton
-    Left = 304
+    Left = 310
     Height = 25
-    Top = 416
+    Top = 344
     Width = 75
     Caption = 'Font'
     OnClick = btnFontClick
@@ -112,9 +127,9 @@ object Form1: TForm1
     Visible = False
   end
   object clbBackColor: TColorButton
-    Left = 298
+    Left = 305
     Height = 25
-    Top = 296
+    Top = 232
     Width = 146
     BorderWidth = 2
     ButtonColorAutoSize = False
@@ -125,9 +140,9 @@ object Form1: TForm1
     OnColorChanged = clbBackColorColorChanged
   end
   object clbBarColor: TColorButton
-    Left = 297
+    Left = 304
     Height = 25
-    Top = 323
+    Top = 259
     Width = 146
     BorderWidth = 2
     ButtonColorAutoSize = False
@@ -138,9 +153,9 @@ object Form1: TForm1
     OnColorChanged = clbBarColorColorChanged
   end
   object clbGradientEndColor: TColorButton
-    Left = 297
+    Left = 304
     Height = 25
-    Top = 351
+    Top = 287
     Width = 146
     BorderWidth = 2
     ButtonColorAutoSize = False
@@ -151,9 +166,9 @@ object Form1: TForm1
     OnColorChanged = clbGradientEndColorColorChanged
   end
   object clbBorderColor: TColorButton
-    Left = 297
+    Left = 304
     Height = 25
-    Top = 379
+    Top = 315
     Width = 146
     BorderWidth = 2
     ButtonColorAutoSize = False
@@ -166,16 +181,16 @@ object Form1: TForm1
   object CheckBox1: TCheckBox
     Left = 105
     Height = 19
-    Top = 80
+    Top = 64
     Width = 164
     Caption = 'Compare with TProgressBar'
     OnChange = CheckBox1Change
     TabOrder = 3
   end
   object rgOrientation: TRadioGroup
-    Left = 104
+    Left = 105
     Height = 64
-    Top = 280
+    Top = 232
     Width = 190
     AutoFill = True
     Caption = 'Orientation'
@@ -200,9 +215,9 @@ object Form1: TForm1
     TabOrder = 4
   end
   object rgDrawingStyle: TRadioGroup
-    Left = 104
+    Left = 105
     Height = 81
-    Top = 360
+    Top = 304
     Width = 185
     AutoFill = True
     Caption = 'Drawing style'
@@ -227,10 +242,74 @@ object Form1: TForm1
     OnClick = rgDrawingStyleClick
     TabOrder = 5
   end
+  object RadioGroup1: TRadioGroup
+    Left = 105
+    Height = 64
+    Top = 392
+    Width = 185
+    AutoFill = True
+    Caption = 'Caption'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 2
+    ClientHeight = 44
+    ClientWidth = 181
+    Columns = 2
+    ItemIndex = 0
+    Items.Strings = (
+      'None'
+      'Position'
+      'Percentage'
+      'Custom text'
+    )
+    OnClick = RadioGroup1Click
+    TabOrder = 6
+  end
+  object RadioGroup2: TRadioGroup
+    Left = 304
+    Height = 80
+    Top = 376
+    Width = 140
+    AutoFill = True
+    Caption = 'Border'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 2
+    ClientHeight = 60
+    ClientWidth = 136
+    Columns = 2
+    ItemIndex = 1
+    Items.Strings = (
+      'None'
+      'Flat'
+      'Sunken'
+      'Raised'
+      'Etched'
+    )
+    OnClick = RadioGroup2Click
+    TabOrder = 7
+  end
+  object Button1: TButton
+    Left = 355
+    Height = 25
+    Top = 61
+    Width = 75
+    Caption = 'AutoSize'
+    OnClick = Button1Click
+    TabOrder = 8
+  end
   object FontDialog1: TFontDialog
     MinFontSize = 0
     MaxFontSize = 0
     Left = 408
-    Top = 408
+    Top = 344
   end
 end

components/exctrls/examples/ProgressBarEx/main.pas

@@ -14,6 +14,7 @@ type
 
   TForm1 = class(TForm)
     btnFont: TButton;
+    Button1: TButton;
     CheckBox1: TCheckBox;
     clbBackColor: TColorButton;
     clbBarColor: TColorButton;
@@ -25,6 +26,8 @@ type
     lblMarqueeLength: TLabel;
     lblMarqueeSpeed: TLabel;
     ProgressBar1: TProgressBar;
+    RadioGroup1: TRadioGroup;
+    RadioGroup2: TRadioGroup;
     rbNormalStyle: TRadioButton;
     rbMarqueeStyle: TRadioButton;
     rgOrientation: TRadioGroup;
@@ -33,6 +36,7 @@ type
     seMarqueeLength: TSpinEdit;
     seMarqueeSpeed: TSpinEdit;
     procedure btnFontClick(Sender: TObject);
+    procedure Button1Click(Sender: TObject);
     procedure CheckBox1Change(Sender: TObject);
     procedure clbBackColorColorChanged(Sender: TObject);
     procedure clbBarColorColorChanged(Sender: TObject);
@@ -40,6 +44,8 @@ type
     procedure clbBorderColorColorChanged(Sender: TObject);
     procedure Edit1Change(Sender: TObject);
     procedure FormCreate(Sender: TObject);
+    procedure RadioGroup1Click(Sender: TObject);
+    procedure RadioGroup2Click(Sender: TObject);
     procedure rbNormalStyleChange(Sender: TObject);
     procedure rbMarqueeStyleChange(Sender: TObject);
     procedure rgDrawingStyleClick(Sender: TObject);
@@ -69,6 +75,7 @@ begin
   ProgressbarEx.Left := 8;
   ProgressbarEx.Top := 8;
   ProgressbarEx.Width := 450;
+  ProgressbarEx.Height := 32;
   ProgressbarEx.Parent := self;
   Progressbarex.Position := 75;
 
@@ -87,6 +94,21 @@ begin
   Height := Width;
 end;
 
+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';
+    tmCustom: ProgressBarEx.Caption := Edit1.Text;
+  end;
+end;
+
+procedure TForm1.RadioGroup2Click(Sender: TObject);
+begin
+  ProgressBarEx.BorderStyle := TProgressBarBorderStyle(RadioGroup2.ItemIndex);
+end;
+
 procedure TForm1.rbNormalStyleChange(Sender: TObject);
 begin
   Progressbar1.style := pbstNormal;
@@ -141,6 +163,11 @@ begin
     ProgressbarEx.Font := FontDialog1.Font;
 end;
 
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  ProgressbarEx.AutoSize := true;
+end;
+
 procedure TForm1.CheckBox1Change(Sender: TObject);
 begin
   Progressbar1.Visible := Checkbox1.Checked;
@@ -169,8 +196,6 @@ end;
 procedure TForm1.ScrollBar1Change(Sender: TObject);
 begin
   ProgressbarEx.Position := Scrollbar1.Position;
-  ProgressbarEx.Caption := IntToStr(Scrollbar1.Position);
-
   Progressbar1.Position := Scrollbar1.Position;
 end;
 

components/exctrls/source/exprogressbar.pas

@@ -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));
+          pbHorizontal: Result.Right := round(fraction * (Width - 1));
-          pbRightToLeft: Result.Left := Result.Right - round(fraction * (Width - 2));
+          pbRightToLeft: Result.Left := Result.Right - round(fraction * (Width - 1));
-          pbVertical: Result.Top := Result.Bottom - round(fraction * (Height - 2));
+          pbVertical: Result.Top := Result.Bottom - round(fraction * (Height - 1));
-          pbTopDown: Result.Bottom := round(fraction * (Height - 2));
+          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;
+  R := Rect(0, 0, Width, Height);
-  Canvas.Rectangle(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);