Графика DirectX в Delphi

Принципиально обработка ввода ничем не отличается от первого примера на основе библиотеки Directlnput. Здесь используется непосредственная схема доступа, только уровень доступа устанавливается в комбинацию

DISCL_FOKEGROUND or DISCL_EXCLUSIVE. Несмотря на негласное соглашение,

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

Работа с мышью

После знакомства с возможностями ввода с клавиатуры нам будет легко научиться работать с мышью, принципы обработки ввода здесь точно такие же. Непосредственную схему доступа изучим на конкретном примере - проекте каталога Ех07. Это еще один вариант создания эффекта лупы, но более эффектный, чем предыдущие, поскольку здесь добавлены сферические искажения пикселов (рис. 5.7).

Представленные ниже константы и переменные связаны с параметрами искажений:

const

Diameter = 180; // Задает максимальный размер лупы

Scale =35; // Вспомогательный коэффициент

var

Radius : Integer = Diameter div 2; // Текущий размер лупы

SqrRad : Integer; // Вспомогательные величины

Sphere : Integer;

Вспомогательные переменные заполняются первоначально при создании формы:

SqrRad := Radius * Radius; // Квадрат радиуса

Sphere := (Radius * Radius) - (Scale * Scale); // Искажение

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

function TfrmDD.UpdateFrame : HRESULT;

var

hRet : HRESULT;

begin

// Блиттинг фона

hRet := FDDSBack.BltFast (0, 0, FDDSBackGround, nil, DDBLTFAST_WAIT);

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

hRet := Zoom; // Вызов функции создания эффекта

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

Result := FlipPages; // Переключение буферов

end;

Эффект построен на простейшей математике - уравнениях круга и сферы:

function TfrmDD.Zoom : HRESULT;

var

descl : TDDSURFACEDESC2;

desc2 : TDDSURFACEDESC2;

X, Y : Integer;

XX,YY,YYXX : Integer;

mz : Single;

hRet : HRESULT;

begin

ZeroMemory (Sdescl, SizeOf(descl) );

descl.dwSize := SizeOf (descl);

ZeroMemory (@desc2, SizeOf(desc2));

desc2.dwSize := SizeOf (desc2);

hRet := FDDSBack.Lock (nil, descl, DDLOCK_WAIT, 0);

if Failed (hRet) then begin

Result := hRet;

Exit ;

end;

hRet := FDDSBackGround.Lock (nil, desc2, DDLOCK_WAIT, 0);

if Failed (hRet) then begin

Result := hRet;

Exit;

end;

for Y := -Radius to Radius do begin

YY := у * Y;

for X := -Radius to Radius do begin

XX := X * X; YYXX := YY + XX;

if YYXX < Sphere then begin // Точка внутри круга

mz := Scale / sqrt(SqrRad - YYXX); // Масштаб по третьей оси

// Пиксел на задней поверхности

PWord (Integer(descl.IpSurfасе) + (Y + mouseY) * descl.IPitch +

(mouseX + x) * 2)^ :=

// Источник на поверхности фона

PWord (Integer(desc2.IpSurfасе) +

trunc (mz * Y + mouseY) * desc2.IPitch +

trunc (mz * X + mouseX) * 2)^;

end;

end ;

end;

FDDSBackGround.Unlock (nil);

FDDSBack.Unlock (nil);

Result := DDJ3K;

end;

Для работы с устройством введены переменные уже знакомых нам типов:

DInput : IDIRECTINPUT8 = nil;

DIMouse : IDIRECTINPUTDEVICE8 = nil;

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

function TfrmDD.OnCreateDevice : HRESULT;

var

hRet : HRESULT;

begin

hRet := DirectlnputBCreate (hlnstance, DIRECTINPUT_VERSION,

IID_IDirectInput8, DInput, nil) ;

// GUID соответствует устройству "мышь"

hRet := DInput.CreateDevice (GUID_SysMouse, DIMouse, nil);

hRet := DIMouse.SetDataFormat(c__dfDIMouse2); // Задаем формат данных

// Уровень кооперации задаем обычный

hRet := DIMouse.SetCooperativeLevel(Handle, DISCLJTONEXCLUSIVE or

DISCL__BACKGROUND) ;

Result := DIMouse.Acquire; // Захватываем устройство

end;

Опрос состояния мыши происходит непрерывно, перед каждым обновлением кадра:

procedure TfrmDD.ApplicationEventslIdle(Sender: TObject;

var Done: Boolean);

begin

if FActive then begin

ReadlmmediateData; // Ошибки игнорируем

if Failed (UpdateFrame) then RestoreAll;

end;

Done := False;

end;

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

function TfrmDD.ReadlmmediateData : HRESULT;

var

hRet : HRESULT;

dims2 : TDIMOUSESTATE2; // Структура хранения вводимых данных

begin

ZeroMemory(@dims2, SizeOf(dims2));

// Получаем сведения о состоянии мыши

hRet := DIMouse.GetDeviceState(SizeOf(TDIMOUSESTATE2), @dims2);

if Failed (hRet) then begin // Связь потеряна

hRet := DIMouse.Acquire; // Устанавливаем связь заново

while hRet = DTERR INPUTLOST do hRet := DIMouse. Acquire;

end;

// Массив rgbButtons хранит состояние дня каждой кнопки мыши

if dims2.rgbButtons[0] = 128 then begin // Нажата левая кнопка

Radius := Radius + 1; // Радиус увеличивается до некоторых пределов

if Radius > Diameter then Radius :=- Diameter;

SqrRad := Radius * Radius;

Sphere := (Radius * Radius) - (Scale * Scale);

end;

if dims2.rgbButtons[1] = 128 then begin // Нажата правая кнопка

Radius := Radius - 1; // Радиус уменьшается

if Radius < 0. then Radius := 0;

SqrRad := Radius * Radius;