ScrollText: Add new property ScrollSpeed (based on patch by kkuba).

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

components/scrolltext/latest_stable/exampleapp/unit1.lfm

@@ -1,23 +1,28 @@
 object Form1: TForm1
   Left = 403
-  Height = 363
+  Height = 356
   Top = 139
-  Width = 552
+  Width = 551
   BorderStyle = bsToolWindow
   Caption = 'Form1'
-  ClientHeight = 363
+  ClientHeight = 356
-  ClientWidth = 552
+  ClientWidth = 551
   Position = poDesktopCenter
   LCLVersion = '2.3.0.0'
   object ScrollingText1: TScrollingText
-    Left = 0
+    AnchorSideLeft.Control = Owner
-    Height = 363
+    AnchorSideTop.Control = Owner
-    Top = 0
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    AnchorSideBottom.Control = BitBtn1
+    Left = 12
+    Height = 294
+    Top = 12
     Width = 552
     About.Description.Strings = (
       'Component that shows a scrolling window.'#13#10'Use Lines property to set text and Active=True'#13#10'to use the component'
     )
-    About.Title = 'About About About About About ScrollingText component'
+    About.Title = 'About About About About About About About ScrollingText component'
     About.Height = 280
     About.Width = 400
     About.Font.Color = clNavy
@@ -31,28 +36,11 @@ object Form1: TForm1
     About.ComponentName = 'ScrollingText component'
     About.LicenseType = abLGPL
     Active = False
-    Align = alClient
+    Anchors = [akTop, akLeft, akBottom]
+    Borderspacing.Around = 12
     Lines.Strings = (
-      'This is the ScrollingText scrolling window.'
+      'The file ''../readme.txt'' is missing.'
-      ' '
+      'Ideally, it should be in the same folder as your application'
-      'This default text is showing because you either:'
-      ' '
-      '1) Haven''t set any text in the Lines property. or'
-      '2) TextSource is set to stTextfile and the file'
-      '''scrolling.txt'' is empty.'
-      ' '
-      'Note that URL links such as'
-      'http://wiki.lazarus.freepascal.org/Main_Page'
-      'mailto:bill_gates@microsoft.com'
-      'are clickable by the user'
-      ' '
-      'TScrollingText is released under the GPL license (See About)'
-      'Code is modified from the Lazarus ''AboutFrm'' code'
-      ' '
-      'The standalone visual component TScrollingText is available at:'
-      'http://www.charcodelvalle.com/scrollingtext/scrollingtext_component.zip'
-      ' '
-      'June 2014'
     )
     Font.Height = -13
     LinkFont.Height = -13
@@ -61,22 +49,47 @@ object Form1: TForm1
     TextResourceName = 'scrolltext_res'
   end
   object BitBtn1: TBitBtn
-    Left = 239
+    AnchorSideLeft.Control = Owner
+    AnchorSideLeft.Side = asrCenter
+    AnchorSideBottom.Control = Owner
+    AnchorSideBottom.Side = asrBottom
+    Left = 238
     Height = 30
-    Top = 317
+    Top = 318
     Width = 75
+    Anchors = [akLeft, akBottom]
+    BorderSpacing.Bottom = 8
     DefaultCaption = True
     Kind = bkClose
     ModalResult = 11
     TabOrder = 0
   end
   object Button1: TButton
-    Left = 456
+    AnchorSideTop.Control = BitBtn1
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 468
     Height = 30
-    Top = 317
+    Top = 318
     Width = 75
+    Anchors = [akTop, akRight]
+    BorderSpacing.Right = 8
     Caption = 'Toggle'
     OnClick = Button1Click
     TabOrder = 1
   end
+  object TrackBar1: TTrackBar
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = BitBtn1
+    AnchorSideTop.Side = asrCenter
+    Left = 12
+    Height = 25
+    Top = 321
+    Width = 100
+    Max = 4
+    OnChange = TrackBar1Change
+    Position = 2
+    BorderSpacing.Left = 12
+    TabOrder = 2
+  end
 end

components/scrolltext/latest_stable/exampleapp/unit1.pas

@@ -11,7 +11,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, ScrollingText, Forms, Controls, Graphics,
-  Dialogs, Buttons, StdCtrls, LResources;
+  Dialogs, Buttons, StdCtrls, LResources, ComCtrls;
 
 type
 
@@ -21,7 +21,9 @@ type
     BitBtn1: TBitBtn;
     Button1: TButton;
     ScrollingText1: TScrollingText;
+    TrackBar1: TTrackBar;
     procedure Button1Click(Sender: TObject);
+    procedure TrackBar1Change(Sender: TObject);
   private
     { private declarations }
   public
@@ -45,6 +47,11 @@ begin
   ScrollingText1.Active:=NOT ScrollingText1.Active;
 end;
 
+procedure TForm1.TrackBar1Change(Sender: TObject);
+begin
+  ScrollingText1.ScrollSpeed := TScrollSpeed(Trackbar1.Position);
+end;
+
 initialization
 {$IFDEF LRS_RESOURCE}
   {$I scrolltext.lrs}

components/scrolltext/latest_stable/scrollingtext.pas

@@ -41,11 +41,16 @@ uses
 const
   C_TEXTFILENAME = 'scrolling.txt';
   C_TEXTRESOURCENAME = 'scrolltext'; //Note: LResources unit needed for .lrs resource
-  C_VERSION = '1.0.4.0';
+  C_VERSION = '1.1.3.0';
 
 type
   TTextSource = (stStringlist, stTextfile, stResource);
+  TScrollSpeed = (ssVerySlow, ssSlow, ssNormal, ssFast, ssVeryFast);
   
+var
+  ScrollInterval: array[TScrollSpeed] of Integer = (100, 50, 35, 18, 5);
+
+type
   TScrollingText = class(TAboutScrollText)
   private
     FActive: boolean;
@@ -66,6 +71,7 @@ type
     fResourceName: string;
     fVersionString: string;
     fTextSource: TTextSource;
+    FScrollSpeed: TScrollSpeed;
     function ActiveLineIsURL: boolean;
     procedure DoTimer(Sender: TObject);
     procedure SetActive(const AValue: boolean);
@@ -74,6 +80,7 @@ type
     procedure SetLines(AValue: TStrings);
     procedure SetFont(AValue: TFont);
     procedure SetLinkFont(AValue: TFont);
+    procedure SetScrollSpeed(AValue: TScrollSpeed);
   protected
     procedure DoOnChangeBounds; override;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
@@ -105,6 +112,8 @@ type
     property Font: TFont read fFont write SetFont;
     // Sets the font properties of links in the scrolling text
     property LinkFont: TFont read fLinkFont write SetLinkFont;
+    // Speed of scrolling
+    property ScrollSpeed: TScrollSpeed read FScrollSpeed write SetScrollSpeed default ssNormal;
     // Source of the text to display.
     // If TextSource=stTextfile the file "TextFileName" should be in the deployed app folder
     // if TextSource=stResource a resource named "TextResourceName" should be available.
@@ -144,6 +153,14 @@ begin
   fLines.Assign(AValue);
 end;
 
+procedure TScrollingText.SetScrollSpeed(AValue: TScrollSpeed);
+begin
+  if AValue = FScrollSpeed then
+    exit;
+  FScrollSpeed := AValue;
+  FTimer.Interval := ScrollInterval[FScrollSpeed];
+end;
+
 procedure TScrollingText.SetActive(const AValue: boolean);
 begin
   FActive := AValue;
@@ -378,10 +395,14 @@ begin
   ControlStyle := ControlStyle + [csOpaque];
 
   OnPaint := @DrawScrollingText;
+  
   FLines := TStringList.Create;
   FTimer := TTimer.Create(nil);
   FTimer.OnTimer := @DoTimer;
   FTimer.Interval := 30;
+  FScrollSpeed := ssNormal;
+  FTimer.Interval := ScrollInterval[FScrollSpeed];
+
   FBuffer := TBitmap.Create;
   FFont := TFont.Create;
   FLinkFont := TFont.Create;

components/scrolltext/latest_stable/scrolltext.lpk

@@ -1,6 +1,6 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
-  <Package Version="4">
+  <Package Version="5">
     <PathDelim Value="\"/>
     <Name Value="scrolltext"/>
     <Type Value="RunAndDesignTime"/>
@@ -44,7 +44,7 @@
   along with this library; if not, write to the Free Software Foundation,
   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 "/>
-    <Version Major="1" Minor="1" Release="2"/>
+    <Version Major="1" Minor="1" Release="3"/>
     <Files Count="2">
       <Item1>
         <Filename Value="scrollingtext.pas"/>
@@ -57,6 +57,7 @@
         <UnitName Value="AboutScrolltextunit"/>
       </Item2>
     </Files>
+    <CompatibilityMode Value="True"/>
     <i18n>
       <EnableI18N Value="True"/>
       <OutDir Value="locale"/>