//------------------------------------------------------------------
//    Файл:     basedd7.pas
//    Описание: Процедуры и функции для работы с DirectDraw
//------------------------------------------------------------------
unit basedd7;

interface

uses
  windows;




//------------------------------------------------------------------
// прототипы функций
//------------------------------------------------------------------
function InitDirectDraw( hWnd: HWND; dwWidth, dwHeight, dwBPP: DWORD ): boolean;
procedure ReleaseDirectDraw();
function LoadData(): boolean;
procedure OnDraw( x, y, frame: DWORD );

implementation

uses
  directdraw,
  ddutils;




//------------------------------------------------------------------
// типы, константы и глобальные переменные
//------------------------------------------------------------------
var
  g_pDD7:            IDirectDraw7        = nil; // главный объект DirectDraw
  g_pPrimarySurface: IDirectDrawSurface7 = nil; // первичная поверхность
  g_pBackBuffer:     IDirectDrawSurface7 = nil; // дополнительный буфер

  g_pDataSurface: IDirectDrawSurface7 = nil;            // общая поверхность
  g_pWallpaper:   IDirectDrawSurface7 = nil;            // задний фон
  g_pMovie:       array[ 0..9 ] of IDirectDrawSurface7; // набор кадров



  
//------------------------------------------------------------------
// производит инициализацию DirectDraw в программе
//------------------------------------------------------------------
function InitDirectDraw( hWnd: HWND; dwWidth, dwHeight, dwBPP: DWORD ): boolean;
var
  ddsd2: TDDSURFACEDESC2;
  ddsc2: TDDSCAPS2;
begin
  result := false;

  // создаём главный объект DirectDraw
  if FAILED( DirectDrawCreateEx( nil, g_pDD7, IID_IDirectDraw7, nil ) ) then
     exit;

  // устанавливаем уровень кооперации
  if FAILED( g_pDD7.SetCooperativeLevel( hWnd, DDSCL_ALLOWREBOOT or
                                               DDSCL_EXCLUSIVE or
                                               DDSCL_FULLSCREEN ) ) then
     exit;

  // устанавливаем требуемое разрешение и глубину цвета
  if FAILED( g_pDD7.SetDisplayMode( dwWidth, dwHeight, dwBPP, 0, 0 ) ) then
     exit;

  // подготавливаем структуру TDDSURFACEDESC2
  ZeroMemory( @ddsd2, SizeOf( TDDSURFACEDESC2 ) );
  ddsd2.dwSize := SizeOf( TDDSURFACEDESC2 );

  ddsd2.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
  ddsd2.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or
                          DDSCAPS_FLIP or
                          DDSCAPS_COMPLEX;
  ddsd2.dwBackBufferCount := 1;

  // создаём первичную поверхность (фактически постоянно видимую на экране)
  if FAILED( g_pDD7.CreateSurface( ddsd2, g_pPrimarySurface, nil ) ) then
     exit;

  // подготавливаем структуру TDDSCAPS2
  ZeroMemory( @ddsc2, sizeof( TDDSCAPS2 ) );
  ddsc2.dwCaps := DDSCAPS_BACKBUFFER;

  // подсоединяем к первичной поверхности дополнительный буфер
  if FAILED( g_pPrimarySurface.GetAttachedSurface( ddsc2, g_pBackBuffer ) ) then
     exit;

  result := true;
end;




//------------------------------------------------------------------
// удаляет из памяти объекты DirectDraw
//------------------------------------------------------------------
procedure ReleaseDirectDraw();
var
  i: integer;
begin
  for i := 0 to High( g_pMovie ) do
  if g_pMovie[ i ] <> nil then
     g_pMovie[ i ] := nil;

  if g_pWallpaper <> nil then
     g_pWallpaper := nil;

  if g_pBackBuffer <> nil then
     g_pBackBuffer := nil;

  if g_pPrimarySurface <> nil then
     g_pPrimarySurface := nil;

  if g_pDD7 <> nil then
  begin
    g_pDD7.RestoreDisplayMode();
    g_pDD7 := nil;
  end;
end;




//------------------------------------------------------------------
// загружает растр из bmp-файла на поверхности DirectDraw
//------------------------------------------------------------------
function LoadData(): boolean;
var
  pBits:    pointer;
  bi:       BITMAPINFO;

  DC:       HDC;
  dwWidth:  DWORD;
  dwHeight: DWORD;

  rect:     TRect;
  i:        integer;
begin
  result := false;

  // Создаём в памяти битовый массив. Вторым параметром функция возвращает
  // адрес структуры BITMAPINFO - она нужна при вызове функции StretchDIBits()
  pBits := LoadBitMap( 'data.bmp', @bi );
  if pBits = nil then
     exit;

  //------------------------------

  dwWidth := bi.bmiHeader.biWidth;
  dwHeight := bi.bmiHeader.biHeight;

  // создаём поверхность, на которую скопируем все данные из массива pBits
  if not CreateSurface( g_pDataSurface, dwWidth, dwHeight ) then
     exit;
  if g_pDataSurface.GetDC( DC ) = DD_OK then
  begin
    // копируем битовый массив в контекст
    StretchDIBits( DC,                      // контекст, в который осуществляется копирование
                   0, 0, dwWidth, dwHeight, // прямоугольная область, куда копируем
                   0, 0, dwWidth, DwHeight, // прямоугольная область источника копирования
                   pBits, bi,               // битовый массив и структура BITMAPINFO
                   0, SRCCOPY );            // параметры копирования
    g_pDataSurface.ReleaseDC( DC );
  end;

  // освободили битовый массив!
  pBits := nil;

  //------------------------------

  // переносим часть растра с data-поверхности на фоновую поверхность
  CreateSurface( g_pWallpaper, 640, 480 );
  SetRect( rect, 0, 0, 640, 480 );
  g_pWallpaper.BltFast( 0, 0, g_pDataSurface, @rect, DDBLTFAST_WAIT );

  // переносим часть растра с data-поверхности на поверхность спрайта
  for i := 0 to 9 do
  begin
    CreateSurface( g_pMovie[ i ], 64, 64 );         // номер и размеры кадра
    SetRect( rect, 64 * i, 480, 64 * i + 64, 544 ); // тут каждый раз новая область
    g_pMovie[ i ].BltFast( 0, 0, g_pDataSurface, @rect, DDBLTFAST_WAIT );
  end;

  //------------------------------

  // уничтожили data-поверхность!
  g_pDataSurface := nil;

  result := true;
end;




//------------------------------------------------------------------
// осуществляет построение изображения на экране
//------------------------------------------------------------------
procedure OnDraw( x, y, frame: DWORD );
begin
  g_pBackBuffer.BltFast( 0, 0, g_pWallpaper, nil, DDBLTFAST_WAIT );
  g_pBackBuffer.BltFast( x, y, g_pMovie[ frame ], nil, DDBLTFAST_WAIT );
  g_pPrimarySurface.Flip( nil, DDFLIP_WAIT );
end;

end.
