unit main;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    DD: TDirectDraw;
    DDSPrimary, DDSBack, DDSOne: TDirectDrawSurface;
    DDPal: TDirectDrawPalette;
    lastTickCount: array [0..2] of Longint;
    currentFrame: array [0..2] of Integer;

    procedure finiObjects;
    procedure doInit;
    procedure UpdateFrame(Sender: TObject; var Done: Boolean);
    function RestoreAll: Boolean;
  public
  end;

const
  szBitmap = 'ALL';
  delay: array [0..3] of Longint = (13, 13, 13, 13);
  xpos: array [0..3] of Integer = (288, 190, 416, 420);
  ypos: array [0..3] of Integer = (300, 300, 300, 300);

var
  Form1: TForm1;

implementation

{$R *.DFM}

(*
 * finiObjects
 *
 * finished with all objects we use; release them
 *)
procedure TForm1.finiObjects;
begin
  DD.RestoreDisplayMode;
  DD.Free;
end;


(*
 * restoreAll
 *
 * restore all lost objects
 *)
function TForm1.restoreAll: Boolean;
begin
  Result := False;
  if not DDSPrimary.Restore or not DDSOne.Restore then exit;
  DDSOne.ReloadBitmap( szBitmap );
  Result := True;
end;


(*
 * doInit - do work required for every instance of the application:
 *                create the window, initialize data
 *)
procedure TForm1.doInit;
var
  ddscaps: TDDSCaps;
  ddsd: TDDSurfaceDesc;
  Step: Double;
begin
  try
    (*
     * create the main DirectDraw object
     *)
    Step := 0;
    DD := TDirectDraw.Create( nil );

    Step := 1;
    // Get exclusive mode

    //DD.SetCooperativeLevel( Handle, DDSCL_EXCLUSIVE or DDSCL_FULLSCREEN );
    DD.SetCooperativeLevel( Handle, DDSCL_Normal);

    Step := 2;
    //DD.SetDisplayMode( 640, 480, 8 );

    Step := 3;
    // Create the primary surface with 1 back buffer
    ddsd.dwSize := sizeof( ddsd );
    Step := 3.1;
    ddsd.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
    Step := 3.2;
    ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or
              DDSCAPS_FLIP or
              DDSCAPS_COMPLEX;
    Step := 3.3;
    ddsd.dwBackBufferCount := 1;
    Step := 3.4;
    DDSPrimary := TDirectDrawSurface.Create( DD, ddsd );

    Step := 4;
    // Get a pointer to the back buffer
    ddscaps.dwCaps := DDSCAPS_BACKBUFFER;
    DDSBack := DDSPrimary.GetAttachedSurface( ddscaps );

    Step := 5;
    // Create a Direct Draw Palette and associate it with the front buffer
    DDPal := DD.LoadPalette( szBitmap );

    DDSPrimary.Palette := DDPal;

    // Create the offscreen surface, by loading our bitmap.
    DDSOne := DD.LoadBitmap( szBitmap, 0, 0 );

    // Set the color key for this bitmap (black)
    DDSOne.SetRGBColorKey( RGB(0,0,0) );
  except
    on Exception do
    begin
      ShowMessage( 'Direct Draw Init Failed at step ' + FloattoStr(Step) );
      finiObjects;
      raise;
    end;
  end;

  Application.OnIdle := UpdateFrame;
end;


procedure TForm1.UpdateFrame(Sender: TObject; var Done: Boolean);
var
  rcRect: TRect;
  thisTickCount: Longint;
  i: Integer;

begin
  Done := False;

  if DDSPrimary.IsLost then
    if not RestoreAll then exit;

  thisTickCount := GetTickCount;
  for i := 0 to 2 do
  begin
	  if((thisTickCount - lastTickCount[i]) > delay[i]) then
	  begin
	    // Move to next frame;
	    lastTickCount[i] := thisTickCount;
	    Inc( currentFrame[i] );
	    if (currentFrame[i] > 59) then
    		currentFrame[i] := 0;
    end;
  end;

  // Blit the stuff for the next frame
  rcRect := Rect( 0, 0, 640, 480 );

  try
    // wait until it can blit
    DDSBack.BltFast( 0, 0, DDSOne, @rcRect, DDBLTFAST_NOCOLORKEY
      or DDBLTFAST_WAIT );

    for i := 0 to 2 do
    begin
      rcRect := Rect(currentFrame[i] mod 10*64, currentFrame[i] div 10*64 + 480,
        currentFrame[i] mod 10*64 + 64, currentFrame[i] div 10*64 + 64 + 480);

      DDSBack.BltFast( xpos[i], ypos[i], DDSOne, @rcRect, DDBLTFAST_SRCCOLORKEY
        or DDBLTFAST_WAIT );
    end;

    // Flip surfaces
    DDSPrimary.Flip( nil, DDFLIP_WAIT );

  except
    on E: EDirectDrawError do
      if E.ErrorCode <> DDERR_SURFACELOST then raise;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
  Cnt: Integer;
begin
  //Screen.Cursor := crNone;

  for Cnt := 0 to 2 do
  begin
    lasttickCount[Cnt] := 0;
    currentFrame[Cnt] := 0;
  end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F10 then
    Close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  finiObjects;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  if (DD = nil) then
    DoInit;
end;

end.
