Smoothly Scroll - TelePrompter

Any comment would be appreciated. Thanks in an advance.

Hi rarigo,

I suppose you are still working on a Win9x or WinNT machine (as you are asking in the Delphi area :-)). I don't see many problems (even with large fonts) as you only have to deal with scrolling and text out. Scrolling a window (using ScrollDC(Ex)) is fast enough on todays machines, but it might be necessary to use a graphics card with very good 2D performance (Matrox' card are very good in this regard) depending on CPU and window (size) to scroll. After you've srcolled the DC you'd simply write out the new text line at the bottom of the window. Quite easy, ey ;-) Do you need code, just ask, or even better put your code here...

Ciao, Mike

Hi rarigo

Take a look at the VCL code of TScrollingWinControl there you can look up all those things.

ptm.

Thanks Mike for answering this but it's not fast enough. I've played a great deal with ScrollDC, ScrollWindow or ScrollWindowEx already but they're too sloooooow. I really need something faster. By the way window size to be scrolled is 800X600.


Obs. I'm already using code from you in this project. DVideoSets remember? As you know full screen is a lot faster. Yes. I'll put my code here later.

Thanks Mike for answering this but it's not fast enough. I've played a great deal with ScrollDC, ScrollWindow or ScrollWindowEx already but they're too sloooooow. I really need something faster. By the way window size to be scrolled is 800X600.


Obs. I'm already using code from you in this project. DVideoSets remember? As you know full screen is a lot faster. Yes. I'll put my code here later.

Listening

ScrollDCEx is very fast! If it isn't fast enough there is only DirectX but I have some doubt if it's really much faster because ScrollDCEx is already good optimized. May be you have an logical error in your code...?
ptm.

As you're scolling a very large amount of data you may want to consider rendering your text on a double buffered directdraw surface.  Just a thought.


GL
Mike

You have to optimize your paint routine if you're working with ScrollDCEx. You just have to paint the UpdateRect if you paint the whole virtual sheet it will take hours to repaint your form after an InvaldiateRect... - Have you already optimized your paint routine?

That is correct Mike, I have recently done the same thing. Using double buffering reduces the problem remarkably. I have brought an example code made by using this method. Even DirectDraw shouldn't be necessary.
Please do not bother that there could be improvements, but it sure helps upon the problem. ;-)

The exampe shows how to write a character at a time - But I could modify it to scroll like a smooth moviescroll. Assigning the image the way I do will use the windows own built-in V-blank mechanism, but you will still need the buffering and maybe some info on the sreens updatefrequency.

1. You will need a clean application, add a OnFormCreate event as well as a OnFormDestroy event before pasting the first part below.
2. You'll need a clean unit (unit2) where to paste the last piece.



-----------------------------------------------------------
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FTimer, STimer: TTimer;
    Memo: TMemo;
    Image: TImage;
    ShowText: String;
    ScreenDC: hDC;
    Scroll: TSmoothScroll;
    procedure ButtonClick(Sender: TObject);
    procedure OnFastTimer(Sender: TObject);
    procedure OnSlowTimer(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
Var
  FOwner: TWinControl;
begin
  FOwner:= Self;
  ClientWidth:= 1000;
  ClientHeight:= 600;
  Memo:= TMemo.Create(Self);
  With Memo do
  Begin
    SetBounds(800,0,200,200);
    Parent:= FOwner;
  End;
  With TButton.Create(Self) do
  Begin
    SetBounds(800,200,200,25);
    Caption:= 'Activate';
    Parent:= FOwner;
    OnClick:= ButtonClick;
  End;
  Image:= TImage.Create(Self);
  With Image do
  begin
    SetBounds(0,0,800,600);
    Parent:= FOwner;
  End;
  FTimer:= TTImer.Create(Self);
  With FTimer do
  begin
    Interval:= 22;
    Enabled:= False;
    OnTimer:= OnFastTimer
  End;
  STimer:= TTImer.Create(Self);
  With STimer do
  begin
    Interval:= 60;
    Enabled:= True;
    OnTimer:= OnSlowTimer;
  End;
  Scroll:= TSmoothScroll.Create(800, 600, 4);
  ShowText:= '';
  ScreenDC:= GetDC(0);
end;

procedure TForm1.OnFastTimer(Sender: TObject);
Var
  c: Char;
begin
  If ShowText<>'' then
  begin
    If not(ShowText = #13#10) then
    Begin
      c:= ShowText[1];
      Delete(ShowText,1,1);
      Scroll.Add(c);
    End else
      ShowText:= '';
  End else
    FTimer.Enabled:= False;
end;

procedure TForm1.OnSlowTimer(Sender: TObject);
begin
  //Scroll.DrawToDisplayContext(ScreenDC);
  Image.Picture.Bitmap:= Scroll.GetBitmap;
end;

procedure TForm1.ButtonClick(Sender: TObject);
begin
  ShowText:= Memo.Lines.Text;
  FTimer.Enabled:= True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ReleaseDC(0, ScreenDC);
end;

end.

------------------------------------------------------------

unit Unit2;

interface

  Uses
    Windows, Graphics, ExtCtrls, Classes;

Type
  { Main purpose:
      - To provide the ability to write text upon a device context on severel
      lines by adding a char at a time, but without having the flicker, which
      happens by updating directly to a device context.
      - This object uses double-buffering to provide the ability of doing
      graphics stuff in the background at the same time showing previous
      graphics. When updating, the whole image will be updated at once.
  }

  TSmoothScroll = class
  Private
    Font: TFont;
    NewBuffer,
    NextLineWarn: Boolean;
    Buffers: Array[0..1] of TBitmap;
    BufIndex: Integer;
    FWidth,
    FHeight,
    FMaxLines: Integer;
    Lines: TStringList;
    Function LastWord(Var S: String): String;
    procedure UpdateBuffers;
  Public
    Constructor Create(AWidth, AHeight, MaxLines: Integer);
    Destructor Destroy; override;
    Procedure DrawToDisplayContext(DC: hDC);
    Function GetBitmap: TBitmap;
    Procedure Add(Letter: Char);
    Procedure Clear;
  End;

implementation

  Constructor TSmoothScroll.Create(AWidth, AHeight, MaxLines: Integer);
  Var
    i: Integer;
  Begin
    Font:= TFont.Create;
    Font.Color:= clBlack;
    Font.Height:= -96;
    Font.Name:= 'Times New Roman';
    Font.Pitch:= fpDefault;
    Font.Size:= 72;
    BufIndex:= 0;
    FWidth:= AWidth;
    FHeight:= AHeight;
    FMaxLines:= MaxLines;
    NextLineWarn:= False;
    For i:= 0 to 1 do
    Begin
      Buffers[i]:= TBitmap.Create;
      With Buffers[i] do
      Begin
        Width:= FWidth;
        Height:= FHeight;
        PixelFormat:= pfDevice;
        Canvas.Font.Assign(Font);
        Canvas.Brush.Color:= clBtnFace;
      End;
    End;
    Lines:= TStringList.Create;
    UpdateBuffers;
  End;

  Destructor TSmoothScroll.Destroy;
  Begin
    Font.Free;
    Buffers[0].Free;
    Buffers[1].Free;
    Lines.Free;
    Inherited Destroy;
  End;

  Function TSmoothScroll.LastWord(Var S: String): String;
  Var
    i: Integer;
  Begin
    Result:= '';
    If S<>'' then
    Begin
      i:= Length(S);
      While (i>0) AND (S[i]<>' ') do Dec(i);
      If i>0 then
      Begin
        Result:= Copy(S,i+1,Length(S));
        Delete(S,i,Length(S));
      End;
    End;
  End;

  procedure TSmoothScroll.UpdateBuffers;
  Var
    Bmp: TBitmap;
    i, h: Integer;
  Begin
    Bmp:= Buffers[BufIndex];
    i:= 0;
    h:= Bmp.Canvas.TextHeight('W');
    Bmp.Canvas.FillRect(Rect(0,0,Bmp.Width,Bmp.Height));
    While i<Lines.Count do
    Begin
      Bmp.Canvas.TextOut(0,i*h,Lines[i]);
      Inc(i);
    End;
    NewBuffer:= True;
  End;

  Procedure TSmoothScroll.DrawToDisplayContext(DC: hDC);
  Begin
    if NewBuffer then
    begin
      NewBuffer:= False;
      BitBlt(DC,0,0,FWidth,FHeight, Buffers[BufIndex].Canvas.Handle,0,0,SRCCOPY);
      BufIndex:= 1 - BufIndex;
    End else
      BitBlt(DC,0,0,FWidth,FHeight, Buffers[1-BufIndex].Canvas.Handle,0,0,SRCCOPY);
  End;

  Function TSmoothScroll.GetBitmap: TBitmap;
  Begin
    if NewBuffer then
    begin
      NewBuffer:= False;
      Result:= Buffers[BufIndex];
      BufIndex:= 1 - BufIndex;
    End else
      Result:= Buffers[1 - BufIndex];
  End;

  Procedure TSmoothScroll.Add(Letter: Char);
  Var
    S: String;
    i: Integer;
  Begin
    If Lines.Count = 0 then Lines.Add(Letter) else
    Begin
      If Ord(Letter)>31 then
      //We don't want to put in any control characters
      Begin
        Lines.BeginUpdate;
        i:= Lines.Count-1;
        S:= Lines[i];
        S:= S + Letter;
        If Buffers[0].Canvas.TextWidth(S) > FWidth then
          Lines.Add(LastWord(S));
        Lines[i]:= S;
        If Lines.Count > FMaxLines then Lines.Delete(0);
        Lines.EndUpdate;
        UpdateBuffers;
      End else
      begin
        //New line protocol #10#13
        If NextLineWarn And (Letter = #10) then
        begin
          Lines.Add('');
          NextLineWarn:= False;
        End else
          NextLineWarn:= Letter = #13;
      End;
    End;
  End;

  Procedure TSmoothScroll.Clear;
  Begin
    Lines.Clear;
    UpdateBuffers;
  End;

end.
------------------------------------------------------------

Phyyyuuuu.... I hope it's worth the space :-)

Regards,
Williams

Nice job Will!

Reginaldo, to increase scroll speed you can leave out every other line or even scroll in units of 4 or 8 pixels. Should still be fairly smooth. A little additional trick. Try balancing the screen refresh rate. As drawing is synchronized with the vertical retrayce the vertical refresh rate is usually the highest painting rate you can get. Some video boards allow switch this off. Setting the refresh rate too high may also lower the speed as the remaining bandwidth might be too low (at least on older boards).

Ciao, Mike

I know it's very hard to understand someone else logic. But here you'll see
quotes of my code.


{...}
type
  TScrollForm = class(TForm)
  private
     LastValue : Real;               // A aux to keep step  
     Step  : Real                    // How fast this supposed to go
     FontHeight,                         // How height this font
     CurrentLine : Integer;          // A aux var
     i : Real;                       // The line we are on.
     Finished,                       // Is it finished?
     GoingUP     : Boolean;          // Are we going up?
     procedure WMERASEBKGND(var Msg:TMEssage); message WM_ERASEBKGND;  // Try to help
  public
  end;

var
    ScrollForm: TScrollForm;

implementation
Uses DVideoSets, Main;
{$R *.DFM}

// Trying no to flick
procedure TScrollForm.WMERASEBKGND(var Msg:TMEssage);
begin
  msg.result :=1;  
end;


{...}
   Line, Topy  : Integer;          // auxiliaries

begin
    {...}
    // Make currentLine equal to that is on at the MainForm
   
    CurrentLine :=  FrmMain.ActiveMemo.SelLine;  

    // Set some vars before the MainLoop
    //
    FontHeight := ScrollForm.Canvas.TextHeight('Wg');  
    Finished := false;
    GoingUp  := true;
    i := 0;
    //
   
    while not Finished do
    begin
      if GoingUP then
         i := i - Step
      else
         i := i + Step;

      if GoingUp then
      begin
        if i < -FontHeight then                                       //  if i is as height as a line
        begin
             CurrentLine := CurrentLine + 1;                          // Change current line
             if( CurrentLine > FrmMain.ActiveMemo.LineCount-1 ) then  // if we past the last line
             begin                                                    // then  
               Dec( CurrentLine );                                    // make the last line the current one
               steop  := 0;                                           // stop
               lbPosition.Caption := 'END OF FILE';                   // warning the user
               GoingUP := false;                                      // change direction
             end else                                                 // else
             begin                                                      
                i := 0;                                               // Reset the aux
                lbPosition.Caption := '';                             // Just in case clear the warning
             end;
         end;
      end else
      begin
        if i > 0  then                                                // the same as above
        begin
          CurrentLine := CurrentLine - 1;                             // except we're going down
          if( CurrentLine < 0 ) then
          begin
              Inc( CurrentLine );
              step := 0;
              lbPosition.Caption := 'BEGGINING OF FILE';
              GoingUP := true;                                      
          end else
          begin
              i := -YHeight;
              lbPosition.Caption := '';
          end;
        end;
      end;

      // Copy current line to auxiliary line  
      Line := CurrentLine;  
      // Copy the topy from current i
      TopY := Round(i);

      while  ( Topy <= Screen.Height + FontHeight )  // it's not out of screen
              and ( Step <> 0 ) do                   // and it's not stopped
      begin
            if( Line > FrmMain.ActiveMemo.LineCount-1 ) then
               Break;                                              // Line > LastLine

            R := Rect( 0, Topy, 800, TopY + FontHeight );          // Get a rect to write in
            SetTextAlign( ScrollForm.Canvas.Handle, TA_CENTER );   // Center the text
            ExtTextOut( ScrollForm.Canvas.Handle, 400, Topy, ETO_OPAQUE, @R,  // Write down
                        PChar(FrmMain.ActiveMemo.Lines[ Line ]),
                        Length(FrmMain.ActiveMemo.Lines[ Line ]), nil );

            TopY := TopY + FontHeight;       // Increase the top line
            Inc( Line );                     // and the line itself
      end;
      Application.ProcessMessages;
   end;
end;


procedure TScrollForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

    case Key of
        // + Key
       107: if( step < 10 ) then step := step + 0.1;

       // - Key
       109: if( step >= 0.2 ) then step := step - 0.1;

       // UpKey
       38 : GoingUp := true;

       // DownKey
       40 : GoingUp := false;

       // Space Key
       32 : begin
             if( step <> 0 ) then
             begin
               LastValue := step;
               step := 0;
             end  else
               step := LastValue;
           end;

       // Left Key
       39 : if step < 10    then step := step + 1.0;

       // right key
       37 : if step >= 1.0  then step := step - 1.0;

       // Esc Key
       27 : begin
              Finished := true;
              RestoreDefaultMode;
              Close;
           end;
    end;
end;


{...}



Ok. That's my code. It has proved to be good for its purpose EXCEPT for
some fonts sizes or kinds. Surprisingly for biggest fonts sizes ( 70) it
goes smoothly, very soft,  but for sizes smaller than 65 it doesn't do a
good job. And I don't know what's going wrong.


Reginaldo

Hmm... I'm not sure that I'm able to help you on this one, but if you'll wait half'n'hour I'll try posting an example with the moviescroll as I suppose is the real question ? The small font sizes you are talking about could be the fact, the windows is able to do things in between the paintjob, like refreshing the screen, so I guess it's quite important painting it all at once like also Mike suggested.

Regards,
Williams

When are you painting? I couldn't see the WM_PAINT event. Are you using the scrolling of TForm? Unfourtunally this is optimized to scroll a lot of controls and it's doing a very bad job if you want to scroll one big image.

>Reginaldo, to increase scroll speed >you can leave out every other line or >even scroll in units of 4 or 8 pixels

Thats the heart of the problem its not acceptable except for other purposes e.g. search a particular string scroll in units other than 1 because it won't be smooth enough to please my client.

Thanks Williams for your code. In fact I have a component that do just that. But for the same reason above i wont be able to use it.


Thanks ptm and edey for comments.


Reginaldo

Interesting that from a distance your client can tell the step size of a few pixels.

>Reginaldo, to increase scroll speed >you can leave out every other line or >even scroll in units of 4 or 8 pixels

Thats the heart of the problem its not acceptable except for other purposes e.g. search a particular string scroll in units other than 1 because it won't be smooth enough to please my client.

Thanks Williams for your code. In fact I have a component that do just that. But for the same reason above i wont be able to use it.


Thanks ptm and edey for comments.


Reginaldo

Your right Philipleighs from distance you couldn't tell the step size.
But consider this. The person who's recording is reading from distance looking at the camera and my client or his employee is sitting before the computer reading the same text not that far.


Yes. I tried to paint all at once as suggested. And those flicks problems are gone but its performance decayed lower than necessary.
You know even with small fonts (60) doesn't flick if the string is wide enough to fill the screen width.

I guess this tip would answer the question.


Reginaldo

Hmmm.. I guess it's time to put up with some mean and nasty hardcode stuff.. I'm still working on it >;-) ..like checking the gfx ports for v-blanking ..I should think it's possible even on a WinNT system, but if the above will answer your question I'm perfectly satisfied with that - if curiousity really killed the cat, I should't be living in more than a few minutes, hehe

Regards,
Williams

I'm watching here :)

Are you going to use windowsNT or 95/98 ?

....I'm not sure NT will allow this little thing >:-)

i'm not sure because sometimes you use the client's equipment but i guess
windows 95/98 will be most used.  


Reginaldo

i'm not sure because sometimes you use the client's equipment but i guess
windows 95/98 will be most used.  


Reginaldo

I've created a new mail account at yahoo and have sent the program to there with some desabled functions to all of you who want to see all i've done till now.

The program is in Portuguese so let me tell you start the program and press F10 to prompt the text.

Try changing the font height to see what i'm talking about.


Reginaldo


email     : rarigo@yahoo.com
password  : 135792468


 

I've created a new mail account at yahoo and have sent the program to there with some desabled functions to all of you who want to see all i've done till now.

The program is in Portuguese so let me tell you start the program and press F10 to prompt the text.

Try changing the font height to see what i'm talking about.


Reginaldo


email     : rarigo@yahoo.com
password  : 135792468


 

Ok Reginaldo, don't ask me for more this time..  I've really done my very best this time to work this out !

...Same procedure as last time....


------------------------------------------------------------
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    Memo: TMemo;
    Image: TImage;
    ScreenDC: hDC;
    Scroll: TMovieScroll;
    procedure ButtonClick(Sender: TObject);
    procedure ChangeDisplayClick(Sender: TObject);
    procedure ScrollPaint(Sender: TObject; Bitmap: TBitmap);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
Var
  FOwner: TWinControl;
begin
  FOwner:= Self;
  ClientWidth:= 1000;
  ClientHeight:= 600;
  Memo:= TMemo.Create(Self);
  With Memo do
  Begin
    SetBounds(800,0,200,200);
    Parent:= FOwner;
  End;
  With TButton.Create(Self) do
  Begin
    SetBounds(800,200,200,25);
    Caption:= 'Activate';
    Parent:= FOwner;
    OnClick:= ButtonClick;
  End;
  With TButton.Create(Self) do
  Begin
    SetBounds(800,225,200,25);
    Caption:= 'Display: Form';
    Parent:= FOwner;
    OnClick:= ChangeDisplayClick;
  End;
  Image:= TImage.Create(Self);
  With Image do
  begin
    SetBounds(0,0,800,600);
    Parent:= FOwner;
  End;
  ScreenDC:= GetDC(0);
  Scroll:= TMovieScroll.Create(800, 600);
  Scroll.OnPaint:= ScrollPaint;
  Scroll.DeviceContext:= ScreenDC;
end;

procedure TForm1.ScrollPaint(Sender: TObject; Bitmap: TBitmap);
begin
  Image.Picture.Bitmap:= Bitmap;
End;

procedure TForm1.ButtonClick(Sender: TObject);
begin
  Scroll.LoadStrings(Memo.Lines);
end;

procedure TForm1.ChangeDisplayClick(Sender: TObject);
begin
  if Assigned(Scroll.OnPaint) then
  begin
    Scroll.OnPaint:= nil;
    TButton(Sender).Caption:= 'Display: Desktop';
  End else
  begin
    Scroll.OnPaint:= ScrollPaint;
    TButton(Sender).Caption:= 'Display: Form';
  End;
End;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ReleaseDC(0, ScreenDC);
  Scroll.Terminate;
end;

end.

------------------------------------------------------------

unit Unit2;

interface

Uses
  Windows, Graphics, ExtCtrls, Classes, SysUtils, dialogs;

Type
  { Main purpose:
      - To provide the ability to write text upon a device context on severel
      lines by raising the contents a couple of pixels at a time, but without
      having the flicker, which happens by updating directly to a device context.
      - This object uses double-buffering to provide the ability of doing
      graphics stuff in the background at the same time showing previous
      graphics. When updating, the whole image will be updated at once.
  }

  TMoviePaintEvent = Procedure(Sender: TObject; Bitmap: TBitmap) of object;

  TMovieScroll = class(TThread)
  Private
    Procedure SetStep(Value: Integer);
  protected
    FSafeStep: Integer;
    FDC: hDC;
    FOnPaint: TMoviePaintEvent;
    FSetEnabled,
    FEnabled: Boolean;
    Font: TFont;
    FontHeight: Integer;
    FStep,
    FSpeed: Integer;
    FPosition: Integer;
    NewBuffer: Boolean;
    Buffers: Array[0..1] of TBitmap;
    BufIndex: Integer;
    FWidth,
    FHeight: Integer;
    Lines: TStringList;
    ShowLines: TStringList;
    VBlankEnabled: Boolean;
    procedure SyncSetEnabled;
    procedure SyncSetStep;
    procedure NextLine;
    Procedure DrawBuffer(Const Buffer: TBitmap);
    procedure UpdateBuffers;
    Procedure DrawToDisplayContext(DC: hDC);
    Function GetBitmap: TBitmap;
    procedure Execute; override;
    procedure DoSyncOutput;
  Public
    Constructor Create(AWidth, AHeight: Integer);
    Destructor Destroy; override;
    Procedure LoadStrings(Value: TStrings);
    property Step: Integer read FSafeStep write SetStep;
    Property OnPaint: TMoviePaintEvent read FOnPaint write FOnPaint;
    Property DeviceContext: hDC read FDC write FDC;
  End;

  Procedure VBlank;

implementation

  uses unit1;

  Procedure VBlank;
  asm
    pushad
    mov      dx,3dah
  @@L1:
    in      al,dx
    test      al,8
    jz      @@L1
  @@L2:
    in      al,dx
    test      al,8
    jnz      @@L2
    popad
  End;

  Constructor TMovieScroll.Create(AWidth, AHeight: Integer);
  Var
    i: Integer;
    Test: TDateTime;
  Begin
    FEnabled:= False;
    Font:= TFont.Create;
    Font.Color:= clBlack;
    Font.Height:= -96;
    Font.Name:= 'Times New Roman';
    Font.Pitch:= fpDefault;
    Font.Size:= 72;
    BufIndex:= 0;
    FWidth:= AWidth;
    FHeight:= AHeight;
    FStep:= 4;
    FSafeStep:= 4;
    FPosition:= 0;
    For i:= 0 to 1 do
    Begin
      Buffers[i]:= TBitmap.Create;
      With Buffers[i] do
      Begin
        Width:= FWidth;
        Height:= FHeight;
        PixelFormat:= pfDevice;
        Canvas.Font.Assign(Font);
        Canvas.Brush.Color:= clBtnFace;
      End;
    End;
    FontHeight:= Buffers[0].Canvas.TextHeight('W');
    //Calculating maximum numnber of lines
    i:= FHeight div FontHeight;
    Lines:= TStringList.Create;
    ShowLines:= TStringList.Create;
    //Add an extra line for scrolling
    ShowLines.Add('');
    //Add an extra lines, if the height doesn't fit perfectly
    //..the last is rarely the case
    if i * FontHeight < FHeight then ShowLines.Add('');
    //Creating the lines necessary to show it all
    While i>0 do
    Begin
      ShowLines.Add('');
      Dec(i);
    End;
    //make some updates..

    if Win32Platform = VER_PLATFORM_WIN32_NT then
    Begin
      FSpeed:= GetDeviceCaps(Buffers[0].Canvas.Handle, VREFRESH);
      VBlankEnabled:= False;
    End else
    begin
      FSpeed:= 0;
      Test:= Now + 1 / (24*60*60);
      Repeat
        VBlank;
        Inc(FSpeed);
      Until not(Test > Now);
      VBlankEnabled:= True;
    End;
    Inherited Create(False);
    FreeOnTerminate:= False;
  End;

  Destructor TMovieScroll.Destroy;
  Begin
    Inherited Destroy;
  End;

  Procedure TMovieScroll.SetStep(Value: Integer);
  begin
    FSafeStep:= Value;
    Synchronize(SyncSetStep)
  End;

  procedure TMovieScroll.SyncSetStep;
  begin
    FStep:= FSafeStep;
  End;

  procedure TMovieScroll.SyncSetEnabled;
  begin
    FEnabled:= FSetEnabled;
  End;

  Procedure TMovieScroll.LoadStrings(Value: TStrings);
  Begin
    FSetEnabled:= False;
    Synchronize(SyncSetEnabled);
    Lines.Assign(Value);
    FSetEnabled:= True;
    Synchronize(SyncSetEnabled);
  End;

  Procedure TMovieScroll.NextLine;
  Var
    S: String;
    i: Integer;
    Empty: Boolean;
  begin
    Inc(FPosition, FontHeight);
    ShowLines.Delete(0);
    If Lines.Count>0 then
    begin
      S:= Lines[0];
      With Buffers[0].Canvas do
      Begin
        i:= 0;
        While (TextWidth(Copy(S,1,i+1)) < FWidth) AND (i<Length(S)) do Inc(i);
        ShowLines.Add(Copy(S,1,i));
        If i = length(S) then
          Lines.Delete(0)
        else
          Lines[0]:= Copy(S, i+1, Length(S) - i);
      End;
    End else
    Begin
      ShowLines.Add('');
      Empty:= True;
      i:= 0;
      While Empty And (i<ShowLines.Count) do
      begin
        Empty:= ShowLines[i]='';
        Inc(i);
      End;
      FEnabled:= FEnabled AND not(Empty);
    End;
  End;

  Procedure TMovieScroll.DrawBuffer(Const Buffer: TBitmap);
  var
    i, p: Integer;
  begin
    Dec(FPosition, FStep);
    If FPosition < -FontHeight then
      NextLine;
    p:= FPosition;
    i:= 0;
    While p < FHeight do
    Begin
      Try
        Buffer.Canvas.TextOut(0,p,ShowLines[i]);
      Except
        FStep:= 100;
      end;
      Inc(p, FontHeight);
      Inc(i)
    End;
  End;

  procedure TMovieScroll.UpdateBuffers;
  Var
    Bmp: TBitmap;
  Begin
    Bmp:= Buffers[BufIndex];
    Bmp.Canvas.FillRect(Rect(0,0,Bmp.Width,Bmp.Height));
    DrawBuffer(Buffers[BufIndex]);
    NewBuffer:= True;
  End;

  Procedure TMovieScroll.DrawToDisplayContext(DC: hDC);
  Begin
    if NewBuffer then
    begin
      NewBuffer:= False;
      BitBlt(DC,0,0,FWidth,FHeight, Buffers[BufIndex].Canvas.Handle,0,0,SRCCOPY);
      BufIndex:= 1 - BufIndex;
    End else
      BitBlt(DC,0,0,FWidth,FHeight, Buffers[1-BufIndex].Canvas.Handle,0,0,SRCCOPY);
  End;

  Function TMovieScroll.GetBitmap: TBitmap;
  Begin
    if NewBuffer then
    begin
      NewBuffer:= False;
      Result:= Buffers[BufIndex];
      BufIndex:= 1 - BufIndex;
    End else
      Result:= Buffers[1 - BufIndex];
  End;

  procedure TMovieScroll.Execute;
  begin
    Repeat
      SleepEx(1000 div FSpeed, True);
      If FEnabled then
      Begin
        Synchronize(UpdateBuffers);
        If VBlankEnabled then VBlank;
        Synchronize(DoSyncOutput);
      End;
    Until Terminated;

    Font.Free;
    Buffers[0].Free;
    Buffers[1].Free;
    ShowLines.Free;
    Lines.Free;
  End;

  procedure TMovieScroll.DoSyncOutput;
  Begin
    if Assigned(FOnPaint) Then FOnPaint(Self, GetBitmap) else
    if FDC<>0 then DrawToDisplayContext(FDC);
  End;

end.



Check this out !! ..If it's not any solution to you, it's sure a pretty interesting piece crap ;-)

...There might be some few things left to turn upon to ie. get a more precise result, but what the h..., you know what I mean... hehe

Regards,
Williams

NOTE-ERROR: Please do remove the 'ThrdUnit' in the uses clause.. it was some attempt to test some new components of mine..

Regards,
Williams

Hi Williams,

   No I won't ask for more. In fact I don't even have time to test all this right now. You know by now, i'm down here in Brazil and it's 00:57 AM. I was just waiting your code. I'll talk to you "tomorrow".

  Thanks a lot.


Reginaldo.

I tried your stuff and it seems very interesting :-) ..I might have a few changes to the code for making it able to draw in both directions, but that's no problem...

...And by the way, up here in Denmark it's 4:30 AM in the morning.. but I rarely sleep, so I hang out at places like this :-)

See you tommorow..

...and you are welcome.

Williams

  I've tried all these codes and all suggestion here and  I'm not sure I should use anything of these instead my own stuff.
   I'll keep trying to solve my flickers problems for one day more and if i couldn't find a solution for this i close this question and give these points to "Will"iams for his good will to help me finding a solution.  
   I'd like to thanks to all of you who commented this question in any way.


regards,

Reginaldo