Графика DirectX в Delphi

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

Мне потребовались четыре образа рыбок, один образ всплывающего пузырька воздуха и образ для построения фона (рис. 4.4).

Для загрузки на поверхность образа из компонента класса Timage введена пользовательская функция createFromimage. Рыбки и пузырьки на экране будут иметь случайные размеры, чтобы при использовании цветового ключа не появлялась окантовка. Для корректного масштабирования приходится применять длинную процедуру перекладывания образа на вспомогательные объекты класса TBitMap:

function TfrmDD.CreateFromimage (var FDDS : IDirectDrawSurface7;

const Image : Timage; const imgWidth, imgHeight : Integer) : HRESULT;

var

DC : HDC;

ddsd : TDDSurfaceDesc2;

hRet : HResult;

wrkBitmapl : TBitMap;

wrkBitmap2 : TBitMap;

begin

ZeroMemory (@ddsd, SizeOf(ddsd)); with ddsd do begin

dwSize := SizeOf(ddsd);

dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;

dwWidth := imgWidth;

dwHeight := imgHeight;

ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;

end;

// Создаем поверхность нужных размеров

hRet := FDD.CreateSurfасе(ddsd, FDDS, nil);

if Failed(hRet) then ErrorOut(hRet, 'Create Surface');

// Первое изображение хранит растр,

// переложенный с компонента класса TImage

wrkBitmapl := TBitMap.Create;

wrkBitmapl.Width := Image.Width;

wrkBitmapl.Height := Image.Height;

// Копирование растра, StretchBlt исказит образ

BitBlt(wrkBitmapl.Canvas.Handle, 0, 0, wrkBitmapl.Width,

wrkBitmapl.Height, Image.Canvas.Handle, 0, 0, SRCCOPY);

// Второе изображение используется для корректного масштабирования

wrkBitmap2 := TBitMap.Create;

wrkBitmap2.Width := imgWidth;

wrkBitmap2.Height := imgHeight;

// Перекладываем растр во второй битмап

wrkBitmap2.Canvas.StretchDraw (Rect (0, 0, imgWidth, imgHeight),

wrkBitmapl);

// Воспроизводим масштабированный растр на сформированной поверхности

if FDDS.GetDC(DC) = DD_OK then begin

BitBlt(DC, 0, 0, imgWidth, imgHeight,

wrkBitmap2.Canvas.Handle, 0, 0, SRCCOPY);

FDDS.ReleaseDC(DC);

end;

wrkBitmapl.Free;

wrkBitmap2.Free;

// Задаем ключ, берем цвет первого пиксела

Result := DDSetColorKey (FDDS, Image.Canvas.Pixels [0, 0]);

end;

Класс TFish инкапсулирует свойства и методы наших рыбок:

TFish = class

XFish, YFish :Integer; // Позиция на экране

Direction :0..1; // Направление движения

WidthFish :Integer; // Ширина

HeightFish :Integer; // Высота

FDDSFish :IDirectDrawSurface7; // Поверхность с образом

SpeedFish :Integer; // Скорость движения

procedure Init; // Инициализация

procedure Render; // Воспроизведение

end;

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

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

procedure TFish.Init;

procedure Rotate; // Зеркальный поворот поверхности рыбки

var

desc : TDDSURFACEDESC2; i, j : Integer; wrkW : Word;

begin

ZeroMemory (@desc, SizeOf(desc));

desc.dwSize := SizeOf(desc);

if Failed (FDDSFish.Lock (nil, desc, DDLOCK_WAIT, 0)) then Exit;

for i := 0 to (WidthFish - 1) div 2 do // Цикл по столбцам растра

for j := 0 to HeightFish - 1 do begin // Цикл по строкам растра

wrkW := PWord (Integer (desc.IpSurface) + j * desc.lPitch +

i * 2)^; // Переставляем пикселы растра

PWord (Integer (desc.IpSurface) + j * desc.lPitch + i * 2) ^ :=

PWord (Integer (desc.IpSurface) + j * desc.lPitch +

(WidthFish - I - i) * 2)л; PWord (Integer (desc.IpSurface) + j * desc.lPitch +

(WidthFish - I - i) * 2)л := wrkW;

end;

FDDSFish.Unlock (nil);

end;

begin

case random (4) of // Случайный выбор одного из четырех видов рыбок

0 : begin

WidthFish := random (141) + 24;

HeightFish := WidthFish * 129 div 164; // Сохранение пропорций

if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFishl,

WidthFish, HeightFish))

then frmDD.ErrorOut(DDJTALSE, 'CreateFish');

end;

1 : begin

WidthFish := random (161) + 22; HeightFish := WidthFish * 115 div 182;

if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFish2,

WidthFish, HeightFish))

then frmDD.ErrorOut(DD_FALSE, 'CreateFish');

end;

2 : begin

WidthFish := random (161) +22;

HeightFish := WidthFish * 122 div 182;

if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFish3,

WidthFish, HeightFish))

then f rmDD. ErrorOut (DD__FALSE, 'CreateFish');

end;

3 : begin

WidthFish := random (175) +22; HeightFish := WidthFish * 142 div 182;

if Failed (frmDD.CreateFromlmage (FDDSFish, frmDD.imgFish4,

WidthFish, HeightFish))

then frmDD.ErrorOut(DD_FALSE, 'CreateFish');

end;

end;

Direction := random (2); // Направление движения случайно

SpeedFish := random (6) +1; // Следим, чтобы скорость была ненулевой

if Direction =0 // Плывет слева направо, значит,

// должна появиться слева экрана

then XFish := -WidthFish

else begin

XFish := ScreenWidth; // Должна появиться справа экрана

Rotate;

// Требуется зеркальный поворот картинки