Михаил Краснов - Графика DirectX в Delphi

Я переписал эту функцию. Теперь поворачивается содержимое передаваемого объекта класса TBitmap, и возвращается объект такого же класса:

function TfrmDD.RotateBmp (const BitmapOriginal: TBitmap;

const iRotationAxis, jRotationAxis: Integer;

const AngleOfRotation: Single): TBitmap;

const

MaxPixelCount = 32768;

type

TRGBTripleArray = Array [0..MaxPixelCount-1] of TRGBTriple;

pRGBTripleArray = ATRGBTripleArray;

var

cosTheta Single;

i : Integer;

iOriginal : Integer;

iPrime : Integer;

j Integer;

jOriginal : Integer;

jPrime : Integer;

RowOriginal : pRGBTripleArray;

RowRotated : pRGBTRipieArray;

sinTheta : Single;

begin

Result := TBitmap.Create; // Создание результирующего растра

Result.Width := BitmapOriginal.Widths

Result .Height := BitmapOriginal.Height;

Result.PixelFormat := pf24bit; // Очень важно задать явно режим пиксела

sinTheta := sin (AngleOfRotation);

cosTheta := cos (AngleOfRotation);

// Расчет источника для пикселов повернутого растра

for j := Result.Height - 1 downto 0 do begin

RowRotated := Result.Scanline[j];

jPrime := j - JRotationAxis;

for i := Result.Width-1 downto 0 do begin

iPrime := i - iRotationAxis;

iOriginal := iRotationAxis + round(iPrime * CosTheta - jPrime *

sinTheta);

jOriginal := JRotationAxis + round(iPrime * sinTheta + jPrime *

cosTheta);

if (iOriginal >= 0) and (iOriginal <= BitmapOriginal.Width-1) and

(jOriginal >= 0) and (jOriginal <= BitmapOriginal.Height-1)

then begin

RowOriginal := BitmapOriginal.Scanline[jOriginal];

RowRotated[i] := RowOriginal[iOriginal]

end

else begin // "Новые" пикселы заполняются черным, цветом ключа

RowRotated[i].rgbtBlue := 0;

RowRotated[i].rgbtGreen := 0;

RowRotated[i].rgbtRed := 0

end

end

end;

end;

При перерисовке кадра поворачиваем первоначальное изображение на увеличивающийся угол, копируем полученный растр на вспомогательную поверхность, а затем формируем окончательную картинку:

function TfrmDD.UpdateFrame : HRESULT;

begin

// Повернутый растр копируем на поверхность

FDDSLogo with RotateBmp (wrkBitmap, 128, 128, Angle) do begin

DDCopyBitmap (FDDSLogo, Handle, 0, 0, Width, Height);

Free end;

Angle := Angle - 0.1;

// Наращиваем угол поворота

if Angle > - 2 * Pi then Angle := Angle + 2 * Pi;

// Теоретически возможные ошибки блиттинга игнорируем

// На заднем буфере подготавливаем итоговую картинку

FDDSBack.BltFast(О, О, FDDSImage, nil, DDBLTFAST_WAIT or

DDBLTFAST_SRCCOLORKEY); // Вывод фона, земной шар

FDDSBack.BltFast(О, О, FDDSLogo, nil, DDBLTFAST_WAIT or

DDBLTFAST_SRCCOLORKEY); // На фон накладываем повернутую надпись

// Вывод посередине экрана заставки

Result := FDDSPrimary.BitFast(HalfWidth, HalfHeight, FDDSBack,

nil, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

end;

Перед окончанием работы заставку необходимо убрать с экрана. Обращаю внимание, как это делается: появился обработчик события onclose, в котором собственно окно приложения занимает всю область заставки:

procedure TfrmDD.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Left := HalfWidth;

Top := HalfHeight;

Width := 256;

Height := 256;

end;

Космический истребитель

В этом разделе я представляю свою небольшую заготовку увлекательной игры. Проект располагается в каталоге Ех02. Имитируется полет в космосе космического корабля (рис. 5.1).

С помощью клавиш перемещения курсора можно управлять направлением и скоростью полета истребителя.

Для создания эффекта пространства звезды, на фоне которых располагается корабль, разделены на три группы, различающиеся по яркости и скорости перемещения:

const

NuruStars =10; // Количество звезд в каждой группе

var

StepX : Integer =0; // Базовая скорость движения звезд

StepY : Integer = 1;

type

TCoord = record // Тип описания текущего положения звезды

X, Y : Integer;

end;

var // Массивы звезд

Starsl : Array [0..NumStars - 1] of TCoord;

Stars2 : Array [0..NumStars - 1] of TCoord;

Stars3 : Array [0..NumStars - 1] of TCoord;

В начале координаты звезд задаются, конечно, случайно. При каждом обновлении кадра они циклически движутся по экрану:

function TfrmDD.UpdateFrame : HRESULT;

var

i : Integer;

begin

ThisTickCount := GetTickCount;

if ThisTickCount - LastTickCount > 5 then begin

for i := 0 to NumStars - 1 do begin

// Первая группа звезд, самое медленное движение

Starsl [i].X := (Starsl [i].X + StepX);

if Starsl [i].X > ScreenWidth - 2 then Starsl [i].X := 0 else

if Starsl [i].X < 0 then Starsl [i].X := ScreenWidth - 2;

// Вторая группа звезд движется в два раза быстрее

Stars2 [i].X := (Stars2 [i].X + 2 * StepX);

if Stars2 [i].X > ScreenWidth - 2 then Stars2 [i].X := 0 else

if Stars2 [i].X < 0 then Stars2 [i].X := ScreenWidth - 2;

// Третья группа движется в три раза быстрее

Stars3 [i].X := (Stars3 [i].X + 3 * StepX);

if Stars3 [i].X > ScreenWidth - 2 then Stars3 [i].X := 0 else

if Stars3 [i].X < 0 then Stars3 [i].X := ScreenWidth - 2;

// Аналогично по координате Y

Starsl [i].Y := (Starsl [i].Y + StepY);

if Starsl [i].Y > ScreenHeight - 2 then Starsl [i].Y := 0 else

if Starsl [i].Y < 0 then Starsl [i].Y := ScreenHeight - 2;

Stars2 [i].Y := (Stars2 [i].Y + 2 * StepY);

if Stars2 [i].Y > ScreenHeight - 2 then Stars2 [i].Y := 0 else

if Stars2 [i].Y < 0 then Stars2 [i].Y := ScreenHeight - 2;

Stars3 [i].Y := (Stars3 [i].Y + 3 * StepY);

if Stars3 [i].Y > ScreenHeight - 2 then StarsS [i].Y := 0 else

if Stars3 [i].Y < 0 then Stars3 [i].Y := ScreenHeight - 2;

end;

LastTickCount := GetTickCount;

end;

Clear;

// Очистка заднего буфера

for i := 0 to NumStars - 1 do begin // Цикл рисования звезд

FDDSBack.BltFast (Starsl [i].X, Starsl [i].Y,

FDDSImagel, nil, DDBLTFAST_WAIT);

FDDSBack.BltFast (Stars2 [i].X, Stars2 [i].Y,

FDDSImage2, nil, DDBLTFAST_WAIT);

FDDSBack.BltFast (Stars3 [i].X, Stars3 [i].Y,

FDDSImageS, nil, DDBLTFAST_WAIT);

end;

// Рисование истребителя

Result := FDDSBack.BltFast (150, 140,

FDDSFighter, nil, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

end;

Механизм поворота образа истребителя точно такой же, как в предыдущем примере, и основан на искажении первоначального растра. В данном примере нет необходимости обращаться к функции поворота в каждом кадре. Делается это только при нажатии клавиш:

procedure TfrmDD.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if (Key = VK_ESCAPE) or (Key = VK_F12) then begin Close;

Exit;

end else

if Key = VK_LEFT then StepX := StepX + 1 else

if Key = VKJUGHT then StepX := StepX - I else

if Key = VK_UP then StepY := StepY + 1 else

if Key = VK_DOWN then StepY := StepY - 1;

// Ограничиваем углы поворота некоторыми пределами

if StepY < 1 then StepY := 1 else

if StepY > 3 then StepY := 3;

if StepX < -4 then StepX := -4 else

if StepX > 4 then StepX := 4;

// Копируем на поверхность истребителя новое изображение

with RotateBmp (wrkBitmap, 170, 135, arctan {StepX / StepY)) do begin

DDCopyBitmap (FDDSFighter, Handle, 0, 0, Width, Height);

Free end;

end;

При восстановлении поверхностей надо не просто восстановить содержимое поверхности истребителя, но и повернуть его образ соотвественно текущему положению:

function TfrmDD.RestoreAll : HRESULT;

var

hRet : HRESULT;

begin

hRet := FDDSPrimary._Restore;

if Succeeded (hRet) then begin

hRet := FDDSFighter._Restore;

if Failed (hRet) then begin

Result := hRet; Exit;

end;

// Поворот образа истребителя на текущий угол

with RotateBmp (wrkBitmap, 170, 135, arctan (StepX / StepY)) do begin

hRet := DDCopyBitmap (FDDSFighter, Handle, 0, 0, Width, Height);

Free end;

if Failed (hRet)

then ErrorOut(hRet, 'DDCopyBitmap');

hRet := FDDSImage3._Restore;

if Failed (hRet) then begin Result := hRet;

Exit;

end;

hRet := DDReLoadBitmap(FDDSImage3, starBmpS);

if Failed (hRet) then ErrorOut(hRet, 'DDReLoadBitmap');

hRet := FDDSImage2._Restore;

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

hRet := DDReLoadBitmap(FDDSImage2, starBmp2);

if Failed (hRet) then ErrorOut(hRet, 'DDReLoadBitmap');

hRet := FDDSImagel._Restore;

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

hRet := DDReLoadBitmap(FDDSImage1, starBmpl);

if Failed (hRet)

then ErrorOut(hRet, 'DDReLoadBitmap');

Result := DD_OK

end else Result := hRet;

end;

Ну что же, дорогой читатель, если вы истомились в ожидании "настоящих" примеров, то сейчас настало самое время встряхнуться и превратить этот пример в полноценную игру. Вам осталось добавить извергающиеся лучи мощного лазерного оружия, накатывающиеся астероиды и злобного и многочисленного противника. Сделайте все это, но не сейчас: прочтите до конца хотя бы эту главу.