Текущий архив: 2005.03.20;
Скачать: CL | DM;

Вниз

Товарищи! Поможите с DirectDraw!   Найти похожие ветки 

← →
Вась-Вась   (2004-11-25 18:33) [0]

Глубоко-преглубоко уважаемые мастера Delphi! Я решил изучить DirectX основательно – а именно не DelphiX, а с помощью заголовочных файлов, COM-технологии и т.д. Купил книгу (Краснова, если кто интересуется, единственная книга на эту тему, которую нашёл в магазинах). Так вот, в каждом примере, приводимом в тексте книженции, при закрытии приложения, использующего DirectDraw, происходит AccessViolation! Может быть кто-нибудь сталкивался с такими же ошибками? Заголовочные файлы брал с сайта : http://clootie.narod.ru , самые новые. На всякий случай я выложу листинг проги (я просто не знаю, как ещё можно донести до общественности листинг приложения).

unit Unit1;
interface
uses…
type
 TForm1 = class(TForm)
    …
 private
   FDD            : IDirectDraw7;
   FDDSBack       : IDirectDrawSurface7;
   FDDSPrimary    : IDirectDrawSurface7;
   FDDSBackGround : IDirectDrawSurface7;
   FDDSImage      : IDirectDrawSurface7;
   procedure ErrorOut(hRet : HRESULT; FuncName : String);
   function RestoreAll: HRESULT;
 protected
   procedure FormSetCursor(var aMsg : TMessage); message WM_SETCURSOR;
 end;
const
 ScreenWidth = 640;
 ScreenHeight = 480;
 ScreenBitDepth = 16;
 groundBMP = "Lake.bmp";
 imageBMP = "Mouse.bmp";
var
 Form1: TForm1;
 mousex: integer = 0;
 mousey: integer = 0;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.ErrorOut(hRet: HRESULT; FuncName: String);
var
 t : TextFile;
begin
 AssignFile (t, "Debug.txt");
 Rewrite (t);
 WriteLn (t, FuncName + ": " + DDErrorString (hRet));
 CloseFile (t);
 Destroy;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
 hRet : HRESULT;
 ddsd : TDDSurfaceDesc2;
 ddscaps : TDDSCaps2;
begin
 FDDSImage := nil;
 FDDSBack := nil;
 FDDSBackGround := nil;
 FDDSPrimary := nil;
 FDD := nil;
 hRet:=DirectDrawCreateEx(nil,FDD,IDirectDraw7,nil);
 if Failed(hRet) then
   ErrorOut(hRet,"DirectDrawCreateEx");
 hRet:=FDD.SetCooperativeLevel(Handle,DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE);
 if Failed(hRet) then
   ErrorOut(hRet,"SetCooperativeLevel");
 hRet:=FDD.SetDisplayMode(ScreenWidth,ScreenHeight,ScreenBitDepth,0,0);
 if Failed(hRet) then
   ErrorOut(hRet,"SetDisplayMode");
 ZeroMemory(@ddsd,SizeOf(ddsd));
 with ddsd do
 begin
   dwSize:=SizeOf(ddsd);
   dwFlags:=DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
   ddsCaps.dwCaps:=DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
   dwBackBufferCount:=1;
 end;
 hRet:=FDD.CreateSurface(ddsd,FDDSPrimary,nil);
 if Failed(hRet) then
   ErrorOut(hRet,"Create Primary Surface");
 FDDSBackGround:=DDLoadBitmap(FDD,groundBMP,ScreenWidth,ScreenHeight);
 if FDDSBackGround = nil then
   ErrorOut(hRet,"DDLoadBitmap");
 ZeroMemory(@ddscaps,SizeOf(ddscaps));
 ddscaps.dwCaps:=DDSCAPS_BACKBUFFER;
 hRet:=FDDSPrimary.GetAttachedSurface(ddscaps,FDDSBack);
 if Failed(hRet) then
   ErrorOut(hRet,"GetAttachedSurface");
 FDDSImage:=DDLoadBitmap(FDD,imageBMP,0,0);
 if FDDSImage=nil then
   ErrorOut(hRet,"DDLoadBitmap");
 hRet:=DDSetColorKey(FDDSImage,rgb(0,0,0));
 if Failed(hRet) then
   ErrorOut(hRet,"DDSetColorKey");
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 if Assigned(FDD) then
 begin
   if Assigned(FDDSImage) then
   begin
     FDDSImage._Release;
     FDDSImage:=nil;
   end;
   if Assigned(FDDSBackGround) then
   begin
     FDDSBackGround._Release;
     FDDSBackGround:=nil;
   end;
   if Assigned(FDDSPrimary) then
   begin
     FDDSPrimary._Release;
     FDDSPrimary:=nil;
   end;
   FDD._Release;
   FDD:=nil;
 end;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
 hRet: HRESULT;
begin
 while true do
 begin
   hRet:=FDDSBack.BltFast(0,0,FDDSBackGround,nil,DDBLTFAST_WAIT);
   if hRet=DDERR_SURFACELOST then
   begin
     if Failed(RestoreAll) then
       Exit;
   end
   else
     Break;
 end;
 while true do
 begin
   hRet:=FDDSBack.BltFast(mousex,mouseY,FDDSImage,nil,DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
   if hRet = DDERR_SURFACELOST then
   begin
     if Failed(RestoreAll) then
       Exit;
   end
   else
     Break;
 end;
 while True do
 begin
   hRet:=FDDSPrimary.Flip(nil,DDFLIP_WAIT);
   if hRet = DDERR_SURFACELOST then
   begin
     if Failed(RestoreAll) then
       Exit;
   end
   else
     Break;
 end;
end;
procedure TForm1.ApplicationEvents1Deactivate(Sender: TObject);
begin
 Application.Minimize;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
 if (Key=VK_ESCAPE) or (Key=VK_F12) then
   Close;
end;
procedure TForm1.FormSetCursor(var aMsg: TMessage);
begin
 SetCursor(0);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 if x<=ScreenWidth-40 then
   mouseX:=x;
 if y<=ScreenHeight-40 then
   mouseY:=y;
 FormPaint(nil);  
end;
function TForm1.RestoreAll: HRESULT;
var
 hRet: HRESULT;
begin
 hRet:=FDDSPrimary._Restore;
 if Succeeded(hRet) then
 begin
   hRet:=FDDSBackGround._Restore;
   if Failed(hRet) then
   begin
     Result:=hRet;
     Exit;
   end;
   hRet:=DDReloadBitmap(FDDSBackGround, groundBMP);
   if Failed(hRet) then
   begin
     Result:=hRet;
     Exit;
   end;
   hRet:=FDDSImage._Restore;
   if Failed(hRet) then
   begin
     Result:=hRet;
     Exit;
   end;
   result:=DDReloadBitmap(FDDSImage,imageBMP);
 end
 else
   Result:=hRet;
end;
procedure TForm1.ApplicationEvents1Restore(Sender: TObject);
begin
 WindowState:=wsMaximized;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Hide;
end;
end.


---

← →
Darthman ©   (2004-11-25 18:49) [1]

Сталкивался. Откажись от _Release и все будет работать замечательно.

---

← →
Вась-Вась   (2004-11-25 20:14) [2]

Проблема в том, что я уже пробовал и без _Release, но всё равно выскакивает ошибка (Access violation) при закрытии!

---

← →
Mihey_temporary ©   (2004-11-25 20:45) [3]

Тестируй приложения не из Delphi. Кроме того, был поразительный баг - переписал я пример как в книжке, кроме одного - не указал модуль AppEvnts. Всё пахало, но выскакивала ошибка при закрытии. Так что про это тоже не забывай.

---

← →
П7   (2004-11-25 21:20) [4]

Ошибки были точно такие же. Не знаю, кто вообще Красного допустил писать книги по программированию графики, но руки у него явно растут из задницы.
Всё решилось отказом от примеров Красного и VCL. Бери у него только теорию, если нет других источников, а примеры собирай ручками при помощи WinAPI. Качай инфу и примеры из Сети. И всё будет ОК. (:

---

← →
Sphinx   (2004-11-26 10:18) [5]

А у меня вообще его примеры написаные с привлечением VCL подвисали. :(
В итоге разбирался с примерами с того же сайта http://clootie.narod.ru All Direct Draw кажется, там и реализация на VCL и на WinAPI показана, и ошибок у меня покрайней мере не возникает. :)

---

← →
NikeOLD ©   (2004-11-26 11:43) [6]

Краснова защищать не буду, по нему и впрямь в консерватории соскучились.
Его примеры криво, но работают. Главное не пыться отлаживать полноэкранные приложения в Дельфи. Под 98 и оконные вылетают, если начать блокировать поверхности. В С++ такого не происходит.

А метод _Release в Дельфи вызывается автоматически. С одной стороны хорошо, с другой...
И почаще пользуйся логом. Пихай туда все, что можно. так ошибка быстрее найдется.

---

← →
DonNikola   (2004-12-22 05:24) [7]

Я бы тому товарищу в Borland кто делал поддержку интерфейсов, вообще бы руки поотрывал бы. Все по умолчанию, бабай их забери! Классический вариант это попытка самому делать _Release. А тут на днях выделяю память по record, в котором есть интерфейс, а как этот интерфейс, простите, обнулять? Если делать :=nil;, то в результате Delphi пытаеться сделать ClearIntf тому хламу что был там раньше и один сплошной AccessViolation. Пришлось делать FillChar(,,0).

---

Страницы: 1 вся ветка

Текущий архив: 2005.03.20;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.042 c