pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
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
2022-06-16 13:18:18 +00:00
parent 3176651aaf
commit fd008e3e37
4 changed files with 79 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
components/scrolltext/latest_stable/scrollingtext.pas
View File

@ -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;