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

end;

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

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

// Круг рисуется средствами GDI, вписанным в квадрат

xl : Integer =0; // Левый верхний угол квадрата

yl : Integer = 0;

х2 : Integer =40; // Правый нижний угол квадрата

у2 : Integer = 40;

xDir : Integer =4; // Текущее приращение координаты X

yDir : Integer =4; // Текущее приращение координаты Y

rcScreen : TRECT; // Позиция окна, используется для оконного режима

rcViewport : TRECT; // Область вывода, 640x480

rcWindow : TRECT; // Структура для хранения позиции окна на экране

flgWindowed : BOOL = False; // Текущий режим работы приложения

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

procedure TfrmDD.FormCreate(Sender: TObject);

var

hRet : HRESULT;

begin

// Обнуляем все объекты DirectDraw

FDDClipper := nil; // Объект отсечения будет удаляться дважды,

FDDSBack := nil; // можно этого и не выполнять, но для корректности

FDDSPrimary := nil; // первого вызова FormCreate лучше все-таки сделать

FDD := nil;

//В зависимости от режима задаем стиль рамки и видимость курсора

if flgWindowed then begin

BorderStyle := bsSizeable; // Обычный стиль, с областью заголовка

ShowCursor(True);

end

else begin

BorderStyle := bsNone; // Без рамки и области заголовка

ShowCursor(False);

end;

// Создается главный объект DirectDraw

hRet := DirectDrawCreateEx (nil, FDD, IDirectDraw7, nil);

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

// Инициализация поверхностей

if Failed (InitSurfaces(Handle)) then Close;

FActive := True;

end;

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

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;

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

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