Solved

Help!  My scrolling text is very jerky

Posted on 2000-04-03
13
768 Views
Last Modified: 2012-11-26
I have been trying create a smooth scrolling text effect without
much success :-(

When I used a label the text was both jerky and flickery...
I finally figured out that putting the text onto a panel and
sliding the panel sideways got rid of the flicker...but the jerky
start and stop motion remains. I use the timer to slide the panel
across the form... maybe I need a better timer or a better way to
use the standard one... anybody out there know how to fix this?

..Gwen..
0
Comment
Question by:Gwena
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 3
  • 3
  • +1
13 Comments
 
LVL 15

Accepted Solution

by:
simonet earned 75 total points
ID: 2682533
Gwena, try this:

unit Marquee;

interface

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

const
  ScrollPixels : byte = 3;     // num of pixels for each scroll
{  TimerInterval = 65;   // time between scrolls in ms}

type
  TJustification = (tjCenter, tjLeft, tjRight);

  EMarqueeError = class(Exception);

  TMarquee = class(TCustomPanel)
  private
    FTimerInterval : Integer;      
    MemBitmap: TBitmap;
    InsideRect: TRect;
    FItems: TStringList;
    FJust: TJustification;
    FScrollDown: Boolean;
    LineHi : integer;
    CurrLine : integer;
    VRect: TRect;
    FTimer: TTimer;
    FActive: Boolean;
    FOnDone: TNotifyEvent;
    FLoop  : Boolean;
    procedure SetItems(Value: TStringList);
    procedure DoTimerOnTimer(Sender: TObject);
    procedure MakeRects;
    procedure PaintLine(R: TRect; LineNum: integer);
    procedure SetLineHeight;
    procedure SetStartLine;
    procedure IncLine;
    procedure SetTimerInterval (Value : Integer);
  protected
    procedure Paint; override;
    procedure FillBitmap; virtual;
  public
    property Active: Boolean read FActive;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Activate;
    procedure Deactivate; virtual;
  published
    property Interval : Integer read FTimerInterval write SetTimerInterval;      
    property ScrollDown: Boolean read FScrollDown write FScrollDown;
    property Justify: TJustification read FJust write FJust default tjCenter;
    property Items: TStringList read FItems write SetItems;
    property OnDone: TNotifyEvent read FOnDone write FOnDone;
    Property Loop : boolean read FLoop write FLoop;
    { Publish inherited properties: }
    property Align;
    property Alignment;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderWidth;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property Font;
    property Locked;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
  end;

procedure Register;

implementation

procedure TMarquee.DoTimerOnTimer(Sender: TObject);
{ This method is executed in respose to a timer event }
var
  R: TRect;
begin
  IncLine;
  { only repaint within borders }
  InvalidateRect(Handle, @InsideRect, False);
end;

procedure TMarquee.SetTimerInterval(Value : integer);
begin
      if (value > 65535) or (value < 1) then exit;
  if value <> FTimerInterval then
  begin
     FTimerInterval := value;
        FTimer.Interval := FTimerInterval;
  end;
end;


procedure TMarquee.IncLine;
{ this method is called to increment a line }
begin
  if not FScrollDown then       // if Marquee is scrolling upward
  begin
    { Check to see if marquee has scrolled to end yet }
    if FItems.Count * LineHi + ClientRect.Bottom -
        ScrollPixels  >= CurrLine then
      { not at end, so increment current line }
      inc(CurrLine, ScrollPixels)
    else Deactivate;
  end
  else begin                   // if Marquee is scrolling downward
    { Check to see if marquee has scrolled to end yet }
    if CurrLine >= ScrollPixels then
      { not at end, so decrement current line }
      dec(CurrLine, ScrollPixels)
    else Deactivate;
  end;
end;

constructor TMarquee.Create(AOwner: TComponent);
{ constructor for TMarquee class }

  procedure DoTimer;
  { procedure sets up TMarquee's timer }
  begin
    FTimer := TTimer.Create(Self);
    with FTimer do begin
      Enabled := False;
      Interval := FTimerInterval;
      OnTimer := DoTimerOnTimer;
    end;
  end;

begin
  inherited Create(AOwner);
  FTimerInterval := 65;
  FItems := TStringList.Create;  { instanciate string list }
  DoTimer;                       { set up timer }
  { set instance variable default values }
  Width := 100;
  Height := 75;
  FActive := False;
  FScrollDown := False;
  FJust := tjCenter;
  BevelWidth := 1;
end;

destructor TMarquee.Destroy;
{ destructor for TMarquee class }
begin
  Deactivate;
  FTimer.Free;             // free allocated objects
  FItems.Free;
  inherited Destroy;
end;

procedure TMarquee.SetItems(Value: TStringList);
begin
  if FItems <> Value then
    FItems.Assign(Value);
end;

procedure TMarquee.SetLineHeight;
{ this virtual method sets the LineHi instance variable }
var
  Metrics : TTextMetric;
begin
  { get metric info for font }
  GetTextMetrics(Canvas.Handle, Metrics);
  { adjust line height }
  LineHi := Metrics.tmHeight + Metrics.tmInternalLeading;
end;

procedure TMarquee.SetStartLine;
{ this virtual method initializes the CurrLine instance variable }
begin
  if not FScrollDown then          // initialize current line to...
    CurrLine := 0                  // top if scrolling up, or
  else
    CurrLine := VRect.Bottom - Height; // bottom if scrolling down
end;

procedure TMarquee.PaintLine(R: TRect; LineNum: integer);
{ this method is called to paint each line of text onto MemBitmap }
const
  Flags: array[TJustification] of Longint =
         (dt_Center, dt_Left, dt_Right);
var
  S: String;
begin
  { Copy next line to local variable for clarity }
  S := FItems.Strings[LineNum];
  { Draw line of text onto memory bitmap }
  if DrawText(MemBitmap.Canvas.Handle, PChar(S), Length(S), R,
           Flags[FJust] or dt_SingleLine or dt_Top) <= 0 then
    raise EMarqueeError.Create('Failed to render text');
end;

procedure TMarquee.MakeRects;
{ procedure sets up VRect and InsideRect TRects }
begin
  { VRect rectangle represents entire memory bitmap }
  with VRect do begin
    Top := 0;
    Left := 0;
    Right := Width;
    Bottom := LineHi * FItems.Count + Height * 2;
  end;
  { InsideRect rectangle represents interior of beveled border }
  with InsideRect do begin
    Top := BevelWidth;
    Left := BevelWidth;
    Right := Width - (2 * BevelWidth);
    Bottom := Height - (2 * BevelWidth);
  end;
end;

procedure TMarquee.FillBitmap;
var
  y, i : integer;
  Rect: TRect;
begin
  SetLineHeight;                 // set height of each line
  MakeRects;                     // make rectangles
  with Rect do begin
    Left := InsideRect.Left;
    Bottom := VRect.Bottom ;
    Right := InsideRect.Right;
  end;
  SetStartLine;
  MemBitmap.Width := Width;      // initialize memory bitmap
  with MemBitmap do begin
    Height := VRect.Bottom;
    with Canvas do begin
      Font := Self.Font;
      Brush.Color := Color;
      FillRect(VRect);
      Brush.Style := bsClear;
    end;
  end;
  y := Height;
  i := 0;
  repeat
    Rect.Top := y;
    PaintLine(Rect, i);
    { increment y by the height (in pixels) of a line }
    inc(y, LineHi);
    inc(i);
  until i >= FItems.Count;      // repeat for all lines
end;

procedure TMarquee.Activate;
{ this method is called to activate the marquee }
begin
  if (not FActive) and (FItems.Count > 0) then begin
    FActive := True;                // set active flag
    MemBitmap := TBitmap.Create;
    FillBitmap;                     // Paint Image on bitmap
    FTimer.Enabled := True;         // start timer
  end;
end;

procedure TMarquee.Deactivate;
begin
  if FActive then begin
    FTimer.Enabled := False;   // disable timer,
    if Assigned(FOnDone)       // fire OnDone event,
      then FOnDone(Self);
    FActive := False;          // set FActive to False
    MemBitmap.Free;            // free memory bitmap
    Invalidate;                // clear control window
  end;
  if FLoop then
        Activate;
end;

procedure TMarquee.Paint;
{ this virtual method is called in response to a }
{ Windows paint message }
var
  URect: TRect;
begin
  if FActive then
    { Copy from memory bitmap to screen }
    BitBlt(Canvas.Handle, 0, 0, InsideRect.Right, InsideRect.Bottom,
           MemBitmap.Canvas.Handle, 0, CurrLine, srcCopy)
  else
    inherited Paint;
end;


procedure Register;
{ procedure registers component for Component Palette }
begin
  RegisterComponents('New', [TMarquee]);
end;

end.
0
 
LVL 5

Author Comment

by:Gwena
ID: 2682650
Hi Simonet :-)

Thanx for the info!   I will try that code first thing in the morning...I sure hope it works... I am at my wits end trying to get the flickering jerkies out of this scrolling text :)

p.s.  I saw that post about your website being plagiarized :-(  what a !@#$% that guy is! ..please don't take your site down though...I like your site.
0
 
LVL 5

Author Comment

by:Gwena
ID: 2682696
Hi Simonet :-)

Thanx for the info!   I will try that code first thing in the morning...I sure hope it works... I am at my wits end trying to get the flickering jerkies out of this scrolling text :)

p.s.  I saw that post about your website being plagiarized :-(  what a !@#$% that guy is! ..please don't take your site down though...I like your site.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 5

Author Comment

by:Gwena
ID: 2682735
Hi Simonet...

I must be doing something wrong here.. I renamed the code above to marquee.pas
and then installed it as a component in D3
But when I try to use it the panel just remains
blank....I put several strings into the strings list but no text appears.
 
The events all seem to work OK..

Did I install the component wrong?

I tried installing in D2 but I get an error
"class Tbevel not found" when I try to
put strings into the strings list.

...Gwen..
0
 
LVL 15

Expert Comment

by:simonet
ID: 2683168
It only works in runtime. You don't see any scrolling text in design-time. Besides, you have to call TMarquee.Activate in order to make it work.

Alex
0
 
LVL 3

Expert Comment

by:ckaneta
ID: 2684395
here ya go:
This code is in a timer event

  {// draw bitmap in appropriate position(moving L->R)
  BitBlt(bnr.Canvas.Handle,amt,0,scrll.Width-amt,bnr.Height,scrll.Canvas.Handle,0,0,SRCCOPY);
  BitBlt(bnr.Canvas.Handle,0,0,amt,bnr.Height,scrll.Canvas.Handle,scrll.Width-amt,0,SRCCOPY);}
  // draw bitmap in appropriate position(moving R->L)
  BitBlt(bnr.Canvas.Handle,0,0,scrll.Width-amt,bnr.Height,scrll.Canvas.Handle,amt,0,SRCCOPY);
  BitBlt(bnr.Canvas.Handle,scrll.width-amt,0,amt,bnr.Height,scrll.Canvas.Handle,0,0,SRCCOPY);

it scrolls a bitmap, I used it to scroll text by using the textout function.  It works okay for me
0
 
LVL 3

Expert Comment

by:ckaneta
ID: 2685024
oh yeah, a couple other things:
amt is the number of pixels to scroll
and bnr is a label that I used to scroll the text on.
0
 
LVL 5

Author Comment

by:Gwena
ID: 2685438
Hi Simonet :-)

That marquee effect looks pretty good...
Can it scroll from left to right and right to left
or does it just do up and down ?

I get an error when I stop a program that uses the marquee.. it says  'marquee1 has no parent window'   ?

0
 
LVL 5

Author Comment

by:Gwena
ID: 2685469
Hi ckaneta :-)

Your code looks like it might be what I need...
But I'm having trouble getting it to work...
could you please show me an example program
that uses this code... you could put it here or
email it to me at gwena@gurlmail.com
It is always a huge help to me to see working examples of code.... I'm still pretty much a Delphi
newbie.

...Gwen..
0
 
LVL 10

Expert Comment

by:ptmcomp
ID: 2685479
Why are you using BitBlt that copies a part of the bitmap instead of ScrollWindowEx that uses hardware support (if available)?
ScrollWindow is in most of the case the fastest, easiest and flickerfreeest solution (as long you don't use DirectX).
0
 
LVL 15

Expert Comment

by:simonet
ID: 2685840
Gwena, the component I sent you only does vertical scrolling. I'll see if I can find a horizontal marquee on my library.

Alex
0
 
LVL 3

Expert Comment

by:ckaneta
ID: 2687339
Here's an example:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    tmr: TTimer;
    dir: TRadioGroup;
    scroll: TSpeedButton;
    lodpic: TSpeedButton;
    img1: TImage;
    pict: TOpenPictureDialog;
    settxt: TSpeedButton;
    Edit1: TEdit;
    procedure tmrTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lodpicClick(Sender: TObject);
    procedure scrollClick(Sender: TObject);
    procedure settxtClick(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
   scrtxt : String;
   pos    : Integer;
   bmp    : TBitmap; //Bitmap to scroll
   procedure setscr;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
 begin
  bmp:=TBitmap.Create;  pos:=0; scrtxt:='';
  pict.InitialDir:=ExtractFilePath(application.exename);
 end;
procedure TForm1.FormActivate(Sender: TObject);   begin {} end;
procedure TForm1.FormDestroy(Sender: TObject);    begin bmp.Destroy; end;
{------------------------------------------------------------------------------}
procedure TForm1.tmrTimer(Sender: TObject);
 begin
  if dir.ItemIndex = 0 then begin
              // draw bitmap in appropriate position(moving L->R)
   BitBlt(label1.Canvas.Handle, pos, 0, bmp.Width-pos, label1.Height,
          bmp.Canvas.Handle, 0, 0, SRCCOPY);
   BitBlt(label1.Canvas.Handle, 0, 0, pos, label1.Height, bmp.Canvas.Handle,
          bmp.Width-pos, 0, SRCCOPY);
  end else if dir.ItemIndex = 1 then begin
             // draw bitmap in appropriate position(moving R->L)
   BitBlt(label1.Canvas.Handle, 0, 0, bmp.Width-pos, label1.Height,
          bmp.Canvas.Handle, pos, 0, SRCCOPY);
   BitBlt(label1.Canvas.Handle, bmp.width-pos, 0, pos, label1.Height,
          bmp.Canvas.Handle, 0, 0, SRCCOPY);
  end;
  InvalidateRect(label1.canvas.Handle, nil, false );
  inc(pos, 5); if (pos >= bmp.width) and (bmp.width<>0) then
   pos:=pos mod bmp.width;
 end;

procedure TForm1.setscr;                     // set up bitmap to scroll
var img : TBitmap; ht,w : Integer;
 begin
  img:=TBitmap.Create;       label1.canvas.font:=label1.font;
  if scrtxt = '' then begin
   img.LoadFromFile(pict.FileName);
  end else begin
   ht:=(label1.Height div 2) - (img.Canvas.TextHeight('H') div 2);
   img.height:=label1.height;
   img.width:=8*length(scrtxt)+15;
   img.canvas.Brush.color:=clWhite; img.canvas.floodfill(1,1,clBlack,fsSurface);
   img.canvas.pen.color:=label1.font.color;
   img.Canvas.TextOut(1,ht,scrtxt);
  end;

  bmp.Height:=img.height;     bmp.width:=0;   w:=img.width;
  while bmp.width < label1.width do begin
   bmp.width:=bmp.width+img.width;
   bmp.Canvas.CopyRect(Rect(bmp.width-w, 0, bmp.width, img.height),
                       img.canvas, Rect(0, 0, img.width, img.height));
  end;
  img.Destroy;
 end;
{------------------------------------------------------------------------------}
procedure TForm1.scrollClick(Sender: TObject);
 begin
  tmr.Enabled:=not(tmr.Enabled);
  if tmr.Enabled then scroll.caption:='Stop' else scroll.caption:='Start';
 end;
procedure TForm1.lodpicClick(Sender: TObject);
 begin
  pict.FileName:=''; edit1.text:=''; scrtxt:='';
  if pict.Execute then begin
   img1.Picture.LoadFromFile(pict.FileName);
   setscr;
  end;
 end;
procedure TForm1.settxtClick(Sender: TObject);
 begin
  if edit1.text <> '' then begin
   scrtxt := edit1.text;
   setscr;  pict.FileName:='';
  end;
 end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
 begin if key = #13 then settxtClick(Sender); end;

end.
0
 
LVL 5

Author Comment

by:Gwena
ID: 2694682
It's not exactly what I was after since it scrolls up/down instead of right/left  ... but I found a good use for the code in another project... so I'm going to use it... so here is the 75 points :-)
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In this video, viewers will be given step by step instructions on adjusting mouse, pointer and cursor visibility in Microsoft Windows 10. The video seeks to educate those who are struggling with the new Windows 10 Graphical User Interface. Change Cu…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.

695 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question