{******************************************************************************}
{* Иллюстрация к книге "DirectX. Графика в проектах Delphi".                  *}
{* Издательство BHV. www.bhv.ru                                               *}
{* Краснов М.В. softgl@chat.ru                                                *}
{******************************************************************************}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  AppEvnts, ExtCtrls, StdCtrls,
  DirectDraw, DDUtil;

type
  TfrmDD = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    ApplicationEvents1: TApplicationEvents;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    FDD            : IDirectDraw7;
    FDDSPrimary    : IDirectDrawSurface7;
    FDDClipper     : IDirectDrawClipper;
    FDDSBackGround : IDirectDrawSurface7;
    procedure ErrorOut(hRet : HRESULT; FuncName : String);
  public
    { Public declarations }
  end;

const
  ScreenWidth    = 800;
  ScreenHeight   = 600;
  ScreenBitDepth = 16;
  GroundBmp      = '..\Mona.bmp';

var
  frmDD: TfrmDD;

implementation

{$R *.DFM}

procedure TfrmDD.ErrorOut(hRet : HRESULT; FuncName : string);
begin
  MessageBox(0, PChar(FuncName + ': ' + #13 + DDErrorString(hRet)),
             PChar(Caption), MB_OK or MB_ICONSTOP);
end;

procedure TfrmDD.FormCreate(Sender: TObject);
var
  hRet : HRESULT;
  ddsd : TDDSurfaceDesc2;
  rgn : TRgnData;
  wrk : TRECT;
begin
  FDDSBackGround := nil;
  FDDSPrimary := nil;
  FDD := nil;

  hRet := DirectDrawCreateEx (nil, FDD, IDirectDraw7, nil);
  if Failed(hRet) then begin
      ErrorOut(hRet, 'DirectDrawCreateEx');
      Exit;
  end;

  hRet := FDD.SetCooperativeLevel(Handle, DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE);
  if Failed(hRet) then begin
     ErrorOut(hRet, 'SetCooperativeLevel');
     Exit;
  end;

  hRet := FDD.SetDisplayMode (ScreenWidth, ScreenHeight, ScreenBitDepth, 0, 0);
  if Failed(hRet) then ErrorOut(hRet, 'SetDisplayMode');

  ZeroMemory(@ddsd, SizeOf(ddsd));
  with ddsd do begin
       dwSize := SizeOf(ddsd);
       dwFlags := DDSD_CAPS;
       ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
  end;
  hRet := FDD.CreateSurface(ddsd, FDDSPrimary, nil);
  if Failed(hRet) then begin
     ErrorOut(hRet, 'Create Primary Surface');
     Exit;
  end;

  SetRect (wrk, 230, 0, 620, 600);
  with rgn.rdh do begin
       dwSize := SizeOf (RGNDATAHEADER);
       iType := RDH_RECTANGLES;
       nCount := 1;
       nRgnSize := Sizeof(TRECT);
  end;
  PRECT(@rgn.Buffer)^ := wrk;
  if FDD.CreateClipper(0, FDDClipper, nil) = DD_OK then begin
     FDDClipper.SetClipList (@rgn, 0);
     FDDSPrimary.SetClipper(FDDClipper);
  end;

  FDDSBackGround := DDLoadBitmap(FDD, GroundBmp, 0, 0);
  if FDDSBackGround = nil then ErrorOut(DD_FALSE, 'DDLoadBitmap');
end;

procedure TfrmDD.FormDestroy(Sender: TObject);
begin
  if Assigned(FDD) then begin
      if Assigned(FDDSBackGround) then begin
         FDDSBackGround._Release;
         FDDSBackGround := nil;
      end;
      if Assigned(FDDSPrimary) then begin
         FDDSPrimary._Release;
         FDDSPrimary := nil;
      end;
      FDD._Release;
      FDD := nil;
  end;
end;

procedure TfrmDD.FormPaint(Sender: TObject);
begin
  FDDSPrimary.Blt (nil, FDDSBackGround, nil, DDBLT_WAIT, nil);
end;

procedure TfrmDD.FormActivate(Sender: TObject);
begin
  WindowState := wsMaximized;
  ComboBox1.Left := 650;
end;

procedure TfrmDD.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Hide
end;

procedure TfrmDD.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) or (Key = VK_F12) then Close;
end;

end.


