| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Прошу разъяснить и помочь
ferr © (2004-06-15 21:25:00)Когда я беру пример из книги Краснова DirectX Chap4 Ex09 его (Краснова программа на диске) откомпилированная версия работает нормально, но если я скомпилирую сам, данный проект, то при завршении он генерирует ошибку.
Может кто подскажет что делать.
ferr (2004-06-16 14:15:00) [1]Всем большое человеческое Спасибо...
ferr (2004-06-16 14:12:00) [2]Вроде вот так работает
if Assigned(FDD) then begin
if Assigned(FDDSImage) then begin
// FDDSImage._Release;
Pointer(FDDSImage) := nil;
end;
if Assigned(FDDSBackGround) then begin
// FDDSBackGround._Release;
Pointer(FDDSBackGround) := nil;
end;
if Assigned(FDDSPrimary) then begin
// FDDSPrimary._Release;
Pointer(FDDSPrimary) := nil;
end;
// FDD._Release;
Pointer(FDD) := nil;
end;
ferr (2004-06-16 13:53:00) [3]Вот подобрал пример, который помельче, но с той же ошибкой.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
AppEvnts, ExtCtrls,
DirectDraw, DDUtil;
type
TfrmDD = class(TForm)
ApplicationEvents1: TApplicationEvents;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure ApplicationEvents1Deactivate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ApplicationEvents1Restore(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
FDD : IDirectDraw7;
FDDSBack : IDirectDrawSurface7;
FDDSPrimary : IDirectDrawSurface7;
FDDSBackGround : IDirectDrawSurface7;
FDDSImage : IDirectDrawSurface7;
function RestoreAll : HRESULT;
procedure ErrorOut(hRet : HRESULT; FuncName : String);
public
{ Public declarations }
protected
procedure FormSetCursor(var aMsg : TMessage); message WM_SETCURSOR;
end;
const
ScreenWidth = 640;
ScreenHeight = 480;
ScreenBitDepth = 16;
groundBmp = '..\lake.bmp';
imageBmp = '..\mouse.bmp';
var
frmDD : TfrmDD;
mouseX : Integer = 0;
mouseY : Integer = 0;
implementation
{$R *.DFM}
procedure TfrmDD.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 TfrmDD.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(DD_FALSE, '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(DD_FALSE, 'DDLoadBitmap');
hRet := DDSetColorKey (FDDSImage, RGB(0, 0, 0));
if Failed (hRet) then ErrorOut(hRet, 'DDSetColorKey');
end;
procedure TfrmDD.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 TfrmDD.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 TfrmDD.ApplicationEvents1Deactivate(Sender: TObject);
begin
Application.Minimize;
end;
procedure TfrmDD.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_ESCAPE) or (Key = VK_F12) then Close;
end;
procedure TfrmDD.FormSetCursor(var aMsg : TMessage);
begin
SetCursor(0);
end;
procedure TfrmDD.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 TfrmDD.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 TfrmDD.ApplicationEvents1Restore(Sender: TObject);
begin
WindowState := wsMaximized;
end;
procedure TfrmDD.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Hide
end;
end.
cyborg (2004-06-16 13:37:00) [4]таймеры какие нибудь понавтыкал наверное?
И вообще непонятно чего там у тебя, что ты ждёшь, что тебе скажут, что ошибка в 14-ой строке?
ferr (2004-06-16 13:33:00) [5]Если убрать, то код Destroy весь проскакивает потом программа чего-то ждёт в свёрнутом виде, на щелчки не отзываясь и потом...
ferr [14]
cyborg (2004-06-16 13:11:00) [6]Ребуилд нужно делать, тогда шайтаны убегут сверкая пятками.
КиТаЯц (2004-06-16 13:09:00) [7]Да... У меня вот тоже "затыки" бывают. Ну не идет прога и все тут. Хоть че ремарь - не идет, или ввобще ничего на форме нет (это когда заремариш слишким много). Ну, думаеш, надо успокоится и с другого бока подойти. Покуриш, кофя тяпнеш, садишся за комп... А сам радостный такой - думаеш - ништяк!!! ща все получится! А прога как не шла так и не идет. Тьфу :(
А потом зову колегу, ну, типа, помогай, смотри где ошибка. Он смотрит - нет ошибки, а прога не идет. Прям рычать хочется.
И как думаете с такой ситуацией борюсь? А никак. Сидиш себе, дальше другой юнит колупаеш, и вдруг ловиш себя на мысли, что ошибки-то и нету... Куда делась? Где была? Прям, блин, полтергейс какой-то...
Занятное это дело - программирование...
cyborg (2004-06-16 12:58:00) [8]Ну так покажи где теперь вываливается?
ferr (2004-06-16 12:45:00) [9]Судя по ferr (16.06.04 12:35) [14] я не брезговал второй раз попытаться.
cyborg (2004-06-16 12:38:00) [10]Сомневаюсь я, что так ты пытался, судя по [2] ferr (15.06.04 22:41) ошибка вываливается на релизе, закомментируй его, не будет вываливаться.
ferr (2004-06-16 12:35:00) [11]Так я уже пытался.
Приожение подвисает и Windows заботливо хочет что-то отправить, но мы ему отказываем и тут:
Application Error
Exception EAccessViolation in module Project1.exe at 000059A4.
Access violation at address 004059A4 in module '*.exe'. Read of address 00000008
cyborg (2004-06-16 12:27:00) [12]От тебя требуется:
procedure TfrmDD.FormDestroy(Sender: TObject);
var
i : Integer;
begin
if Assigned(FDD) then begin
if Assigned(FDDPal) then FDDPal := nil;
for i := 0 to NumSprites - 1 do begin
if Assigned(spr [i].FSpriteSurface) then begin
// spr [i].FSpriteSurface._Release;
spr [i].FSpriteSurface := nil;
end;
spr [i].Free;
end;
if Assigned(FDDSPrimary) then begin
// FDDSPrimary._Release;
FDDSPrimary := nil;
end;
// FDD._Release;
FDD := nil;
end;
end;
ferr (2004-06-16 12:08:00) [13]Это от меня требовалось?
cyborg (2004-06-16 12:07:00) [14]
> [9] ferr (16.06.04 12:01)
Что может так?
ferr (2004-06-16 12:03:00) [15]const
NumSprites = 10;
var
spr : Array [0..NumSprites - 1] of TSprite;
ferr (2004-06-16 12:01:00) [16]Может так
TSprite = class
FSpriteSurface : IDirectDrawSurface7;
...
TfrmDD = class(TForm)
...
private
FDD : IDirectDraw7;
FDDSBack : IDirectDrawSurface7;
FDDSPrimary : IDirectDrawSurface7;
FDDPal : IDirectDrawPalette;
...
cyborg (2004-06-16 11:58:00) [17]Это значит впереди поставить //
ferr (2004-06-16 11:52:00) [18]Закомментируй все строчки ._Release;
Там примеры для Дельфи5, а у тебя или шестая или седьмая.
Вы совершенно правы, но я не знаю что значит закомментируй.
cyborg (2004-06-16 09:22:00) [19]Закомментируй все строчки ._Release;
Там примеры для Дельфи5, а у тебя или шестая или седьмая.
Огромное Кулясище (2004-06-16 01:01:00) [20]Нынче совсем сейчас запускал пример (тот, что с Мона Лизой) из под Delphi, после окончания - AV вылетает. Запустил откомпиленое приложение просто из проводника - всё нормально. Дело в отладчике Delphi. Так что подумал...
В твоём случае... э, если ты дейстивтельно не запускал из под Delphi, то либо: конфликт версий Delphi, проблемы с видеокартой, покоцаный DirectX, вмешалось НЛО...
| |
Страницы: 