From ef7c6a38aca3d2a754397284a1cd5c7c7c37ebad Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 29 Mar 2023 11:23:17 +0000 Subject: [PATCH] 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 --- .../exctrls/examples/ProgressBarEx/demo.lpi | 88 ++++ .../exctrls/examples/ProgressBarEx/demo.lpr | 25 ++ .../exctrls/examples/ProgressBarEx/main.lfm | 236 ++++++++++ .../exctrls/examples/ProgressBarEx/main.pas | 188 ++++++++ components/exctrls/exctrlspkg.lpk | 6 +- components/exctrls/exctrlspkg.pas | 2 +- components/exctrls/images/imagelist.txt | 3 + components/exctrls/images/tprogressbarex.png | Bin 0 -> 539 bytes .../exctrls/images/tprogressbarex_150.png | Bin 0 -> 763 bytes .../exctrls/images/tprogressbarex_200.png | Bin 0 -> 1066 bytes .../exctrls/source/design/exctrlsreg.pas | 3 +- .../exctrls/source/design/exctrlsreg.res | Bin 28842 -> 31410 bytes components/exctrls/source/exprogressbar.pas | 416 ++++++++++++++++++ 13 files changed, 964 insertions(+), 3 deletions(-) create mode 100644 components/exctrls/examples/ProgressBarEx/demo.lpi create mode 100644 components/exctrls/examples/ProgressBarEx/demo.lpr create mode 100644 components/exctrls/examples/ProgressBarEx/main.lfm create mode 100644 components/exctrls/examples/ProgressBarEx/main.pas create mode 100644 components/exctrls/images/tprogressbarex.png create mode 100644 components/exctrls/images/tprogressbarex_150.png create mode 100644 components/exctrls/images/tprogressbarex_200.png create mode 100644 components/exctrls/source/exprogressbar.pas 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 @@ + + + + + + + + + <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> 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"/> <License Value="LGPL with linking exception (like Lazarus LCL)."/> - <Files Count="8"> + <Files Count="9"> <Item1> <Filename Value="source\excheckctrls.pas"/> <UnitName Value="ExCheckCtrls"/> @@ -51,6 +51,10 @@ <Filename Value="source\eximglist.pas"/> <UnitName Value="ExImgList"/> </Item8> + <Item9> + <Filename Value="source\exprogressbar.pas"/> + <UnitName Value="ExProgressbar"/> + </Item9> </Files> <CompatibilityMode Value="True"/> <LazDoc Paths="fpdoc"/> 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 0000000000000000000000000000000000000000..9cef1315a390400c213ef88713d3133c7287b773 GIT binary patch literal 539 zcmV+$0_6RPP)<h;3K|Lk000e1NJLTq000;O000;W1^@s6;CDUv00009a7bBm000id z000id0mpBsWB>pF8FWQhbW?9;ba!ELWdL_~cP?peYja~^aAhuUa%Y?FJQ@H10jNnt zK~zYI?UX-jR6!KQfA{UAkPS$>q!0{*fMxs)SpznSi=-5ltpq_Zg<l~>0;xn<L9ok) z6sg2&**Z<^3>XEi4Whz2*}2yud5_uW+dr7Mod+(w!_3@s?tOPg%#2AQnP~R^0^`5| zG@H$zs#+~Gagrpz8jZ%Z15nj!y<SI2Ff+`IsfyrxikYFROjU&6XMv0TxCGJ(RMo!k zUav>H-L7U80E7@&-Tat2ICwVCoy|`f-`}{#`u3NM?>?E!%;Y14(BGm|IYyqxhho>U z`;^CL#}*hQm?n)y3oFPwEOJ~_K|V^WV30r>g#xZ34B{b#zj&N17A$O$_nudctH60* zyWK7?A53T5d(ZQGSF$AD`|+npL{2-M&I~0&L{0%@($BR66p$f%hOLc60?3VrZvlAy z?lV$rA+;86Wv?6oGx+fJ2LShPUFYfDMF2uct?PTPH(ngEwRg<p)rHI1j^ISV4Bnr7 zKTp24z|Ny3ZZ4KIRAy!@@0yv};qf<9wLE0ljU5#Zz*PjPwfcnTXRDmNxqayZ#719) d1o-Da{s+X~ngJ2v_5}a{002ovPDHLkV1k_}@M-`6 literal 0 HcmV?d00001 diff --git a/components/exctrls/images/tprogressbarex_150.png b/components/exctrls/images/tprogressbarex_150.png new file mode 100644 index 0000000000000000000000000000000000000000..50008eceef42a7f72448437d453e788d34baf373 GIT binary patch literal 763 zcmV<X0tEeuP)<h;3K|Lk000e1NJLTq001Na001Ni1^@s6;Q*MJ00009a7bBm000id z000id0mpBsWB>pF8FWQhbW?9;ba!ELWdL_~cP?peYja~^aAhuUa%Y?FJQ@H10*FaO zK~z|U?U&DM6G0TmKeL++L{W(1K}4uZRZzh{!Gl;So~mAg*MN9RFVcb_2!bc|q=)FG zUWz{o9)g(u4=S`psVGIf35q>5(Cp0f(CoU&?rhxJZhFWUmJRdX&V1&*H;;)D5q6TC zK?C$^2-HtQpne(x^-}?$Ua$WYk@6rxlv2N{)#|<ifQXbUl?tBcbvYShy51rZK7pcR zQJZbt7}Mng;QKz!X0r^P2mus}#Sq8_kTiMH;z_n(%yr$Ezt%e3U<hQ4!5G82>36Yk z&fhtMh;ZTdV$9aKbpjFL(%t2*aS`G5)G;e`?<TE4ZQsNe4Z@t&7VO*>tzazp9RrGn zE@|Sdwg5IQ#l3TcKw4`YC%FsshV@@<Q6L*w^xXxNHnG+^)n-#*>vsyRMeX~(b*DB( zk8!V}^^sQ8i8Yj#vb06hY(ZqxPF8R2#!i`S(aqYj^sX3?)|$DSM`EE4b~;--WNm6Q zHx5`&Prn+n9(!X94uT*!PUj;8V>TvnFbD#Qj+Y?P>A=x3g2mD!Vg*u4tu-2rU5Rne zPixQt@;q;UtJNwElBQHDwE&ceIDpFVt-bMVfeJvIY!|fx+X%HYZ;T_?8hm{=j-xg* zce?tPrIppcPOf78%@tIZ#BNd!!1o_5qRn=(K8DO+W%BZI0E_{X(_e0D%BG(#@Zi-l zwTaPOB9jU<^<;s2v!AF<jB@|_+5BjTbm~Bpk3aBm?sEvE6r38_8`jshOGI>G?1i*_ zBTFm4h4as)_UOGBBR087SBb59x`0GPK7L!ZlH>sttD%#J_vDiriwXd)<KSI<X>~e! ta5rCO#&ZEuBC-y+8NTrV`<?bb^#_8~j*>gjI3)l8002ovPDHLkV1mqDUdjLf literal 0 HcmV?d00001 diff --git a/components/exctrls/images/tprogressbarex_200.png b/components/exctrls/images/tprogressbarex_200.png new file mode 100644 index 0000000000000000000000000000000000000000..7299f564505b2827360675d540794ab5bfcaffa8 GIT binary patch literal 1066 zcmV+_1l9YAP)<h;3K|Lk000e1NJLTq001xm001xu1^@s6R|5Hm00009a7bBm000id z000id0mpBsWB>pF8FWQhbW?9;ba!ELWdL_~cP?peYja~^aAhuUa%Y?FJQ@H11Gh;; zK~!jg?O07n6;Txa?wgsXJuOqitcZS~pthCtv#3@fBuP{dBou@wv?y>ZB?Un)gcgA= zM6f7AkQN1nn`j{jwK6Jd5k!BI|32sa`0i=pd*jT!d+*GsInVIh%$<Agz4LwNo_o%H zj}Z}8Ga_LVSSr>8gpD-;VPj1|*jV)f^jxE@tu0bjRaF)y8NX<5Zk_-@0Kl@9n00k^ zy$7%_Okx4>y0NkG1dt7(-rn9ARu6dqIFM`TZcANV9W+g|-iZkI`%<ngdj{#_oJ+ss z?js_Yrir1UA;*|J0lKckFbqta83757lA`%@Z@1^hFb2e;3;-~b-~!@=Sd>|Pnx;AI zUe2*QRw{sqFq_QaeEXNY!9@l`U&}6-DUORBUxoH3*S8~)CS1DzO=y33ZA;$H_}xv> z%~>cwb;ahKEA2$&2o2GE6<HzzW6WxMUH1bESPr|_Q?x4pkjZ4c1#r$miu&efhg3Tt zOA2nADy)<OhzNwmdsy``Hz9YpsE7wT1Dw<z^b_N%`Cj27J0GI87j*`_2zrH(?5R4~ zGAv3!kQkTQy<*?qR%N6-0q#ZI@RLSWkX2tl)!UbVd4fzy&|9GQ+#t_D0+uI4q~<_E z+<m?eF^H@?jU7csWPV}Jh4!ePO^IAQKdLiF2+C5aN|>hr&N+$<4c$#uQm;gHpzCUd z(*EG`2FFJ^=R%@6n~HRx5Hd{@$z;;e=iW}g#Yfim^0uts%}Xd?aBwhhP$5GHfQE*K zcxPwlOU77D*o1uId9J}kakZN8U;M4|3qa)(*4PYSY<cJehYrAi<VxWa^0K`Gu!vu{ zJ%}Hp3B2hz3C0%s2HuTWgVS>yiBtx$VjbiC^@tQe09pcGz5R{Jcp6i)X_S>10D!US z6vk&#d6TAQ)0l{-P_aI`a!e&q`f%Xhag6n!!Hsi!@@!fp)X1^m83gT5KcS=Vv-NIh z1rRqjSZs1}Z!Zh2J;S*B_@nh+TT_i#asHo6VM6N8)}CS9dGx`0udS&@|E*&yLMjM^ z>GQ?VPY3zB!&}jJ^9Z7P1PAw)<NF^IrR$cGd6y3s3zkji1VS>s@Wa7Q9+*Gag#@7+ z>yK_jcgrEnm~&`4y&HyJSO?dRg&nXRV#a_gr*?)!DHtpPGv*uspz`c9;lQ#I1CgxC z{W~@|Dt4H#1Z*sgVq_vA9XJ_JTkX-QBsdYY0#Lw+XcRz&*TBhm8a!Jh%1a$rh)n=S k{|P%E@SO{D_oG6?UsDfqM{2pgAOHXW07*qoM6N<$f=G_!9smFU literal 0 HcmV?d00001 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 f2e0df71fe23de1d0d976eae9b5828cc6b8c4059..a37d6dd4c220a01594789a1292ffd82d78457ca0 100644 GIT binary patch delta 2249 zcmai!`9ISQ0LQ<ZVHlAml$@22gxuMtjT}RaR${IYawMVAq)j73=9t_^IWoCc$oU8z zbLPksL#m~aFpA{y{Pz6zygskj=MVV2->*;QEU1nLs;LY)3;+kf0AK<Dz|M{^fCKCS z2fz-n*li5pxEnJ71vt>(T#O)<TcT08vk8mohyWZ4-c8zAEKL<X+gvIRBgbC;4ZFan zmvFBXp238mv?v5c47dV)0af!R9$xXnf5Hg60F<iWdK6G|@D!6qPc;eUD%~%M;XW z>0(cYEyYBbvy&{9vi;U~z;hiS-JHIH%8SQ!Leo^*WobPPeD<UMq*gZzOD!FCQbpnn zF)_QS(#DBA?R)#)b|Yk12shgH-R+6R^Qmf|eE?Y;KlPhoXb`D4kk@A?Gd<ndv$>v? z^xZW34f~@qd2qTIXK0?^d)ITkb}PNtw^vG9g>i(25mA3>ta0rU4rOZf*gX{~O959a z!9FOG+aq%|q%;Ca_c!v-(;jz35uQ(Jo{+ckog@yd63^GEaJGJwokiOk=k>!5o1tw% z-opbdK6t7kF`h|7gJ06_27@BEmvkHg6j@S1m!BL2>HJ*g2?86zuH5-43}9x-{6?(S zcRN_iieS%;Qr=7?&!9VCoPubCUE9-+{*uE%nwh#dA8#Lx?+>ykW`F2AvP`_+(d71t zbvQvPSes<7@8jH-rkHu~3v&V)@{^1BBlv>z03<QH&cBNlu*BG+tIgcwfURB7=>Gv- zbWoBm<{Cf(Q~#xnrz~a-1W2Oby@>i8QS>?L2Nb&8%E`VH(Rl}dEWgq%Zag;9>cnuI z0yOR@uk`Mhhi-`o;X`qZKYP>~Fcqqp7NNw`x`PYs)xm}4S4)ADe+S)sxj$2MmD3;n zxm7<UVXwrEv|JS5nm=^J?o8n=SuoELROt3(hXlXBqJT<wXs;ao+6IoLrmJTN=X1ji zWxSd>N_$Oj7kiz{xjHHR_7mUCmT8|)JuD9jg5T>Fe<_fv8#VmF@~JyJe2URNW;E#z z^-k)P?rNHks150#HoQX(nO*l}k2QvaC1!`GK2?WG%<@J~s$c(pgo(U5{X$CguiR0o z1=6Gx(_Q1I9A9F*=9LdsPXWE--K}9{<i&u4N1H^};(3It=M)a$*QWT>^=ikAMtvOJ zzeNZ$F^gMm;bnT5l+Y)|y!*~038&IC>l!d`15w^@ZJmP`du+3>4)y(Aw^l8kI`*I` z$HKEn?1qtxvG-Mf9epvpon5<Z-65hEOpFw#U|`EthIr{63Dtsv6O*$PhUYtmPR4Z) zD|_-gSTRq@(p(cl2kZg{K`SP~q{pLbqG^wCYAhg~Y7qN+nc4ay@U}2ACvZOt{2t2E z2~JWTmyM3mOD@sVj%eP@e3&uXZd>iS-M0^y`69?ctYbs|cyZs2TGMzo;quB#C<#ac z(ccn+0$x8V&|IDw)n+9OT~eY8>+-yB6YC4gu}Rl<HYa}jQLleR(o+!2AxmM<5_qoc z#DTH#r`G7}9t)I)7-ehqcFO9&!}Tw%(#m>Gmgf_gH=AS8XwzFRthA3H_~Rn_-HnfQ z*?Yo3_1uhW^p$X<n<4rHpPn#~g@aO^Sffna4`3^A9l;Zf8%a(x9yHi}tN-|{2Kj%V zCDbJ8i8k7Fg8)Mk-?M+6_Pf1^$DZAH4*q8;C%f$QamTJI>aD`Urx|PY<<5#KmN;=0 zI9atpHAMX|KT4A<bz2i%qiU8a#ZSrcQ-rd#)%+#Uq_iDV?)J~6E3?Eob_?-4yWDVK z`8_+2xYW8D!_6o5$D~L|IO`~RNaEGTAY|GpkcStRgnWnRf!8jTFqy|4oSdAbj>xq8 z1qI~;NT8!GgApDc-YQsg!p0M{++17x1ClCQ#NlwHo%cim2B`sGf~;L#<#e(2oCN6l zmP7S%qQLxIu66s|lCl!xQ9@CXVlTr4)Lh-A1+&SK0SP6i75@qge#Y(55_nMz1GMNf zVA2ONKK(+>gGYu7ZvC~!&T6q#tsM4D^j20&Cr025;f*HaSn@qN0%iT^_%r4EM=mw* zVEssuSFJhyKc}!meHT=b;oYBe)fdqpp`t_4`z|Pfz1aRl*9|@qyx8+`#|CvE^_6!E ze@H(nar3k9U7WFkwQx|5T2(rj3MF?FNqF8#eZ`2za;l&aU+&1EHOaZkUv9HX#`49i z{ow*F(3_Ohg$kp0+8S2KROzgVR?lgU^W{<#&=O{HnQrcs>O??{zR!w{inFmCbSd1J zR2V>lGmoN6KO@a1W7_tdq*fWz<S^#mw><hO>*e{_gi9ufN*xR6YljLeMj1frH%x?y zPGOxKo}j}Ezxh*!|IDli^ja8l&58|k60aAEYhxu}c@Gb9IkxTH7GvuxPphW;tX17Z zLbQVI70(F9#>dA;`ucLMd+^wI<meAk)t%^2)`MljZ{~^!^3&e2cQE(Bs4tMaVjZy` zt!5=x>RQ1yR6^rvs(gu1%RI?Is7Gp3fJ4LIc^h^x0Vh!FDL1#xqr#EEMX+1zHtkiU ztYiI^^bBbrwss!g<LeMbf8_I)K`pbdHEq6TbJ%_}WQG%(#4G5eg%MW*FRF~Zteug8 zEZQN8O1{_gg8cZ!_4V+9*Fu9&h%irgHE#VZ;kmgu((s{w3amZMNMHNM@;xS_);e!K zVOE&$Ful~x)S%?~)$Tz%!C%c?E<+Kk(BhjA!HvwhEqTd@-!jvpvi3-cWMa7xGws&p zu1?!S48%JMr0Br6l%O*aZxq>#Fh8T#1MzNn!SQ5@T#cM(Ppo>`jd=7iX$_Fh=Yv4u z%7V^pN8Mh&`&F;EamIQEYBv})kU$NZr?--#oPms;%i>Ulih)D}*uI162S-xIJ9bAf naZ!0~Eq9)Z1<ZGZjOCZ}M8Y;o%(@7Ud#+jdH?=AJ_XPd{OXC$H delta 9 Qcmdn=m2uTW#to|q02(s{{{R30 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. +