ExCtrls: New component: TProgressBarEx (https://forum.lazarus.freepascal.org/index.php/topic,62848.0.html)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8779 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/exctrls/examples/ProgressBarEx/demo.lpi

@@ -0,0 +1,88 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="demo"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="ExCtrlsPkg"/>
+      </Item>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="demo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit>
+      <Unit>
+        <Filename Value="exprogressbar.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ExProgressbar"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="demo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

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.
+

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

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.
+