You've already forked lazarus-ccr
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
This commit is contained in:
wp_xxyyzz
@ -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
|
||||
ClientWidth = 552
|
||||
ClientHeight = 356
|
||||
ClientWidth = 551
|
||||
Position = poDesktopCenter
|
||||
LCLVersion = '2.3.0.0'
|
||||
object ScrollingText1: TScrollingText
|
||||
Left = 0
|
||||
Height = 363
|
||||
Top = 0
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
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.'
|
||||
' '
|
||||
'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'
|
||||
'The file ''../readme.txt'' is missing.'
|
||||
'Ideally, it should be in the same folder as your application'
|
||||
)
|
||||
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
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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"/>
|
||||
|
||||
Reference in New Issue
Block a user