| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Ускоренный вывод [Delphi, Windows]
Lockdog © (2004-04-29 15:35:00)Пишу игру (2D) на Directdraw, но возникла проблема - у меня было 4 поверхности:
фон(земля), два персонажа (спрайта) и одна переключающаяся (для фона).
Когда я ввёл ещё одну - это рисунок для курсора, то когда я двигаю этим курсором, спрайты останавливаются, то есть тормозят!
Как мне избавится от этого?
Размеры спрайтов: 70х70
Фон: 640х480
Курсор: 32х32
Lockdog (2004-05-01 20:55:00) [1]Огромнейшее спасибо!!!
Всё работает!
Mihey (2004-05-01 20:18:00) [2]В обработке OnMoseMove оставь:
MouseX := X;
MouseY := Y;
а SendMessage(Handle, wm_paint, 0, 0) убери.
Lockdog (2004-05-01 19:22:00) [3]А какой тогда функцией воспользоваться, чтобы передавать координаты курсора в поверхность?
Mihey (2004-05-01 19:09:00) [4]2 Lockdog:
Рендеринг только по таймеру, т.е. из OnMouseMove убрать.
Lockdog (2004-05-01 18:07:00) [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.
miek (2004-04-30 21:06:00) [6]Ворох ошибок!
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-04-30 18:05:00) [7]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.
NikeOLD (2004-04-30 17:41:00) [8]А где и как происходит обработка указателя мыши (получение координат курсора)?
Гони код - разберемся!
miek (2004-04-29 18:43:00) [9]Код рендеринга в студию!
| |
