Solved

Help!  My scrolling text is very jerky

Posted on 2000-04-03
13
758 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
  • 6
  • 3
  • 3
  • +1
13 Comments
 
LVL 15

Accepted Solution

by:
simonet earned 75 total points
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 3

Expert Comment

by:ckaneta
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

743 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now