DirectDraw w Delphi

LOSMARCELOS

Kiedyś,ze 2 lata temu napisałem moduł ułatwiający współprace DirectDraw i Delphi.
Jeśli chcemy zmienić rozdzielczosc na tryb pełnoekranowy w podanej rozdz. uzywamy InitializeDirectDraw(uchwyt okna, szer, wys, glebia kolorow)
DestroyDirectDraw -zamkniecie DirectDraw
CheckVideoSystem - sprawdzenie czy jest obsluga DirectDraw

unit DDRAW_E;

interface

uses Windows, DirectDraw;

procedure InitializeDirectDraw(_HWND : HWND; dwWidth : DWORD; dwHeight : DWORD; dwBPP : DWORD);
procedure DestroyDirectDraw();
function CheckVideoSystem() : HRESULT;

var lpDD : IDIRECTDRAW;           // DirectDraw Obiekt
var lpDDSPrimary : IDirectDrawSurface;        // DirectDraw Główna Powierzchnia
var lpDDSBack : IDirectDrawSurface;      // DirectDraw Tylna Powierzchnia
var bActive : boolean;        // czy Aplikacja jest Aktywna
var lpDDDriverCaps : PDDCAPS;
var lpDDHELCaps :  PDDCAPS;

implementation

procedure InitializeDirectDraw(_HWND : HWND; dwWidth : DWORD; dwHeight : DWORD; dwBPP : DWORD);
var  ddrval : HRESULT;
var  ddsd : TDDSurfaceDesc;
var  ddscaps : TDDSCaps;
begin
//  HDC DC;
//  char buf[256];

  ddrval := DirectDrawCreate(nil, lpDD, nil);
  if (ddrval = DD_OK) then
  begin
    // Weź tryb ekskluzywny
    ddrval := lpDD.SetCooperativeLevel(_HWND,
      DDSCL_EXCLUSIVE or DDSCL_FULLSCREEN or DDSCL_ALLOWREBOOT);
    if(ddrval = DD_OK) then
    begin
      ddrval := lpDD.SetDisplayMode(dwWidth, dwHeight, dwBPP);
      if(ddrval = DD_OK) then
      begin
        // Create the primary surface with 1 back buffer
        // Twórz Główną Powierzchnię z 1 Tylnym Buforem
        ddsd.dwSize := sizeof(ddsd);
        ddsd.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
        ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or
                              DDSCAPS_FLIP or
                              DDSCAPS_COMPLEX;
        ddsd.dwBackBufferCount := 1;
        ddrval := lpDD.CreateSurface(ddsd, lpDDSPrimary, nil);
        if(ddrval = DD_OK) then
        begin
          // Get a pointer to the back buffer
          // Weź wskaźnik z Tylnego Bufora
          ddscaps.dwCaps := DDSCAPS_BACKBUFFER;
          ddrval := lpDDSPrimary.GetAttachedSurface(ddscaps,
                                                lpDDSBack);

        if (ddrval = DDERR_OUTOFMEMORY) then
        begin
            MessageBox(0, 'Brak pamięci operacyjnej aby zainicjalizować DirectDraw !!!!! ', 'Błąd !!!!', MB_ICONERROR);
        end;

        if (ddrval = DDERR_OUTOFVIDEOMEMORY) then
        begin
            MessageBox(0, 'Brak pamięci Video aby zainicjalizować DirectDraw !!!!! ', 'Błąd !!!!', MB_ICONERROR);
        end;
        if (ddrval = DDERR_NODIRECTDRAWHW) then
        begin
            MessageBox(0, 'Nie można załączyć wsparcia sprzętowego !!!!! ', 'Błąd !!!!', MB_ICONERROR);
        end;

        if (ddrval = DDERR_UNSUPPORTEDMODE) then
        begin
            MessageBox(0, 'Operacja nie jest obsługiwana !!!!! ', 'Błąd !!!!', MB_ICONERROR);
        end;

        if (ddrval = DDERR_NOEXCLUSIVEMODE) then
        begin
            MessageBox(0, 'Nie można zainicjować Direct Draw w trybie ekskluzywnym !!!!!\n ' +
            ' Proszę sprawdzić czy nie jest uruchomiony jakiś program korzystający z Direct Draw' +
            'w trybie ekskluzywnym !!!!!', 'Błąd !!!!', MB_ICONERROR);
        end;

end;
end;
end;
end;
end;

procedure DestroyDirectDraw();
begin
  if(lpDD <> nil) then
  begin
    if(lpDDSPrimary <> nil)
    then begin
      lpDDSPrimary._Release();
      lpDDSPrimary := nil;
    end;
    lpDD._Release();
    lpDD := nil;
end;

end;

function CheckVideoSystem() : HRESULT;
var hr : HRESULT;
begin
hr := lpDD.GetCaps(lpDDDriverCaps, lpDDHELCaps);
result := hr;
end;

end.

5 komentarzy

LF - racja powinno byc w gotowcach - do FAQ za trudne. btw, sorki za literki - alt mi sie rozwalil

Czasem się przydać może...

TRochę eksperymentowałem z DirectDrałem ale osiągnąłęm jedynie Acces Volation

No nie, to ma być artykuł? Dwa zdania i trochę kodu? To powinno być w gotowcach, albo ewentualnie w FAQ.

nom fajne :D przydaje sie