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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DirectDraw;

type
  TfrmDD = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    FDD : IDirectDraw7;
    FDDSPrimary    : IDirectDrawSurface7;
    procedure ErrorOut(hRet : HRESULT; FuncName : string);
  public
    { Public declarations }
  end;

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;
begin
  FDDSPrimary := nil;
  FDD := nil;

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

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

  FillChar (ddsd, SizeOf(ddsd), 0);
  ddsd.dwSize := SizeOf(ddsd);
  ddsd.dwFlags := DDSD_CAPS;
  ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
  hRet := FDD.CreateSurface(ddsd, FDDSPrimary, nil);
  if hRet <> DD_OK then begin
     ErrorOut(hRet, 'Create Primary Surface');
     Exit;
  end;
end;

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

procedure TfrmDD.FormPaint(Sender: TObject);
var
  DC : HDC;
  wrkCanvas : TCanvas;
begin
  if FDDSPrimary.GetDC(DC) = DD_OK then begin
     wrkCanvas := TCanvas.Create;
     wrkCanvas.Handle := DC;
     wrkCanvas.Ellipse (Left + 50, Top + 50, Left + 100, Top + 100);
     wrkCanvas.Free;
     FDDSPrimary.ReleaseDC (DC);
  end;
end;

end.
