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

Вниз

Ускоренный вывод   Найти похожие ветки 

← →
Lockdog ©   (2004-04-29 15:35) [0]

Пишу игру (2D) на Directdraw, но возникла проблема - у меня было 4 поверхности:
фон(земля), два персонажа (спрайта) и одна переключающаяся (для фона).
Когда я ввёл ещё одну - это рисунок для курсора, то когда я двигаю этим курсором, спрайты останавливаются, то есть тормозят!
Как мне избавится от этого?
Размеры спрайтов: 70х70
Фон: 640х480
Курсор: 32х32

---

← →
miek ©   (2004-04-29 18:43) [1]

Код рендеринга в студию!

---

← →
NikeOLD   (2004-04-30 17:41) [2]

А где и как происходит обработка указателя мыши (получение координат курсора)?

Гони код - разберемся!

---

← →
Lockdog ©   (2004-04-30 18:05) [3]

unit main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, DirectDraw, DDUtil, AppEvnts, BASS, ExtCtrls;

type
 TForm1 = class(TForm)
   ApplicationEvents1: TApplicationEvents;
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure FormPaint(Sender: TObject);
   procedure FormKeyDown(Sender: TObject; var Key: Word;
     Shift: TShiftState);
   procedure ApplicationEvents1Restore(Sender: TObject);

   procedure PlayStrem(Name: string);
   procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
 private
  result: HStream;
  f: PChar;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

 FDirectDraw: IDirectDraw7;
 FPrimarySurface: IDirectDrawSurface7;
 FImageSurface: IDirectDrawSurface7;
 FBackgroundSurface: IDirectDrawSurface7;
 FBotSurface: IDirectDrawSurface7;
 FMeatmanSurface: IDirectDrawSurface7;
 FCursorSurface: IDirectDrawSurface7;
 SurfaceDesc: TDDSurfaceDesc2;
 HRet: HResult;
 DC: HDC;
 bltfx: TDDBltFx;
 fcaps: TDDSCaps2;
 srcrect: TRect;
 meatmanrect: TRect;
 X, Y, State, LastXState, incparam: Integer;
 msg: TMsg;
 MouseX, MouseY: Integer;

implementation

{$R *.dfm}

procedure TForm1.PlayStrem(Name: string);
begin
f := PChar(Name);
result:= BASS_StreamCreateFile(FALSE, f, 0, 0, BASS_MP3_SETPOS);
if result<>0 then BASS_StreamPlay(result, FALSE, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
incparam := 1;
X := 0;
LastXState := 0;
Y := random(400);

MouseX := 0;
MouseY := 0;

{---Инициализация звука---}
if BASS_GetVersion() <> MAKELONG(1,8) then begin
   ShowMessage("BASS 1.8 не загружен!");
   Halt;
 end;
if not BASS_Init(-1, 44100, 0, handle) then
  ShowMessage("Не могу инициализировать звук!");

BASS_Start;
{----------}

{---Инициализация DirectX 7.0---}
HRet := DirectDrawCreateEx(nil, FDirectDraw, IDirectDraw7, nil);
if HRet <> DD_OK then
begin
 ShowMessage("Установите DirectX 7.0 или выше!");
 Halt;
end;
{----------}
FDirectDraw.SetCooperativeLevel(Handle, DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE);
FDirectDraw.SetDisplayMode(800, 600, 16, 0, 0);

FillChar(SurfaceDesc, SizeOf(SurfaceDesc), 0);
SurfaceDesc.dwSize := SizeOf(SurfaceDesc);
SurfaceDesc.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
SurfaceDesc.dwBackBufferCount := 1;//Кол-во вторичных экранов
SurfaceDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or
DDSCAPS_FLIP or DDSCAPS_COMPLEX;

FDirectDraw.CreateSurface(SurfaceDesc, FPrimarySurface, nil);

FillChar(fcaps, SizeOf(fcaps), 0);
fcaps.dwcaps := DDSCAPS_BACKBUFFER;
FPrimarySurface.GetAttachedSurface(fcaps, FBackgroundSurface);;

FImageSurface := nil;
FImageSurface := DDLoadBitmap(FDirectDraw, "background.bmp", 800, 600);

FBotSurface := nil;
FBotSurface := DDLoadBitmap(FDirectDraw,
"images\bots\MonkeyBot\monkeybot.bmp", 0, 0);
DDSetColorKey(FBotSurface, RGB(0,0,0));

FMeatmanSurface := nil;
FMeatmanSurface := DDLoadBitmap(FDirectDraw,
"images\meatman\meatman.bmp", 0, 0);
DDSetColorKey(FMeatmanSurface, RGB(0,0,0));

FCursorSurface := nil;
FCursorSurface := DDLoadBitmap(FDirectDraw,
"cursor01.bmp", 0, 0);
DDSetColorKey(FCursorSurface, RGB(0,0,0));
ShowCursor(False);

PlayStrem("sounds\play.mp3");

while true do
begin
 if PeekMessage(msg, 0,0,0, pm_remove)= false then
  begin
   X := X+1;
     if X = 730 then
      begin
       X := X+(-1);
      end;
    if X-LastXState>10 then
     begin
      State := State+incparam;
       if State=10 then
        incparam := -1;
       if State=0 then
        incparam := 1;
        LastXState := X;
      end;
     SendMessage(Handle, wm_paint, 0, 0);
  end
 else
  begin
   translatemessage(msg);
   dispatchmessage(msg);
  end;
 end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
BASS_Stop;
BASS_StreamFree(result);
BASS_Free();

FBotSurface := nil;
FImageSurface := nil;
FBackgroundSurface := nil;
FPrimarySurface := nil;
FDirectDraw := nil;
ShowCursor(True);
Halt;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
ZeroMemory(@bltfx, SizeOf(BltFx));
BltFx.dwSize := SizeOf(BltFx);
BltFx.dwFillColor := 0;
FPrimarySurface.Blt(nil, nil, nil, DDBLT_COLORFILL or
 DDBLT_WAIT, @BltFx);

FBackgroundSurface.BltFast(0, 0, FImageSurface, nil, DDBLTFAST_WAIT);
FPrimarySurface.Flip(nil, DDFLIP_WAIT);

srcrect := Rect(0,0,70,70);
srcrect.Left := 0;
srcrect.Top := State*70;
srcrect.Right := 70;
srcrect.Bottom := State*70+70;
FPrimarySurface.BltFast(X, 10, FBotSurface, @srcrect,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

meatmanrect := Rect(0,0,70,70);
meatmanrect.Left := 0;
meatmanrect.Top := State*70;
meatmanrect.Right := 70;
meatmanrect.Bottom := State*70+70;
FPrimarySurface.BltFast(X, 530, FMeatManSurface, @meatmanrect,
 DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

FPrimarySurface.BltFast(MouseX, MouseY, FCursorSurface,
 nil, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
case chr(ord(Key)) of
 "W","Ц": Application.Terminate;
 "S","Ы": Application.Terminate;
 "D","А": Application.Terminate;
 "A","Ф": Application.Terminate;
end;

end;

procedure TForm1.ApplicationEvents1Restore(Sender: TObject);
begin
if HRet = DDERR_SURFACELOST then
 FPrimarySurface._Restore;
 FBackgroundSurface._Restore;
 FBotSurface._Restore;
 FMeatManSurface._Restore;
 FCursorSurface._Restore;
 FPrimarySurface.Blt(nil,nil,nil, DDBLT_COLORFILL or DDBLT_WAIT, @bltfx);
 FBackgroundSurface := DDLoadBitmap(FDirectDraw, "background.bmp", 0, 0);

 FBotSurface := DDLoadBitmap(FDirectDraw,
  "images\bots\MonkeyBot\monkeybot.bmp", 0, 0);
 DDSetColorKey(FBotSurface, RGB(0,0,0));

 FMeatManSurface := DDLoadBitmap(FDirectDraw,
  "images\meatman\meatman.bmp", 0, 0);
 DDSetColorKey(FMeatmanSurface, RGB(0,0,0));

 FCursorSurface := DDLoadBitmap(FDirectDraw,
  "cursor.bmp", 0, 0);
 DDSetColorKey(FCursorSurface, RGB(0,0,0));
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
MouseX := X;
MouseY := Y;
FormPaint(nil);
end;

end.

---

← →
miek ©   (2004-04-30 21:06) [4]

Ворох ошибок!
1) Во-первых, для хранения спрайтов грамотнее использовать ОДНУ внеэкранную поверхность - зачем целых три? Просто выводить будешь не всю ее, а регион с нужным спрайтом.
2) Во-вторых, если уж используешь двойную буферизацию и переключение страниц, то рисуй на ВТОРИЧНОЙ поверхности, а не на первичной.
3) Ну и отрисовка по событию от мыши или по счетчику п цикле обработки событий - это верх непонимания. Рендеринг (FormPaint) вызывай по таймеру. На худой конец - сойдет и обычный, дельфийский.

По мелочи:
meatmanrect := Rect(0,0,70,70);
meatmanrect.Left := 0;
meatmanrect.Top := State*70;
meatmanrect.Right := 70;
meatmanrect.Bottom := State*70+70;
Интересно, а первая строчка здесь зачем?

---

← →
Lockdog ©   (2004-05-01 18:07) [5]

Ниже приведён код с исправленными ошибками, на которые вы мне указали, но всёравно игра жутко тормозит (как и прежде). Посоветуйте ещё что-нибудь.

Исправленный код:

unit main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, DirectDraw, DDUtil, AppEvnts, BASS, ExtCtrls;

type
 TForm1 = class(TForm)
   ApplicationEvents1: TApplicationEvents;
   Timer1: TTimer;
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure FormPaint(Sender: TObject);
   procedure ApplicationEvents1Restore(Sender: TObject);
   procedure PlayStrem(Name: string);
   procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
   procedure Timer1Timer(Sender: TObject);
 private
  result: HStream;
  f: PChar;
  FDirectDraw: IDirectDraw7;
  FPrimarySurface: IDirectDrawSurface7;
  FBackgroundSurface: IDirectDrawSurface7;
  FSecondSurface: IDirectDrawSurface7;
  FSpriteSurface: IDirectDrawSurface7;
  SurfaceDesc: TDDSurfaceDesc2;
  HRet: HResult;
  fcaps: TDDSCaps2;
  srcrect: TRect;
  meatmanrect: TRect;
  currect: TRect;
  X, Y, State, LastXState, incparam: Integer;
  msg: TMsg;
  MouseX, MouseY: Integer;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.PlayStrem(Name: string);
begin
f := PChar(Name);
result:= BASS_StreamCreateFile(FALSE, f, 0, 0, BASS_MP3_SETPOS);
if result<>0 then BASS_StreamPlay(result, FALSE, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
incparam := 1;
X := 0;
LastXState := 0;
Y := random(400);

MouseX := 0;
MouseY := 0;

{---Инициализация звука---}
if BASS_GetVersion() <> MAKELONG(1,8) then begin
   ShowMessage("BASS 1.8 не загружен!");
   Halt;
 end;
if not BASS_Init(-1, 44100, 0, handle) then
  ShowMessage("Не могу инициализировать звук!");

BASS_Start;
{----------}

{---Инициализация DirectX 7.0---}
HRet := DirectDrawCreateEx(nil, FDirectDraw, IDirectDraw7, nil);
if HRet <> DD_OK then
begin
 ShowMessage("Установите DirectX 7.0 или выше!");
 Halt;
end;
{----------}
FDirectDraw.SetCooperativeLevel(Handle, DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE);
FDirectDraw.SetDisplayMode(800, 600, 16, 0, 0);

FillChar(SurfaceDesc, SizeOf(SurfaceDesc), 0);
SurfaceDesc.dwSize := SizeOf(SurfaceDesc);
SurfaceDesc.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
SurfaceDesc.dwBackBufferCount := 1;//Кол-во вторичных экранов
SurfaceDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or
DDSCAPS_FLIP or DDSCAPS_COMPLEX;

FDirectDraw.CreateSurface(SurfaceDesc, FPrimarySurface, nil);

FillChar(fcaps, SizeOf(fcaps), 0);
fcaps.dwcaps := DDSCAPS_BACKBUFFER;
FPrimarySurface.GetAttachedSurface(fcaps, FSecondSurface);;

FBackgroundSurface := nil;
FBackgroundSurface := DDLoadBitmap(FDirectDraw, "1.bmp",
800, 600);

FSpriteSurface := nil;
FSpriteSurface := DDLoadBitmap(FDirectDraw,
"sprite.bmp", 0, 0);
DDSetColorKey(FSpriteSurface, RGB(0,0,0));

ShowCursor(False);

PlayStrem("sounds\play.mp3");
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
BASS_Stop;
BASS_StreamFree(result);
BASS_Free();

FSpriteSurface := nil;
FSecondSurface := nil;
FPrimarySurface := nil;
FDirectDraw := nil;
ShowCursor(True);
Halt;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
FSecondSurface.BltFast(0, 0, FBackgroundSurface, nil, DDBLTFAST_WAIT);

srcrect.Left := 0;
srcrect.Top := State*70;
srcrect.Right := 70;
srcrect.Bottom := State*70+70;
FSecondSurface.BltFast(X, 10, FSpriteSurface, @srcrect,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

meatmanrect.Left := 0;
meatmanrect.Top := 770;
meatmanrect.Right := 70;
meatmanrect.Bottom := 770+70;
FSecondSurface.BltFast(X, 530, FSpriteSurface, @meatmanrect,
 DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

currect.Left := 0;
currect.Right := 70;
currect.Top := 2030;
currect.Bottom := 2100;
FSecondSurface.BltFast(MouseX, MouseY, FSpriteSurface,
 @currect, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

FPrimarySurface.Flip(nil, DDFLIP_WAIT);
end;

procedure TForm1.ApplicationEvents1Restore(Sender: TObject);
begin
if HRet = DDERR_SURFACELOST then
 FPrimarySurface._Restore;
 FSecondSurface._Restore;
 FBackgroundSurface._Restore;
 FSpriteSurface._Restore;
 FBackgroundSurface := DDLoadBitmap(FDirectDraw, "1.bmp", 800, 600);

 FSpriteSurface := DDLoadBitmap(FDirectDraw,
  "sprite.bmp", 0, 0);
 DDSetColorKey(FSpriteSurface, RGB(0,0,0));
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
MouseX := X;
MouseY := Y;
SendMessage(Handle, wm_paint, 0, 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
X := X+1;
  if X-LastXState>10 then
   begin
    State := State+incparam;
     if State=10 then
      incparam := -1;
     if State=0 then
      incparam := 1;
     LastXState := X;
   end;
 SendMessage(Handle, wm_paint, 0, 0);
end;

end.

---

← →
Mihey ©   (2004-05-01 19:09) [6]

2 Lockdog:

Рендеринг только по таймеру, т.е. из OnMouseMove убрать.

---

← →
Lockdog ©   (2004-05-01 19:22) [7]

А какой тогда функцией воспользоваться, чтобы передавать координаты курсора в поверхность?

---

← →
Mihey ©   (2004-05-01 20:18) [8]

В обработке OnMoseMove оставь:

MouseX := X;
MouseY := Y;

а SendMessage(Handle, wm_paint, 0, 0) убери.

---

← →
Lockdog ©   (2004-05-01 20:55) [9]

Огромнейшее спасибо!!!
Всё работает!

---

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

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

Наверх

Память: 0.51 MB
Время: 0.049 c