Графика DirectX в Delphi

// Видеорежим 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; // одно и то же первоначальное значение

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