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)); // Желтый цвет букв

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