diff --git a/components/exctrls/examples/ProgressBarEx/demo.lpi b/components/exctrls/examples/ProgressBarEx/demo.lpi
new file mode 100644
index 000000000..6b0dca462
--- /dev/null
+++ b/components/exctrls/examples/ProgressBarEx/demo.lpi
@@ -0,0 +1,88 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+ -
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+ -
+
+
+ -
+
+
+
+
+
diff --git a/components/exctrls/examples/ProgressBarEx/demo.lpr b/components/exctrls/examples/ProgressBarEx/demo.lpr
new file mode 100644
index 000000000..9041e42fb
--- /dev/null
+++ b/components/exctrls/examples/ProgressBarEx/demo.lpr
@@ -0,0 +1,25 @@
+program demo;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}
+ cthreads,
+ {$ENDIF}
+ {$IFDEF HASAMIGA}
+ athreads,
+ {$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, main, ExProgressbar
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource:=True;
+ Application.Scaled:=True;
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/components/exctrls/examples/ProgressBarEx/main.lfm b/components/exctrls/examples/ProgressBarEx/main.lfm
new file mode 100644
index 000000000..54307ac56
--- /dev/null
+++ b/components/exctrls/examples/ProgressBarEx/main.lfm
@@ -0,0 +1,236 @@
+object Form1: TForm1
+ Left = 261
+ Height = 465
+ Top = 130
+ Width = 473
+ Caption = 'TProgressBarEx Demo'
+ ClientHeight = 465
+ ClientWidth = 473
+ OnCreate = FormCreate
+ LCLVersion = '2.3.0.0'
+ object GroupBox1: TGroupBox
+ Left = 105
+ Height = 160
+ Top = 112
+ Width = 347
+ Caption = 'Style'
+ ClientHeight = 140
+ ClientWidth = 343
+ TabOrder = 0
+ object rbNormalStyle: TRadioButton
+ Left = 20
+ Height = 19
+ Top = 9
+ Width = 86
+ Caption = 'Normal Style'
+ Checked = True
+ OnChange = rbNormalStyleChange
+ TabOrder = 1
+ TabStop = True
+ end
+ object rbMarqueeStyle: TRadioButton
+ Left = 20
+ Height = 19
+ Top = 45
+ Width = 93
+ Caption = 'Marquee Style'
+ OnChange = rbMarqueeStyleChange
+ TabOrder = 0
+ end
+ object ScrollBar1: TScrollBar
+ Left = 136
+ Height = 17
+ Top = 11
+ Width = 201
+ PageSize = 0
+ TabOrder = 2
+ OnChange = ScrollBar1Change
+ end
+ object Edit1: TEdit
+ Left = 136
+ Height = 23
+ Top = 45
+ Width = 201
+ OnChange = Edit1Change
+ TabOrder = 3
+ Text = 'Some text...'
+ end
+ object lblMarqueeLength: TLabel
+ AnchorSideTop.Control = seMarqueeLength
+ AnchorSideTop.Side = asrCenter
+ Left = 136
+ Height = 15
+ Top = 76
+ Width = 84
+ Caption = 'Marquee length'
+ end
+ object seMarqueeLength: TSpinEdit
+ Left = 240
+ Height = 23
+ Top = 72
+ Width = 50
+ Alignment = taRightJustify
+ OnChange = seMarqueeLengthChange
+ TabOrder = 4
+ Value = 120
+ end
+ object lblMarqueeSpeed: TLabel
+ AnchorSideTop.Control = seMarqueeSpeed
+ AnchorSideTop.Side = asrCenter
+ Left = 139
+ Height = 15
+ Top = 108
+ Width = 81
+ Caption = 'Marquee speed'
+ end
+ object seMarqueeSpeed: TSpinEdit
+ Left = 240
+ Height = 23
+ Top = 104
+ Width = 50
+ Alignment = taRightJustify
+ OnChange = seMarqueeSpeedChange
+ TabOrder = 5
+ Value = 8
+ end
+ end
+ object btnFont: TButton
+ Left = 304
+ Height = 25
+ Top = 416
+ Width = 75
+ Caption = 'Font'
+ OnClick = btnFontClick
+ TabOrder = 1
+ end
+ object ProgressBar1: TProgressBar
+ Left = 13
+ Height = 20
+ Top = 32
+ Width = 450
+ TabOrder = 2
+ Visible = False
+ end
+ object clbBackColor: TColorButton
+ Left = 298
+ Height = 25
+ Top = 296
+ Width = 146
+ BorderWidth = 2
+ ButtonColorAutoSize = False
+ ButtonColorSize = 16
+ ButtonColor = clBlack
+ Caption = 'Background color'
+ Margin = 4
+ OnColorChanged = clbBackColorColorChanged
+ end
+ object clbBarColor: TColorButton
+ Left = 297
+ Height = 25
+ Top = 323
+ Width = 146
+ BorderWidth = 2
+ ButtonColorAutoSize = False
+ ButtonColorSize = 16
+ ButtonColor = clBlack
+ Caption = 'Bar color'
+ Margin = 4
+ OnColorChanged = clbBarColorColorChanged
+ end
+ object clbGradientEndColor: TColorButton
+ Left = 297
+ Height = 25
+ Top = 351
+ Width = 146
+ BorderWidth = 2
+ ButtonColorAutoSize = False
+ ButtonColorSize = 16
+ ButtonColor = clBlack
+ Caption = 'Gradient end color'
+ Margin = 4
+ OnColorChanged = clbGradientEndColorColorChanged
+ end
+ object clbBorderColor: TColorButton
+ Left = 297
+ Height = 25
+ Top = 379
+ Width = 146
+ BorderWidth = 2
+ ButtonColorAutoSize = False
+ ButtonColorSize = 16
+ ButtonColor = clBlack
+ Caption = 'Border color'
+ Margin = 4
+ OnColorChanged = clbBorderColorColorChanged
+ end
+ object CheckBox1: TCheckBox
+ Left = 105
+ Height = 19
+ Top = 80
+ Width = 164
+ Caption = 'Compare with TProgressBar'
+ OnChange = CheckBox1Change
+ TabOrder = 3
+ end
+ object rgOrientation: TRadioGroup
+ Left = 104
+ Height = 64
+ Top = 280
+ Width = 190
+ AutoFill = True
+ Caption = 'Orientation'
+ ChildSizing.LeftRightSpacing = 6
+ ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+ ChildSizing.EnlargeVertical = crsHomogenousChildResize
+ ChildSizing.ShrinkHorizontal = crsScaleChilds
+ ChildSizing.ShrinkVertical = crsScaleChilds
+ ChildSizing.Layout = cclLeftToRightThenTopToBottom
+ ChildSizing.ControlsPerLine = 2
+ ClientHeight = 44
+ ClientWidth = 186
+ Columns = 2
+ ItemIndex = 0
+ Items.Strings = (
+ 'horizontal'
+ 'vertical'
+ 'right to left'
+ 'top down'
+ )
+ OnClick = rgOrientationClick
+ TabOrder = 4
+ end
+ object rgDrawingStyle: TRadioGroup
+ Left = 104
+ Height = 81
+ Top = 360
+ Width = 185
+ AutoFill = True
+ Caption = 'Drawing style'
+ ChildSizing.LeftRightSpacing = 6
+ ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+ ChildSizing.EnlargeVertical = crsHomogenousChildResize
+ ChildSizing.ShrinkHorizontal = crsScaleChilds
+ ChildSizing.ShrinkVertical = crsScaleChilds
+ ChildSizing.Layout = cclLeftToRightThenTopToBottom
+ ChildSizing.ControlsPerLine = 2
+ ClientHeight = 61
+ ClientWidth = 181
+ Columns = 2
+ ItemIndex = 0
+ Items.Strings = (
+ 'flat'
+ 'gradient'
+ 'rounded'
+ 'shiny'
+ 'bevel'
+ )
+ OnClick = rgDrawingStyleClick
+ TabOrder = 5
+ end
+ object FontDialog1: TFontDialog
+ MinFontSize = 0
+ MaxFontSize = 0
+ Left = 408
+ Top = 408
+ end
+end
diff --git a/components/exctrls/examples/ProgressBarEx/main.pas b/components/exctrls/examples/ProgressBarEx/main.pas
new file mode 100644
index 000000000..4584debf8
--- /dev/null
+++ b/components/exctrls/examples/ProgressBarEx/main.pas
@@ -0,0 +1,188 @@
+unit main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
+ Spin, ExtCtrls, ExProgressbar;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ btnFont: TButton;
+ CheckBox1: TCheckBox;
+ clbBackColor: TColorButton;
+ clbBarColor: TColorButton;
+ clbGradientEndColor: TColorButton;
+ clbBorderColor: TColorButton;
+ Edit1: TEdit;
+ FontDialog1: TFontDialog;
+ GroupBox1: TGroupBox;
+ lblMarqueeLength: TLabel;
+ lblMarqueeSpeed: TLabel;
+ ProgressBar1: TProgressBar;
+ rbNormalStyle: TRadioButton;
+ rbMarqueeStyle: TRadioButton;
+ rgOrientation: TRadioGroup;
+ rgDrawingStyle: TRadioGroup;
+ ScrollBar1: TScrollBar;
+ seMarqueeLength: TSpinEdit;
+ seMarqueeSpeed: TSpinEdit;
+ procedure btnFontClick(Sender: TObject);
+ procedure CheckBox1Change(Sender: TObject);
+ procedure clbBackColorColorChanged(Sender: TObject);
+ procedure clbBarColorColorChanged(Sender: TObject);
+ procedure clbGradientEndColorColorChanged(Sender: TObject);
+ procedure clbBorderColorColorChanged(Sender: TObject);
+ procedure Edit1Change(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure rbNormalStyleChange(Sender: TObject);
+ procedure rbMarqueeStyleChange(Sender: TObject);
+ procedure rgDrawingStyleClick(Sender: TObject);
+ procedure rgOrientationClick(Sender: TObject);
+ procedure ScrollBar1Change(Sender: TObject);
+ procedure seMarqueeLengthChange(Sender: TObject);
+ procedure seMarqueeSpeedChange(Sender: TObject);
+ private
+ ProgressbarEx: TProgressbarEx;
+
+ public
+
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+ ProgressbarEx := TProgressbarEx.Create(self);
+ ProgressbarEx.Left := 8;
+ ProgressbarEx.Top := 8;
+ ProgressbarEx.Width := 450;
+ ProgressbarEx.Parent := self;
+ Progressbarex.Position := 75;
+
+ Progressbar1.Left := ProgressbarEx.Left;
+ Progressbar1.Width := ProgressbarEx.Width;
+
+ clbBackColor.ButtonColor := ProgressbarEx.BackColor;
+ clbBarColor.ButtonColor := ProgressbarEx.BarColor;
+ clbGradientEndColor.ButtonColor := ProgressbarEx.GradientEndColor;
+ clbBorderColor.ButtonColor := ProgressbarEx.BorderColor;
+
+ Scrollbar1.Position := ProgressbarEx.Position;
+ Edit1.Hide;
+
+ Width := ProgressbarEx.Width + 2*ProgressbarEx.Left;
+ Height := Width;
+end;
+
+procedure TForm1.rbNormalStyleChange(Sender: TObject);
+begin
+ Progressbar1.style := pbstNormal;
+ ProgressbarEx.Style := pbstNormal;
+ 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);
+begin
+ ProgressbarEx.DrawStyle := TProgressbarDrawStyle(rgDrawingStyle.ItemIndex);
+end;
+
+procedure TForm1.rgOrientationClick(Sender: TObject);
+begin
+ ProgressbarEx.Orientation := TProgressbarOrientation(RgOrientation.ItemIndex);
+
+ Progressbar1.Orientation := ProgressBarEx.Orientation;
+ if Progressbar1.Orientation in [pbVertical, pbTopDown] then
+ begin
+ Progressbar1.Left := 32;
+ Progressbar1.Top := 8;
+ end else
+ begin
+ Progressbar1.Left := 8;
+ Progressbar1.Top := 32;
+ end;
+ Progressbar1.Width := ProgressbarEx.Width;
+ Progressbar1.Height := ProgressbarEx.Height;
+end;
+
+procedure TForm1.Edit1Change(Sender: TObject);
+begin
+ ProgressbarEx.Caption := Edit1.Text;
+end;
+
+procedure TForm1.btnFontClick(Sender: TObject);
+begin
+ FontDialog1.Font := ProgressbarEx.Font;
+ if FontDialog1.Execute then
+ ProgressbarEx.Font := FontDialog1.Font;
+end;
+
+procedure TForm1.CheckBox1Change(Sender: TObject);
+begin
+ Progressbar1.Visible := Checkbox1.Checked;
+end;
+
+procedure TForm1.clbBackColorColorChanged(Sender: TObject);
+begin
+ ProgressbarEx.BackColor := clbBackColor.ButtonColor;
+end;
+
+procedure TForm1.clbBarColorColorChanged(Sender: TObject);
+begin
+ ProgressbarEx.BarColor := clbBarColor.ButtonColor;
+end;
+
+procedure TForm1.clbGradientEndColorColorChanged(Sender: TObject);
+begin
+ ProgressbarEx.GradientEndColor := clbGradientEndColor.ButtonColor;
+end;
+
+procedure TForm1.clbBorderColorColorChanged(Sender: TObject);
+begin
+ ProgressbarEx.BorderColor := clbBorderColor.ButtonColor;
+end;
+
+procedure TForm1.ScrollBar1Change(Sender: TObject);
+begin
+ ProgressbarEx.Position := Scrollbar1.Position;
+ ProgressbarEx.Caption := IntToStr(Scrollbar1.Position);
+
+ Progressbar1.Position := Scrollbar1.Position;
+end;
+
+procedure TForm1.seMarqueeLengthChange(Sender: TObject);
+begin
+ ProgressbarEx.MarqueeLength := seMarqueeLength.Value;
+end;
+
+procedure TForm1.seMarqueeSpeedChange(Sender: TObject);
+begin
+ ProgressbarEx.MarqueeSpeed := seMarqueeSpeed.Value;
+end;
+
+end.
+
diff --git a/components/exctrls/exctrlspkg.lpk b/components/exctrls/exctrlspkg.lpk
index 80a1a8ad7..b392a73aa 100644
--- a/components/exctrls/exctrlspkg.lpk
+++ b/components/exctrls/exctrlspkg.lpk
@@ -18,7 +18,7 @@
- TRadioButton, TCheckbox, TRadioGroup and TCheckGroup: drawn by ThemeServices/Canvas, not by widgetset, button/text layout, wordwrap, user-provided check images
- TColumnComboBoxEx"/>
-
+
@@ -51,6 +51,10 @@
+
+
+
+
diff --git a/components/exctrls/exctrlspkg.pas b/components/exctrls/exctrlspkg.pas
index 4e3a8e6f3..fcfcd7d2a 100644
--- a/components/exctrls/exctrlspkg.pas
+++ b/components/exctrls/exctrlspkg.pas
@@ -9,7 +9,7 @@ interface
uses
ExCheckCtrls, ExEditCtrls, ExButtons, ExCombo, ExCheckCombo, ExQuestionDlg,
- ExShape, ExImgList;
+ ExShape, ExImgList, ExProgressbar;
implementation
diff --git a/components/exctrls/images/imagelist.txt b/components/exctrls/images/imagelist.txt
index ac3750184..fa7e93933 100644
--- a/components/exctrls/images/imagelist.txt
+++ b/components/exctrls/images/imagelist.txt
@@ -28,3 +28,6 @@ tcheckcomboboxex_200.png
tshapeex.png
tshapeex_150.png
tshapeex_200.png
+tprogressbarex.png
+tprogressbarex_150.png
+tprogressbarex_200.png
diff --git a/components/exctrls/images/tprogressbarex.png b/components/exctrls/images/tprogressbarex.png
new file mode 100644
index 000000000..9cef1315a
Binary files /dev/null and b/components/exctrls/images/tprogressbarex.png differ
diff --git a/components/exctrls/images/tprogressbarex_150.png b/components/exctrls/images/tprogressbarex_150.png
new file mode 100644
index 000000000..50008ecee
Binary files /dev/null and b/components/exctrls/images/tprogressbarex_150.png differ
diff --git a/components/exctrls/images/tprogressbarex_200.png b/components/exctrls/images/tprogressbarex_200.png
new file mode 100644
index 000000000..7299f5645
Binary files /dev/null and b/components/exctrls/images/tprogressbarex_200.png differ
diff --git a/components/exctrls/source/design/exctrlsreg.pas b/components/exctrls/source/design/exctrlsreg.pas
index 2e8513011..b02255747 100644
--- a/components/exctrls/source/design/exctrlsreg.pas
+++ b/components/exctrls/source/design/exctrlsreg.pas
@@ -22,7 +22,7 @@ implementation
{$R exctrlsreg.res}
uses
- ExButtons, ExCheckCtrls, ExEditCtrls, ExCombo, ExCheckCombo, ExShape;
+ ExButtons, ExCheckCtrls, ExEditCtrls, ExCombo, ExCheckCombo, ExShape, ExProgressBar;
function TFloatSIPropertyEditor.GetValue: ansistring;
begin
@@ -54,6 +54,7 @@ begin
TButtonEx, TCheckboxEx, TRadioButtonEx, TCheckGroupEx, TRadioGroupEx,
TFloatSISpinEditEx, TCurrSpinEditEx,
TColumnComboBoxEx, TCheckComboBoxEx,
+ TProgressBarEx,
TShapeEx
]);
diff --git a/components/exctrls/source/design/exctrlsreg.res b/components/exctrls/source/design/exctrlsreg.res
index f2e0df71f..a37d6dd4c 100644
Binary files a/components/exctrls/source/design/exctrlsreg.res and b/components/exctrls/source/design/exctrlsreg.res differ
diff --git a/components/exctrls/source/exprogressbar.pas b/components/exctrls/source/exprogressbar.pas
new file mode 100644
index 000000000..6fe86f40c
--- /dev/null
+++ b/components/exctrls/source/exprogressbar.pas
@@ -0,0 +1,416 @@
+unit ExProgressbar;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Graphics, Types, Controls, ExtCtrls, ComCtrls;
+
+type
+ TProgressbarDrawStyle = (pdsFlat, pdsGradient, pdsRounded, pdsShiny, pdsBevel);
+
+ TProgressbarEx = class(TGraphicControl)
+ private
+ const
+ DEFAULT_BACKCOLOR = $E6E6E6;
+ DEFAULT_BARCOLOR = $06B025;
+ DEFAULT_GRADIENTENDCOLOR = $00FFFF;
+ DEFAULT_BORDERCOLOR = clSilver;
+ DEFAULT_MARQUEELENGTH = 120;
+ DEFAULT_MARQUEESPEED = 8;
+ private
+ FCaption: String;
+ FColors: array[0..3] of TColor;
+ FDrawStyle: TProgressbarDrawStyle;
+ FMarqueePosition: Integer;
+ FMarqueeLength: Integer;
+ FMarqueeSpeed: Integer;
+ FMax: Integer;
+ FMin: Integer;
+ FOrientation: TProgressBarOrientation; // (pbHorizontal, pbVertical, pbRightToLeft, pbTopDown)
+ FPosition: Integer;
+ FStyle: TProgressBarStyle; // (pbstNormal, pbstMarquee)
+ FTimer: TTimer;
+ function GetColors(AIndex: Integer): TColor;
+ procedure SetCaption(AValue: String);
+ procedure SetColors(AIndex: Integer; AValue: TColor);
+ procedure SetDrawStyle(AValue: TProgressbarDrawStyle);
+ procedure SetMax(AValue: Integer);
+ procedure SetMin(AValue: Integer);
+ procedure SetOrientation(AValue: TProgressbarOrientation);
+ procedure SetPosition(AValue: Integer);
+ procedure SetStyle(AValue: TProgressbarStyle);
+ procedure TimerHandler(Sender: TObject);
+ protected
+ procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+ const AXProportion, AYProportion: Double); override;
+ function GetBarRect: TRect;
+ class function GetControlClassDefaultSize: TSize; override;
+ function IsHorizontal(AOrientation: TProgressbarOrientation): Boolean;
+ procedure Paint; 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 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;
+ property DrawStyle: TProgressbarDrawStyle read FDrawStyle write SetDrawStyle default pdsFlat;
+ property MarqueeLength: Integer read FMarqueeLength write FMarqueeLength default DEFAULT_MARQUEELENGTH;
+ property MarqueeSpeed: Integer read FMarqueeSpeed write FMarqueeSpeed default DEFAULT_MARQUEESPEED;
+ property Max: Integer read FMax write SetMax default 100;
+ property Min: Integer read FMin write SetMin default 0;
+ 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 Align;
+ property Anchors;
+ property BorderSpacing;
+ property Constraints;
+ property Font;
+ property Hint;
+ property ParentFont;
+ property ParentShowHint;
+ property ShowHint;
+ property Visible;
+ end;
+
+implementation
+
+uses
+ GraphUtil;
+
+constructor TProgressbarEx.Create(AOwner: TComponent);
+begin
+ inherited;
+ FCaption := '';
+ FColors[0] := DEFAULT_BACKCOLOR;
+ FColors[1] := DEFAULT_BORDERCOLOR;
+ FColors[2] := DEFAULT_BARCOLOR;
+ FColors[3] := DEFAULT_GRADIENTENDCOLOR;
+ FMarqueeLength := DEFAULT_MARQUEELENGTH;
+ FMarqueeSpeed := DEFAULT_MARQUEESPEED;
+ FMax := 100;
+ FStyle := pbstNormal;
+ FTimer := TTimer.Create(self);
+ FTimer.Interval := 25;
+ FTimer.OnTimer := @TimerHandler;
+ with GetControlClassDefaultSize do
+ SetInitialBounds(0, 0, CX, CY);
+end;
+
+procedure TProgressbarEx.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+ const AXProportion, AYProportion: Double);
+begin
+ inherited;
+ if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
+ FMarqueeLength := round(DEFAULT_MARQUEELENGTH * AXProportion);
+end;
+
+function TProgressBarEx.GetBarRect: TRect;
+var
+ fraction: Double;
+begin
+ Result := Rect(1, 1, Width-1, Height-1);
+ fraction := (FPosition - FMin) / (FMax - FMin);
+ case FStyle of
+ pbstNormal:
+ begin
+ if FMax = FMin then
+ exit(Rect(0, 0, 0, 0));
+ case FOrientation of
+ pbHorizontal: Result.Right := round(fraction * (Width - 2));
+ pbRightToLeft: Result.Left := Result.Right - round(fraction * (Width - 2));
+ pbVertical: Result.Top := Result.Bottom - round(fraction * (Height - 2));
+ pbTopDown: Result.Bottom := round(fraction * (Height - 2));
+ end;
+ end;
+ pbstMarquee:
+ case FOrientation of
+ pbHorizontal:
+ begin
+ Result.Right := FMarqueePosition;
+ Result.Left := Result.Right - FMarqueeLength;
+ end;
+ pbRightToLeft:
+ begin
+ Result.Left := Result.Right - FMarqueePosition;
+ Result.Right := Result.Left + FMarqueelength;
+ end;
+ pbVertical:
+ begin
+ Result.Top := Result.Bottom - FMarqueePosition;
+ Result.Bottom := Result.Top + FMarqueeLength;
+ end;
+ pbTopDown:
+ begin
+ Result.Bottom := FMarqueePosition;
+ Result.Top := Result.Bottom - FMarqueeLength;
+ end;
+ end;
+ end;
+ if IsHorizontal(FOrientation) then
+ begin
+ if Result.Right >= Width - 1 then Result.Right := Width - 1;
+ if Result.Left < 1 then Result.Left := 1;
+ end else
+ begin
+ if Result.Bottom >= Height - 1 then Result.Bottom := Height - 1;
+ if Result.Top < 1 then Result.Top := 1;
+ end;
+end;
+
+function TProgressbarEx.GetColors(AIndex: Integer): TColor;
+begin
+ Result := FColors[AIndex];
+end;
+
+class function TProgressbarEx.GetControlClassDefaultSize: TSize;
+begin
+ Result.CX := 200;
+ Result.CY := 20;
+end;
+
+function TProgressbarEx.IsHorizontal(AOrientation: TProgressbarOrientation): Boolean;
+begin
+ Result := (AOrientation in [pbHorizontal, pbRightToLeft]);
+end;
+
+procedure TProgressbarEx.Paint;
+var
+ R, R1, R2: TRect;
+ FontAngle: Integer;
+ txtSize: TSize;
+ isHor: Boolean;
+ col1, col2, col3: TColor;
+begin
+ isHor := IsHorizontal(FOrientation);
+
+ // Draw background with border
+ Canvas.Brush.Style := bsSolid;
+ Canvas.Brush.Color := BackColor;
+ Canvas.Pen.Color := BorderColor;
+ Canvas.Rectangle(0, 0, Width, Height);
+
+ // Draw bar
+ R := GetBarRect;
+ if isHor then
+ FontAngle := 0
+ else
+ FontAngle := 900;
+ case FDrawStyle of
+ pdsFlat:
+ begin
+ Canvas.Brush.Color := BarColor;
+ Canvas.FillRect(R);
+ end;
+ pdsGradient:
+ begin
+ case FOrientation of
+ pbHorizontal:
+ Canvas.GradientFill(R, BarColor, GradientEndColor, gdHorizontal);
+ pbVertical:
+ Canvas.GradientFill(R, GradientEndColor, barColor, gdVertical);
+ pbRightToLeft:
+ Canvas.GradientFill(R, GradientEndColor, BarColor, gdHorizontal);
+ pbTopDown:
+ Canvas.GradientFill(R, BarColor, GradientEndColor, gdVertical);
+ end;
+ end;
+ pdsRounded:
+ begin
+ col2 := BarColor;
+ col1 := GetHighlightColor(col2, 60);
+ col3 := GetShadowColor(col2, -60);
+ R1 := R;
+ R2 := R;
+ if isHor then
+ begin
+ R1.Bottom := R.Top + R.Height div 2;
+ R2.Top := R1.Bottom;
+ Canvas.GradientFill(R1, col1, col2, gdVertical);
+ Canvas.GradientFill(R2, col2, col3, gdVertical);
+ end else
+ begin
+ R1.Right := R.Left + R.Width div 2;
+ R2.Left := R1.Right;
+ Canvas.GradientFill(R1, col1, col2, gdHorizontal);
+ Canvas.GradientFill(R2, col2, col3, gdHorizontal);
+ end;
+ end;
+ pdsShiny:
+ begin
+ col1 := GetHighlightColor(BarColor, 50);
+ col2 := GetHighlightColor(BarColor, 25);
+ col3 := GetShadowColor(BarColor, -20);
+ R1 := R;
+ R2 := R;
+ if isHor then
+ begin
+ R1.Bottom := R.Top + R.Height div 3;
+ R2.Top := R1.Bottom ;
+ Canvas.GradientFill(R1, col1, col2, gdVertical);
+ Canvas.GradientFill(R2, BarColor, col3, gdVertical);
+ end else
+ begin
+ R1 := R;
+ R1.Right := R.Left + R.Width div 3;
+ R2.Left := R1.Right;
+ Canvas.GradientFill(R1, col1, col2, gdHorizontal);
+ Canvas.GradientFill(R2, BarColor, col3, gdHorizontal);
+ end;
+ end;
+ pdsBevel:
+ begin
+ col1 := BarColor;
+ Canvas.Brush.Color := col1;
+ inc(R.Right);
+ Canvas.FillRect(R);
+ col2 := GetShadowColor(col1, -30);
+ col1 := GetHighlightColor(col1, 30);
+ R1 := R;
+ InflateRect(R1, -1, -1);
+ R2 := R;
+ InflateRect(R2, -2, -2);
+ Canvas.Pen.Color := col1;
+ Canvas.Line(R1.Right, R1.Top, R1.Left, R1.Top);
+ Canvas.Line(R2.Right, R2.Top, R2.Left, R2.Top);
+ Canvas.Line(R1.Left, R.Top, R1.Left, R1.Bottom);
+ Canvas.Line(R2.Left, R2.Top, R2.Left, R2.Bottom);
+ Canvas.Pen.Color := col2;
+ Canvas.Line(R1.Left, R1.Bottom, R1.Right, R1.Bottom);
+ Canvas.Line(R2.Left, R2.Bottom, R2.Right, R2.Bottom);
+ Canvas.Line(R1.Right, R1.Bottom, R1.Right, R1.Top);
+ Canvas.Line(R2.Right, R2.Bottom, R2.Right, R2.Top);
+ end;
+ else
+ raise Exception.Create('DrawStyle not implemented.');
+ end;
+
+ // Draw text
+ if FCaption <> '' then
+ begin
+ txtSize := Canvas.TextExtent(FCaption);
+ 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)
+ else
+ Canvas.TextOut((Width - txtSize.CY) div 2, R.Bottom - (Height - txtSize.CX) div 2, FCaption);
+ end;
+end;
+
+procedure TProgressbarEx.SetCaption(AValue: String);
+begin
+ if FCaption = AValue then
+ exit;
+ FCaption := AValue;
+ Invalidate;
+end;
+
+procedure TProgressbarEx.SetColors(AIndex: Integer; AValue: TColor);
+begin
+ if FColors[AIndex] = AValue then
+ exit;
+ FColors[AIndex] := AValue;
+ Invalidate;
+end;
+
+procedure TProgressbarEx.SetDrawStyle(AValue: TProgressbarDrawStyle);
+begin
+ if FDrawStyle = AValue then
+ exit;
+ FDrawStyle := AValue;
+ Invalidate;
+end;
+
+procedure TProgressbarEx.SetMax(AValue: Integer);
+begin
+ if FMax = AValue then
+ exit;
+ FMax := AValue;
+ Invalidate;
+end;
+
+procedure TProgressbarEx.SetMin(AValue: Integer);
+begin
+ if FMin = AValue then
+ exit;
+ FMin := AValue;
+ Invalidate;
+end;
+
+procedure TProgressbarEx.SetOrientation(AValue: TProgressbarOrientation);
+var
+ rotate: Boolean;
+begin
+ if FOrientation = AValue then
+ exit;
+ rotate := IsHorizontal(AValue) xor IsHorizontal(FOrientation);
+ FOrientation := AValue;
+ if rotate then
+ SetBounds(Left, Top, Height, Width)
+ else
+ Invalidate;
+end;
+
+procedure TProgressbarEx.SetPosition(AValue: Integer);
+begin
+ if FPosition = AValue then
+ exit;
+ if AValue > FMax then
+ FPosition := FMax
+ else if AValue < FMin then
+ FPosition := FMin
+ else
+ FPosition := AValue;
+ Invalidate;
+end;
+
+procedure TProgressbarEx.SetStyle(AValue: TProgressbarStyle);
+begin
+ if FStyle = AValue then
+ exit;
+ FStyle := AValue;
+ case FStyle of
+ pbstNormal:
+ begin
+ FPosition := FMin;
+ FTimer.Enabled := false;
+ end;
+ pbstMarquee:
+ begin
+ FMarqueePosition := 0;
+ FTimer.Enabled := true;
+ end;
+ end;
+end;
+
+procedure TProgressbarEx.TimerHandler(Sender: TObject);
+begin
+ inc(FMarqueePosition, FMarqueeSpeed);
+ if IsHorizontal(FOrientation) then
+ begin
+ if (FMarqueePosition - FMarqueeLength > Width) and (FMarqueeSpeed > 0) then
+ FMarqueePosition := 0
+ else
+ if (FMarqueePosition < 0) and (FMarqueeSpeed < 0) then
+ FMarqueePosition := Width + FMarqueeLength;
+ end else
+ begin
+ if (FMarqueePosition - FMarqueeLength > Height) and (FMarqueeSpeed > 0) then
+ FMarqueePosition := 0
+ else
+ if (FMarqueePosition < 0) and (FMarqueeSpeed < 0) then
+ FMarqueePosition := Height + FMarqueeLength;
+ end;
+ Invalidate;
+end;
+
+end.
+