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

function TfrmDD.InitSurfaces(Window : THandle) : HRESULT;

var

hRet : HRESULT;

ddsd : TDDSURFACEDESC2;

ddscaps : TDDSCAPS2;

p : TPoint;

begin

if flgWindowed then begin // Оконный режим

// Получить обычный доступ

hRet := FDD.SetCooperativeLevel(Window, DDSCL_NORMAL);

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

ErrorOut(hRet, 'SetCooperativeLevel');

Exit;

end;

// Получаем размеры области вывода и границы экрана

Windows.GetClientRect(Window, rcViewport);

Windows.GetClientRect(Window, rcScreen);

// Находим позицию клиентской области окна на экране

р.Х := rcScreen.Left;

p.Y := rcScreen.Top;

Windows.ClientToScreen(Window, p);

OffsetRect(rcScreen, p.X, p.Y);

// Создаем первичную поверхность

ZeroMemory(@ddsd, SizeOf(ddsd));

with ddsd do begin

dwSize := SizeOf(ddsd);

dwFlags := DDSD_CAPS;

ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;

end;

hRet := FDD.CreateSurface(ddsd, FDDSPrimary, nil);

if Failed(hRet) then ErrorOut(hRet, 'CreateSurface FAILED');

// Для оконного приложения создаем объект отсечения

hRet := FDD.CreateClipper(0, FDDClipper, nil);

if Failed(hRet) then ErrorOut(hRet, 'CreateClipper FAILED');

// Ассоциируем отсечение с окном приложения

FDDClipper.SetHWnd(0, Window);

FDDSPrimary.SetClipper(FDDClipper) ;

FDDClipper := nil;

// Создаем поверхность заднего буфера, непосредственного вывода with ddsd do begin

dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS;

dwWidth := 640;

dwHeight := 480;

ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;

end;

hRet := FDD.CreateSurface(ddsd, FDDSBack, nil);

if Failed(hRet) then ErrorOut(hRet, 'CreateSurface2 FAILED');

end

else begin // Полноэкранный режим

// Задаем режим исключительного доступа

hRet := FDD.SetCooperativeLevel(Window, DDSCL_EXCLUSIVE or

DDSCL_FULLSCREEN);

if Failed(hRet) then ErrorOut(hRet, 'SetCooperativeLevel FAILED')

// Видеорежим 640x480x8

hRet := FDD.SetDisplayMode(640, 480, 8, 0, 0) ;

if Failed(hRet) then ErrorOut(hRet, 'SetDisplayMode FAILED');

// Размер области вывода и границ окна, одинаковые значения

SetRect(rcViewport, О, О, 640, 480);

CopyMemory (OrcScreen, @rcViewport, SizeOf(TRECT));

// Создаем первичную поверхность с одним задним буфером

ZeroMemory(@ddsd, SizeOf(ddsd));

with ddsd do begin

dwSize := SizeOf(ddsd);

dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;

ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or

DDSCAPS_COMPLEX;

dwBackBufferCount := 1;

end;

hRet := FDD.CreateSurface(ddsd, FDDSPrimary, nil);

if Failed(hRet) then ErrorOut(hRet, 'CreateSurface FAILED');

ZeroMemory(@ddscaps, SizeOf(ddscaps));

ddscaps.dwCaps := DDSCAPS_BACKBUFFER;

hRet : = FDDSPrimary.GetAttachedSurface(ddscaps, FDDSBack);

if Failed(hRet) then ErrorOut(hRet, 'GetAttachedSurface FAILED');

end;

Result := DD_OK;

end;

Как я уже говорил, код, связанный с созданием объектов, вызывается при каждом переключении режима:

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

Shift: TShiftState);

begin

if (Key = VK_RETURN) and (ssAlt in Shift) then begin // Переключение

FActive := False; // На время переключения запрещаем перерисовку

flgWindowed := not flgWindowed; // Меняем значение флага

FormCreate(nil); // Удаляем и заново восстанавливаем объекты end else

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

end;

При перерисовке окна отображаем и перемещаем круг, а затем выводим текст подсказки:

function TfrmDD.UpdateFrame : BOOL;

var

ddbltfx : TDDBLTFX; // Для очистки фона

DC : HOC; // Ссылка на контекст, нужна для функций GDI

hOldBrush : HBrush; // Объект фона hOldPen : HPen; // Объект карандаша

begin

// Очистка окна

ZeroMemory(@ddbltfx, SizeOf(ddbltfx));

ddbltfx.dwSize := SizeOf(ddbltfx);

ddbltfx.dwFillColor := 0;

FDDSBack.Bit(nil, nil, nil, DDBLT^COLORFILL or DDBLT_WAIT, @ddbltfx);

// Получение контекста

if FDDSBack.GetDC(DC) = DD_OK then begin

// Вывод закрашенного круга

SetBkColor(DC, RGB(0, 0, 255)); // Синий фон для текста

SetTextColor(DC, RGB(255, 255, 0)); // Желтый цвет букв

// Круг закрашивается серым

hOldBrush := SelectObject(DC, GetStockObject(LTGRAY BRUSH));

// Сам круг - белый

hOldPen := SelectObject(DC, GetStockObject(WHITE_PEN));

Ellipse(DC, xl, yl, x2, y2); // Рисуем круг

SelectObject(DC, hOldPen); o // Восстанавливаем предыдущие

SelectObject(DC, hOldBrush); // параметры рисования

// Перемещение круга на экране, учитываем границы экрана

xl := xl + xDir;

х2 := х2 + xDir;

if xl < 0 then begin

xl := 0;

x2 := 40;

xDir := -xDir; // Меняется направление движения, круг отскакивает end; if x2 >= 640 then begin

xl := 640 - 1 - 40;

x2 := 640 - 1;

xDir := -xDir;

end;

yl := yl + yDir; y2 := y2 + yDir; if yl < 0 then begin

yl := 0;

y2 := 40;

yDir := -yDir; end; if y2 >= 480 then begin

yl := 480 - 1 - 40;

y2 := 480 - 1;

yDir := -yDir;

end;

// Вывод подсказки

TextOut(DC, 0, 0, 'Press Escape to quit', 20);

if flgWindowed

then TextOut(DC, 0, 20,

'Press Alt-Enter to switch to Full-Screen mode', 45)

else TextOut(DC, 0, 20,

'Press Alt-Enter to switch to Windowed mode', 42);

FDDSBack.ReleaseDC(DC);

Result := True;

end

else Result := False; // Поверхность потеряна

end;

В обработчике состояния ожидания сообщений переключаем буферы:

if FActive then begin

if UpdateFrame then while TRUE do begin

// Оконный режим, переключаем самостоятельно

if flgWindowed

then hRet := FDDSPrimary.Blt(@rcScreen, FDDSBack,

@rcViewport, DDBLT_WAIT, nil)

else

// Полноэкранный режим, используем метод Flip

hRet := FDDSPrimary.Flip(nil, 0) ;

if hRet = DD_OK then Break; if hRet = DDERR_SURFACELOST then begin

hRet := FDDSPrimary._Restore;

if Failed(hRet) then Break;

end;

if hRet о DDERR_WASSTILLDRAWING then Break;

end

else

// Воспроизведение не получилось, восстанавливаем поверхность

FDDSPrimary._Restore; // Для простоты не используем зацикливание

end;

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

Проект, располагающийся в каталоге ЕхЗО, является переделанным примером оконного приложения с пользовательским курсором в виде руки. Теперь приложение является комбинированным, запускается в оконном режиме.

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

flgWindowed : BOOL = True; // Для обоих флагов необходимо задавать

First : BOOL = True; // одно и то же первоначальное значение

При первой деактивизации полноэкранного приложения окно не минимизируем:

procedure TfrmDD.ApplicationEventslDeactivate(Sender: TObject);

begin

if flgWindowed

then begin

GetWindowRect(Handle, rcWindow); // Запомнили позицию окна

if First then First := False; // Прошла первая минимизация

end

else begin

if First

then First := False // Пропускаем первую деактивизацию

else Application.Minimize;

end;

end;

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

* поверхность заднего буфера для оконного приложения должна создаваться не в процедуре инициализации, а в обработчике OnResize окна, когда известны новые размеры окна; чтобы при изменении положения окна в оконном режиме его поверхность не покрывалась серыми пятнами, добавлена ловушка сообщения WM_MOVE, в котором определяю новую позицию окна и перерисовываю его; обработчики многих событий заканчиваются вызовом процедуры перерисовки окна UpdateFrame.

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

Осциллограф

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

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

Начнем с проекта каталога Ех31, в нем отдельные точки синусоиды ставятся с использованием метода Bit поверхности, подобно одному из примеров на построение окружностей. Ничего особо нового нет, за исключением того, что для точного задания цвета точки используется пользовательская функция CreateRGB, осуществляющая перевод тройки цветов в значение, соответствующее схеме 5-6-5.

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

Итак, смотрим внимательно пример. Режим 640x480x8, для работы с пикселами поверхности заведен массив буфера кадра вспомогательной поверхности:

FrameBuffer : Array [0..99, 0..99] of Byte;

Поверхность, как видим, будет размером 100x100 пикселов, внимательно посмотрите, как она создается. Сами задаем значение ipitch и адрес содержимого буфера кадра:

ZeroMemory(@ddsd, SizeOf(ddsd));

with ddsd do begin

dwSize := SizeOf(ddsd);

dwFlags := DDSDJtflDTH or DDSD_HEIGHT or DDSD_LPSURFACE or DDSD_CAPS or

DDSD^PITCH; // Новые флаги!

// Поверхность создается в СИСТЕМНОЙ памяти

ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN or DDSCAPS_SYSTEMMEMORY;

dwWidth := 100;

dwHeight := 100;

IpSurface := @E'rameBuf fer; // Адрес поверхности равен адресу массива

IPitch := Longlnt(100); // Адрес поверхности равен ширине массива

end;

hRet := FDD.CreateSurface(ddsd, FDDSWork, nil);

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