FrameDD: Delphi Version

In Delphi programs, adding a WM_ACTIVATEAPP event handler requires overriding the default message-handling method for that message. To do this, we must declare a new method (with the same message index as the method it overrides) in the protected part of the form declaration:

protected
  procedure WMActivateApp(var Msg: TMessage);
            message WM_ACTIVATEAPP;

Our WM_ACTIVATEAPP handler updates the AppIsActive global and restores the DirectDraw surfaces with fg_ddrestore() when FrameDD becomes active:

procedure TForm1.WMActivateApp(var Msg: TMessage);
begin
  AppIsActive := (Msg.WParam <> 0);
  if AppIsActive then fg_ddrestore;
end;

Finally, note how FrameDD's OnIdle handler calls Animate() only when AppIsActive is True.

{*****************************************************************************
*                                                                            *
*  FrameDD.dpr                                                               *
*  FrameDDU.pas                                                              *
*                                                                            *
*  This program shows how to set up a full screen DirectDraw application     *
*  for either blitting or flipping. The selection of blitting or flipping is *
*  controlled by the BLIT and FLIP symbols defined below.                    *
*                                                                            *
*****************************************************************************}
unit FrameDDU;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWinD;
type
  TForm1 = class(TForm)
    procedure AppOnActivate(Sender: TObject);
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
  protected
    procedure WMActivateApp(var Msg: TMessage); message WM_ACTIVATEAPP;
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
{ define either BLIT or FLIP, but not both, for blitting or flipping }
{$DEFINE BLIT}
{$UNDEF FLIP}
const
  vbWidth = 640;
  vbHeight = 480;
var
  dc   : hDC;
  hPal : hPalette;
  hVB  : integer;
  AppIsActive : boolean = False;
{*****************************************************************************
*                                                                            *
*  Animate()                                                                 *
*                                                                            *
*  Construct the next frame of animation and display it with either blitting *
*  or flipping, as directed by the BLIT and FLIP symbols above.              *
*                                                                            *
*****************************************************************************}
procedure Animate;
begin
  { fill drawing surface with the next color }
  fg_setcolor((fg_getcolor + 1) and $FF);
  fg_fillpage;
  { blit or flip surface to the screen }
  {$IFDEF BLIT}
  fg_vbpaste(0,vbWidth-1,0,vbHeight-1,0,vbHeight-1);
  {$ELSE}
  fg_ddflip;
  {$ENDIF}
end;
{*****************************************************************************
*                                                                            *
*  Application event handlers...                                             *
*                                                                            *
*****************************************************************************}
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.AppIdle(Sender: Tobject; var Done: Boolean);
begin
  if AppIsActive then Animate;
  Done := False;
end;
{*****************************************************************************
*                                                                            *
*  Additional Windows message handlers...                                    *
*                                                                            *
*****************************************************************************}
procedure TForm1.WMActivateApp(var Msg: TMessage);
begin
  AppIsActive := (Msg.WParam <> 0);
  if AppIsActive then fg_ddrestore;
end;
{*****************************************************************************
*                                                                            *
*  Form event handlers...                                                    *
*                                                                            *
*****************************************************************************}
procedure TForm1.FormActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  {$IFDEF BLIT}
  fg_ddsetup(vbWidth,vbHeight,8,FG_DX_BLIT);
  {$ELSE}
  fg_ddsetup(vbWidth,vbHeight,8,FG_DX_FLIP);
  {$ENDIF}
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);
  hPal := fg_defpal;
  fg_realize(hPal);
  Visible := True;
  fg_vbinit;
  { if blitting, create a virtual buffer the same size as the screen }
  { resolution; if flipping, use the primary surface's back buffer }
  {$IFDEF BLIT}
  hVB := fg_vballoc(vbWidth,vbHeight);
  {$ELSE}
  hVB := 0;
  {$ENDIF}
  fg_vbopen(hVB);
  fg_vbcolors;
  fg_mouseini;
  fg_mousevis(0);
  Application.OnActivate := AppOnActivate;
  Application.OnIdle := AppIdle;
  AppIsActive := True;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_Escape) or (Key = VK_F12) then Close;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  fg_mousevis(1);
  fg_vbclose;
  {$IFDEF BLIT}
  fg_vbfree(hVB);
  {$ENDIF}
  fg_vbfin;
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
  Application.Minimize;
end;
end.