[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 772
  • Last Modified:

Help! My scrolling text is very jerky

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
Gwena
Asked:
Gwena
  • 6
  • 3
  • 3
  • +1
1 Solution
 
simonetCommented:
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
 
GwenaAuthor Commented:
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
 
GwenaAuthor Commented:
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
GwenaAuthor Commented:
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
 
simonetCommented:
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
 
ckanetaCommented:
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
 
ckanetaCommented:
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
 
GwenaAuthor Commented:
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
 
GwenaAuthor Commented:
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
 
ptmcompCommented:
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
 
simonetCommented:
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
 
ckanetaCommented:
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
 
GwenaAuthor Commented:
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 Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

  • 6
  • 3
  • 3
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now