Scroller: Delphi Version

In Delphi programs, we achieve the animation-based message loop through an OnIdle event handler:

procedure TForm1.AppIdle(Sender: Tobject; var Done: Boolean);
begin
  Scroll;
  Done := False;
end;

An Idle event occurs whenever there are no other events occurring, meaning the OnIdle event handler will essentially just be called over and over. Because Idle events are associated with the application and not a form, we must explicitly set up the OnIdle handler just as we set up the application's OnActivate handler in all Delphi examples:

Application.OnIdle := AppIdle;

Our OnIdle event handler does nothing more than call our Scroll() function to perform one iteration of the scroll.

{*****************************************************************************
*                                                                            *
*  Scroller.dpr                                                              *
*  ScrollerU.pas                                                             *
*                                                                            *
*  This program demonstrates circular scrolling within a virtual buffer.     *
*                                                                            *
*  Because fg_scroll() requires a "hidden" virtual buffer to save and then   *
*  restore portions of the area being scrolled, we create a second virtual   *
*  buffer for this purpose.                                                  *
*                                                                            *
*****************************************************************************}
unit ScrollerU;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWin;
type
  TForm1 = class(TForm)
    procedure AppOnActivate(Sender: TObject);
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
const
  vbWidth  = 320;
  vbHeight = 200;
var
  dc   : hDC;
  hPal : hPalette;
  hVB1, hVB2 : integer;
  cxClient, cyClient : integer;
{*****************************************************************************
*                                                                            *
*  Scroll()                                                                  *
*                                                                            *
*  The Scroll() function moves the scrolling region up four pixels in a      *
*  circular manner. It is called from the application's OnIdle event         *
*  handler.                                                                  *
*                                                                            *
*****************************************************************************}
procedure Scroll;
begin
  fg_scroll(136,184,50,150,-4,0);
  fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
end;
{****************************************************************************}
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hPal);
  Invalidate;
end;
procedure TForm1.AppIdle(Sender: Tobject; var Done: Boolean);
begin
  Scroll;
  Done := False;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);
  hPal := fg_defpal;
  fg_realize(hPal);
  fg_vbinit;
  hVB1 := fg_vballoc(vbWidth,vbHeight);
  hVB2 := fg_vballoc(vbWidth,vbHeight);
  fg_vbopen(hVB2);
  fg_vbcolors;
  fg_vbopen(hVB1);
  fg_vbcolors;
  fg_sethpage(hVB2);
  fg_setcolor(19);
  fg_fillpage;
  fg_setcolor(25);
  fg_rect(132,188,50,150);
  fg_setcolor(20);
  fg_move(160,67);
  fg_draw(175,107);
  fg_draw(140,82);
  fg_draw(180,82);
  fg_draw(145,107);
  fg_draw(160,67);
  fg_paint(160,77);
  fg_paint(150,87);
  fg_paint(160,87);
  fg_paint(170,87);
  fg_paint(155,97);
  fg_paint(165,97);
  Application.OnActivate := AppOnActivate;
  Application.OnIdle := AppIdle;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
  fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
  cxClient := ClientWidth;
  cyClient := ClientHeight;
  Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  fg_vbclose;
  fg_vbfree(hVB1);
  fg_vbfree(hVB2);
  fg_vbfin;
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
end;
end.