(******************************************************************************
 *                                                                            *
 *  Придумал и написал Кода Виктор, Март 2002                                 *
 *                                                                            *
 *  Файл:       basedd8.pas                                                   *
 *  Содержание: Процедуры и функции для работы с DirectDraw API               *
 *                                                                            *
 ******************************************************************************)
unit basedd8;

interface

uses
  windows,
  directdraw;




//------------------------------------------------------------------------------
// Константы и глобальные переменные
//------------------------------------------------------------------------------
const
  SCREEN_WIDTH  = 640; // Ширина экрана
  SCREEN_HEIGHT = 480; // Высота экрана




//------------------------------------------------------------------------------
// Прототипы функций
//------------------------------------------------------------------------------
function InitDirectDraw( hWnd: HWND; dwWidth, dwHeight, dwBPP: DWORD ): Boolean;
procedure ReleaseDirectDraw();
function CopyImage( var lpSurf: IDirectDrawSurface7; hImage: HBITMAP ): Boolean;
function LoadFiles( hWnd: HWND ): Boolean;
procedure OnDraw( nX, nY: Integer );

implementation




//------------------------------------------------------------------------------
// Константы и глобальные переменные
//------------------------------------------------------------------------------
var
  lpDD7:            IDirectDraw7        = nil;  // Главный объект DirectDraw
  lpPrimarySurface: IDirectDrawSurface7 = nil;  // Первичная поверхность
  lpBackBuffer:     IDirectDrawSurface7 = nil;  // Дополнительный буфер

  lpWallpaper:      IDirectDrawSurface7 = nil;  // Задний фон
  lpSprite:         IDirectDrawSurface7 = nil;  // Спрайт




//------------------------------------------------------------------------------
// Имя:      InitDirectDraw()
// Описание: Производит инициализацию объектов DirectDraw в программе
//------------------------------------------------------------------------------
function InitDirectDraw( hWnd: HWND; dwWidth, dwHeight, dwBPP: DWORD ): Boolean;
var
  ddsd2: TDDSURFACEDESC2;
  ddsc2: TDDSCAPS2;
begin
  Result := FALSE;

  // Создаём главный объект DirectDraw
  if FAILED( DirectDrawCreateEx( nil, lpDD7, IID_IDIRECTDRAW7, nil ) ) then
     Exit;
  lpDD7._AddRef();

  // Устанавливаем уровень кооперации
  if FAILED( lpDD7.SetCooperativeLevel( hWnd, DDSCL_ALLOWREBOOT or
                                              DDSCL_EXCLUSIVE or
                                              DDSCL_FULLSCREEN ) ) then
     Exit;

  // Устанавливаем требуемое разрешение и глубину цвета
  if FAILED( lpDD7.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( lpDD7.CreateSurface( ddsd2, lpPrimarySurface, nil ) ) then
     Exit;
  lpPrimarySurface._AddRef();

  // Подготавливаем структуру TDDSCAPS2
  ZeroMemory( @ddsc2, SizeOf( TDDSCAPS2 ) );
  ddsc2.dwCaps := DDSCAPS_BACKBUFFER; //Указываем, что поверхность будет буфером

  // Подсоединяем к первичной поверхности дополнительный буфер
  if FAILED( lpPrimarySurface.GetAttachedSurface( ddsc2, lpBackBuffer ) ) then
     Exit;
  lpBackBuffer._AddRef();

  Result := TRUE;
end;




//------------------------------------------------------------------------------
// Имя:      ReleaseDirectDraw()
// Описание: Удаляет из памяти объекты DirectDraw
//------------------------------------------------------------------------------
procedure ReleaseDirectDraw();
begin
  // Удаляем сперва дополнительный буфер
  if lpBackBuffer <> nil then
  begin
    lpBackBuffer._Release();
    lpBackBuffer := nil;
  end;

  // Теперь можно удалить первичную поверхность
  if lpPrimarySurface <> nil then
  begin
    lpPrimarySurface._Release();
    lpPrimarySurface := nil;
  end;

  // Наконец, последним удаляем главный объект DirectDraw
  if lpDD7 <> nil then
  begin
    lpDD7.RestoreDisplayMode(); // Восстанавливаем прежний видеорежим
    lpDD7._Release();
    lpDD7 := nil;
  end;
end;




//------------------------------------------------------------------------------
// Имя:      CreateSurface()
// Описание: Создаёт поверхность DirectDraw нужных размеров
//------------------------------------------------------------------------------
function CreateSurface( var lpSurface: IDirectDrawSurface7; nWidth,
                        nHeight: Integer ): Boolean;
var
  ddsd2: TDDSURFACEDESC2;
begin
  Result := FALSE;

  // Если поверхность существует, то удаляем
  if lpSurface <> nil then
  begin
    lpSurface._Release;
    lpSurface := nil;
  end;

  // Подготавливаем структуру TDDSURFACEDESC2
  ZeroMemory( @ddsd2, SizeOf( TDDSURFACEDESC2 ) );
  with ddsd2 do
  begin
    dwSize         := SizeOf( TDDSURFACEDESC2 );
    dwFlags        := DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT;
    ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
    dwWidth        := nWidth;
    dwHeight       := nHeight;
  end;

  // Создаём поверхность
  if FAILED( lpDD7.CreateSurface( ddsd2, lpSurface, nil ) ) then
     Exit;
  lpSurface._AddRef;

  Result := TRUE;
end;




//------------------------------------------------------------------------------
// Имя:      CopyImage()
// Описание: Копирует изображение на поверхность DirectDraw
//------------------------------------------------------------------------------
function CopyImage( var lpSurf: IDirectDrawSurface7; hImage: HBITMAP ): Boolean;
var
  destDC,          // Поверхность-приёмник
  srcDC:  HDC;     // Поверхность-источник
  bm:     BITMAP;  // BITMAP из windows.pas
  hObj:   HGDIOBJ; // Объект GDI
begin
  Result := FALSE;

  // Создаём контекст памяти, совместимый с Рабочим столом
  srcDC := CreateCompatibleDC( 0 );

  // Если контекст не получен - обрабатываем ошибку
  if srcDC = 0 then Exit;

  // Выбираем в контекст растр
  hObj := SelectObject( srcDC, hImage );
  if ( hObj = 0 ) or ( hObj = GDI_ERROR ) then
     Exit;

  // Получаем размеры растра, данные заполняют структуру BITMAP
  if GetObject( hImage, SizeOf( bm ), @bm ) = 0 then
     Exit;

  // Пересоздаём поверхность с размерами растра
  if not CreateSurface( lpSurf, bm.bmWidth, bm.bmHeight ) then
     Exit;

  // Создаём GDI-совместимый контекст для поверхности
  if SUCCEEDED( lpSurf.GetDC( destDC ) ) then
  begin
    // BitBlt-им в контексте (а фактически на поверхности DirectDraw)
    BitBlt( destDC, 0, 0, bm.bmWidth, bm.bmHeight, srcDC, 0, 0, SRCCOPY );
    lpSurf.ReleaseDC( destDC );
  end
  else Exit;

  // В конце операции удаляем объекты GDI
  DeleteObject( hObj );
  DeleteDC( srcDC );

  Result := TRUE;
end;




//------------------------------------------------------------------------------
// Имя:      LoadFiles()
// Описание: Загружает растр из bmp-файлов на поверхность DirectDraw
//------------------------------------------------------------------------------
function LoadFiles( hWnd: HWND ): Boolean;
var
  hImage: HBITMAP;
begin
   Result := FALSE;

   // Загружаем изображение и получаем его хэндл
   hImage := LoadImage( 0, 'wallpaper.bmp', IMAGE_BITMAP, 0, 0,
                        LR_LOADFROMFILE or LR_CREATEDIBSECTION );
   if hImage = 0 then
   begin
     MessageBox( hWnd, 'Не загружен файл wallpaper.bmp!', 'Ошибка!', MB_ICONHAND );
     Exit;
   end;

   // Копируем растр на поверхность DirectDraw
   if not CopyImage( lpWallpaper, hImage ) then
      Exit;

   // Теперь для подвижного спрайта (файл картинки я взял из DSK).
   hImage := LoadImage( 0, 'sprite.bmp', IMAGE_BITMAP, 0, 0,
                        LR_LOADFROMFILE or LR_CREATEDIBSECTION );
   if hImage = 0 then
   begin
     MessageBox( hWnd, 'Не загружен файл sprite.bmp!', 'Ошибка!', MB_ICONHAND );
     Exit;
   end;

   if not CopyImage( lpSprite, hImage ) then
      Exit;

   Result := TRUE;
end;




//------------------------------------------------------------------------------
// Имя:      OnDraw()
// Описание: Осуществляет вывод на экран фона и спрайта
//------------------------------------------------------------------------------
procedure OnDraw( nX, nY: Integer );
var
  rRect: TRect;
begin
  // Устанавливаем размер прямоугольника под размер поверхности
  SetRect( rRect, 0, 0, SCREEN_WIDTH, SCREEN_HEIGHT );
  // Копируем изображение фона на задний буфер
  lpBackBuffer.BltFast( 0, 0, lpWallpaper, @rRect, DDBLTFAST_WAIT );

  // Аналогично для спрайта
  SetRect( rRect, 0, 0, 256, 256 );
  lpBackBuffer.BltFast( nX, nY, lpSprite, @rRect, DDBLTFAST_WAIT );

  // Теперь быстро переносим содержимое заднего буфера на первичную поверхность
  lpPrimarySurface.Flip( nil, DDFLIP_WAIT );
end;

end.