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.
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