Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Scroll Text

140 views
Skip to first unread message

Sarana Tasanasant

unread,
Oct 14, 1999, 3:00:00 AM10/14/99
to
Hi all,

How can I scroll text from down to up smoothly ? (Like a gang-screen)
Because I try to use in many solutions, but it still not satisfied.

Pls give me any ideas.

Thanks a lot,
Aladin.

Ron Sawyer

unread,
Oct 14, 1999, 3:00:00 AM10/14/99
to
I'm not sure what a gang-screen is, but you may find an answer to your
problem in the graphic's NG. Look for the thread "Star Wars" They outline
the creation of a control that will scroll text in the same fashion as the
credits of the opening of the first Star Wars film. Even if this is not
*exactly* what you want, it may give you a some good ideas on how to solve
your problems.


Sarana Tasanasant wrote in message <7u3mue$jd...@forums.borland.com>...

Peter Below (TeamB)

unread,
Oct 14, 1999, 3:00:00 AM10/14/99
to
> How can I scroll text from down to up smoothly ? (Like a gang-screen)
> Because I try to use in many solutions, but it still not satisfied.
>
Implementing soft scroll of text

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, ComCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FTextlist: TStringLIst;
FFirstLine: Integer;
FScanlineOffset: Integer;
FLineHeight: Integer;
FDisplayRect: TRect;

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation


{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
timer1.enabled := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
timer1.enabled := false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Inc( FScanlineOffset );
if FScanlineOffset = FLineHeight then begin
FScanlineOffset := 0;
Inc( FFirstline );
if FFirstline >= FTextlist.Count then
FFirstline := 0;
end;
ScrollWindowEx(
handle, // window to scroll
0, -1, // scroll by 0 in x, -1 in y
@FDisplayRect, // only area inside display rect
@FDisplayRect, // which is the clip rect as well
0, // no result region
Nil, // gets area invalidated by scroll
SW_ERASE or SW_INVALIDATE );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FTextlist:= TStringlist.Create;
FTextlist.LoadFromFile( Changefileext( Application.exename, '.DPR'
));
FFirstline := 0;
FScanlineOffset := 0;
Canvas.Font := Font;
FLineHeight := Canvas.TextHeight('Ay');
FDisplayRect := Rect( 8, Button1.top + Button1.Height + 8,
ClientWidth-8, ClientHeight-8 );
end;

procedure TForm1.FormPaint(Sender: TObject);
var
linerect, aux: TRect;
i, y : Integer;
begin
if not IntersectRect( aux, Canvas.Cliprect, FDisplayRect ) then
Exit;

with FDisplayRect do
IntersectClipRect( Canvas.handle, left, top, right, bottom );

y:= FDisplayRect.Top - FScanlineOffset;
i:= FFirstLine;
Canvas.Brush.Style := bsClear;
while y < FDisplayrect.Bottom do begin
linerect := Rect( FDisplayRect.left, y, Fdisplayrect.right,
y + FLineHeight );
if IntersectRect( aux, Canvas.Cliprect, linerect ) then
canvas.textout( linerect.left, y, FTextlist[i] );
Inc(y, FLineHeight);
Inc(i);
If i >= FTextlist.Count then
i:= 0;
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FTextList.Free;
end;

end.

Peter Below (TeamB) 10011...@compuserve.com)
No replies in private e-mail, please, unless explicitly requested!


Sarana Tasanasant

unread,
Oct 15, 1999, 3:00:00 AM10/15/99
to
Thanks a lot for your help.
But I need more a little bit advance, so, If in Form, I have an image, how
can I display scroll text by use transparent mode ?

Aladin,

Peter Below (TeamB) <10011...@compuXXserve.com> wrote in message ...

Peter Below (TeamB)

unread,
Oct 15, 1999, 3:00:00 AM10/15/99
to
In article <7u79dd$gs...@forums.borland.com>, Sarana Tasanasant wrote:
> But I need more a little bit advance, so, If in Form, I have an image, how
> can I display scroll text by use transparent mode ?
>

This does not work using the mechanism i posted (ScrollWindow) since you
probably want only the *text* to scroll, not the bitmap. The only way to
achieve this is to paint the *complete* area occupied by the scrolling text,
background and all, to an offscreen bitmap first and then paint that bitmap
in toto onto the form. Here is an example, see form resource at end of
message. I cut the bitmap data to conserve space, load the skyline.bmp into
the image1 before you try to compile the example. The code assumes that
image1 is located at (0,0) in the form.

unit ScrollTextUnit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
StartButton: TButton;
StopButton: TButton;
Image1: TImage;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure StartButtonClick(Sender: TObject);
procedure StopButtonClick(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
FScrollText: String;
FDisplay: TBitmap;
FScrollStart: Integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
temp: TStringlist;
begin
image1.hide;
Brush.Style := bsClear;
temp := TStringList.Create;
try
temp.LoadFromfile( ExtractFilePath( ParamStr(0) )+ 'scrolltextunit1.pas'
);
FScrollText := temp.Text;
finally
temp.free;
end;
FDisplay := TBitmap.Create;
FDisplay.Width := image1.clientwidth;
FDisplay.Height:= image1.clientHeight;
FScrollStart := image1.clientheight - 10;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
r: TRect;
begin
Dec( FScrollStart );
r:= image1.BoundsRect;
InvalidateRect( handle, @r, false );
end;

procedure TForm1.StartButtonClick(Sender: TObject);


begin
timer1.enabled := true;
end;

procedure TForm1.StopButtonClick(Sender: TObject);


begin
timer1.enabled := false;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
r: TRect;
begin
if not timer1.enabled then
Canvas.Draw( 0, 0, image1.picture.bitmap )
else begin
timer1.enabled := false;
FDisplay.Canvas.Draw( 0, 0, image1.Picture.Bitmap );
r:= Rect( 10, FScrollStart, image1.width - 10,
image1.height - 10 );
FDisplay.Canvas.Font := Font;
FDisplay.Canvas.Font.Color := clYellow;
SetBKMode( FDisplay.Canvas.Handle, TRANSPARENT );
DrawText( FDisplay.Canvas.Handle, PChar( FScrollText ),
Length( FScrollText ), r,
DT_LEFT or DT_NOPREFIX );
Canvas.Draw( 0, 0, FDisplay );
timer1.enabled := true;
end;
end;

end.

object Form1: TForm1
Left = 249
Top = 133
AutoScroll = False
Caption = 'Form1'
ClientHeight = 222
ClientWidth = 240
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnPaint = FormPaint
PixelsPerInch = 120
TextHeight = 16
object Image1: TImage
Left = 0
Top = 0
Width = 240
Height = 181
Align = alClient
end
object Panel1: TPanel
Left = 0
Top = 181
Width = 240
Height = 41
Align = alBottom
TabOrder = 0
object StartButton: TButton
Left = 8
Top = 8
Width = 75
Height = 25
Caption = 'Start'
TabOrder = 0
OnClick = StartButtonClick
end
object StopButton: TButton
Left = 88
Top = 8
Width = 75
Height = 25
Caption = 'Stop'
TabOrder = 1
OnClick = StopButtonClick
end
end
object Timer1: TTimer
Enabled = False
Interval = 10
OnTimer = Timer1Timer
Left = 180
Top = 185
end
end

0 new messages