Mega Code Archive
Simple Vertical Scroller
<![CDATA[
Title: Simple Vertical Scroller
Question: The following object implements a simple vertical scroller.
Answer:
Usage:
Set the font and colors on the canvas of the ABitmap.
Create the object.
Use AddLine to add lines to be scrolled. The object automatically creates some empty lines at the top to give the impression that the scroll lines appear from the bottom.
Set up a timer. For each onTimer() event, call Animate.
Also, remember to call TBitmap.Refresh to refresh the bitmap.
That's it. Enjoy.
unit scroll;
{ ------------------------------------------------------------------------- }
interface
{ ------------------------------------------------------------------------- }
uses
graphics, windows, classes;
type
TScroll = class
private
fBitmap : graphics.TBitmap;
fList : TStringList;
fLineHeight : integer;
fLinesPerPage : integer;
fTopLine : integer;
fScrollIndex : integer;
public
constructor Create( ABitmap : graphics.TBitmap );
procedure AddLine( ALine : string );
procedure Animate;
end;
{ ------------------------------------------------------------------------- }
implementation
{ ------------------------------------------------------------------------- }
constructor TScroll.Create( ABitmap : graphics.TBitmap );
var
i : integer;
begin
fBitmap := ABitmap;
fList := TStringList.Create;
fLineHeight := fBitmap.Canvas.TextHeight( 'TMgfjpLoQ@&' );
fLinesPerPage := fBitmap.Height div fLineHeight + 1;
fTopLine := 0;
fScrollIndex := 0;
for i := 0 to fLinesPerPage do
fList.Add( '' );
end;
{ ------------------------------------------------------------------------- }
procedure TScroll.Animate;
var
i : integer;
begin
fBitmap.Canvas.FillRect( Bounds( 0,0,fBitmap.Width,fBitmap.Height ) );
for i := 0 to fLinesPerPage do
begin
if fList.Count i+fTopLine then
fBitmap.Canvas.TextOut( 0, fScrollIndex+fLineHeight*i,
fList.Strings[i+fTopLine] );
end;
Dec( fScrollIndex );
if fScrollIndex begin
fScrollIndex := 0;
Inc( fTopLine );
if fTopLine fList.Count-1 then
fTopLine := 0;
end;
end;
{ ------------------------------------------------------------------------- }
procedure TScroll.AddLine( ALine : string );
begin
fList.Add( ALine );
end;
end.
]]>