Графика DirectX в Delphi
Шрифт:
ZeroMemory(Sddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH or
DDSD_PIXELFORMAT;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
dwHeight := bitmap.Height;
dwWidth := bitmap.width;
ddpfPixelFormat := PixelFormat; // Явно задаем 8-битный формат end;
hRet := FDD.CreateSurface(ddsd, FSpriteSurface, nil);
if Failed(hRet) then frmDD.ErrorOut(hRet, 'CreateSpriteSurface1);
// Воспроизведение картинки
if FSpriteSurface.GetDC(DC) = DD__OK then begin
BitBlt(DC, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle,
0, 0, SRCCOPY);
FSpriteSurface.ReleaseDC(DC);
end;
// Цветовой ключ для всех спрайтов - белый
hRet := DDSetColorKey (FSpriteSurface, RGB(255, 255, 255));
if Failed (hRet) then frmDD.ErrorOut(hRet, 'DDSetColorKey1);
SpriteWidth := Bitmap.Width; // Задаем размеры спрайта
SpriteHeight := Bitmap.Height; Bitmap.Free;
// Устанавливаем одну палитру для всех образов
hRet := FSpriteSurface.SetPalette(frmDD.FDDPal);
if Failed (hRet) then frmDD.ErrorOut(hRet, 'SetPalette');
Collide := False; // Явно инициализируем значение свойства
PosX := random (500); // Координаты задаются случайно
PosY := random (300);
CalcVector; . // Определяемся с направлением движения
end;
Инициализация направления движения вызывается только при создании спрайта, но намеренно вынесена в отдельный метод, чтобы добиться того, чтобы ни один из спрайтов не имел нулевой скорости по какой-либо оси:
procedure TSprite.CalcVector;
begin
Xinc := random (7) - 3; // Случайные значения в интервале [-3; 3]
Yinc := random (7) - 3;
if (Xinc =0) or (Yinc = 0) then CalcVector; // Повторяем генерацию
end;
Методы спрайта с префиксом "Get" предназначены для получения информации о спрайте:
function TSprite.GetCenterX : Integer; // Координаты центра
begin
Result := PosX + SpriteWidth div 2;
end;
function TSprite.GetCenterY : Integer;
begin
Result := PosY + SpriteHeight div 2;
end;
function TSprite.GetRect : TRect; // Ограничивающий прямоугольник begin
SetRect (Result, PosX, PosY, PosX + SpriteWidth, PosY + SpriteHeight);
end;
В момент столкновения спрайта фиксируем текущую позицию, а в случае одновременного столкновения с несколькими спрайтами выполняем операцию один раз:
procedure TSprite.Hit(const S : TSprite);
begin
if not Collide then begin // На случай одновременного столкновения
Collidelnfo.X := S.GetCenterX;
Collidelnfo.Y := S.GetCenterY;
Collide := True;
end;
end;
При
procedure TSprite.Update;
var
CenterX : Integer;
CenterY : Integer;
XVect : Integer;
YVect : Integer;
begin
if Collide then begin // Столкновение
CenterX := GetCenterX; // Текущее положение
CenterY := GetCenterY;
XVect := Collidelnfo.X - CenterX; // Вектор из центра в точк
YVect := Collidelnfo.Y - CenterY; // Столкновения
// Для предотвращения залипания столкнувшихся спрайтов
if ((Xinc > 0) and (Xvect > 0)) or ((Xinc < 0) and (XVect < 0))
then Xinc := -Xinc;
if ((Yinc > 0) and (YVect > 0) or (Yinc<0) and (YVect < 0))
then Yinc := -Yinc;
Collide := False;
end;
// Собственно обновление позиции
PosX := PosX + Xinc; PosY := PosY + Yinc;
// Столкновение со стенками
if PosX > ScreenWidth - SpriteWidth then begin
Xinc := -Xinc;
PosX := ScreenWidth - SpriteWidth;
end else
if PosX < 0 then begin
Xinc := -Xinc;
PosX := 0;
end;
if PosY > ScreenHeight - SpriteHeight then begin
Yinc := -Yinc;
PosY := ScreenHeight - SpriteHeight;
end else
if PosY < 0 then begin
Yinc := -Yinc; PosY := 0;
end;
end;
Функция воспроизведения лаконична:
function TSprite. Show (const FDDSBack : IDirectDrawSurface7) : HRESULT;
begin
Result := FDDSBack.BltFast (PosX, PosY, FSpriteSurface, nil,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
end;
Перерисовка кадра осуществляется с небольшим интервалом, поэтому переключение буферов переместилось в этот код, иначе появится мерцание картинки:
function TfrmDD.UpdateFrame : HRESULT;
var
i : Integer; si, s2 : Integer;
hRet : HRESULT;
begin
ThisTickCount := GetTickCount;
if ThisTickCount - LastTickCount > 10 then begin // Время подошло
hRet := Clear (255, 255, 255); // Стираем фон белым цветом
if Failed (hRet) then begin
Result := hRet;
Exit ;
end;
for i := 0 to NumSprites - 1 do begin // Цикл по спрайтам
spr [i].Update; // Определить новую позицию