Графика DirectX в Delphi

chRect.Bottom := chRect.Top + 15;

// Вывод буквы на вспомогательную поверхность

FDDSWork.BltFast(PosX, 0, FDDSFont, @chRect, DDBLTFAST_DONOTWAIT);

end;

begin

ThisTickCount := GetTickCount;

Done := False;

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

if (ThisTickCount - LastTickCount) < Delay then

Exit;

// Ограничивающий прямоугольник

SetRect (rcRect, PosX, PosY, PosX + length (OutLiteral) * 15, PosY + 15);

// Запоминаем, что на экране находится в этом прямоугольнике

FDDSGround.BltFast(PosX, PosY, FDDSPrimary, SrcRect, DD3LTFAST_WAIT);

// Вывод строки

FDDSPrimary.BltFast(PosX, PosY, FDDSWork, @tmpRect, DDBLTFAST WAIT);

// Запоминаем текущее положение строки

X := PosX;

Y := PosY;

OutLiteral := StrList [random (NumbLines)]; // Генерация новой строки

GeneratePos; // Генерируем позицию на экране новой строки

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

for i := 1 to length (OutLiteral) do

OutChar (OutLiteral [i], (i - 1) * 15);

SetRect (tmpRect, 0, 0, length (OutLiteral) * 15, 15);

// Стираем старую фразу на экране

FDDSPrimary.BltFast(X, Y, FDDSGround, SrcRect, DDBLTFAST_WAIT);

LastTickCount := GetTickCount;

end;

Итак, фраза на экране присутствует, пока выполняется код подготовки новой строки. Это очень малый промежуток времени. Конечно, некоторые строки будут потеряны, появившись и исчезнув быстрее, чем произошло обновление экрана. Для замедления процесса можно вставить вызов системной функции sleep с небольшой задержкой, но для небыстрых компьютеров это может привести к тому, что строки начнут неприятно мерцать по всему экрану.

Создание консоли

Консоль вы часто видели и использовали в профессиональных играх и, наверняка, захотите создать и в своей игре. Пример данного раздела - проект каталога Ех09 - поможет вам в этом. Он является развитием нашей пробной игры: теперь по нажатии клавиши <Таb> на экране появляется консоль, предназначенная для ввода команд (рис. 5.9).

Рис. 5.9. Наша игра обзавелась консолью

Я предусмотрел реакцию только на одну команду, после ввода Exit приложение завершает работу, все остальные вводимые строки просто вызывают эхо в консоли.

Моя консоль вмещает три строки, инициализируемые многозначительными фразами:

rcRectConsole : TRECT; // Вспомогательный прямоугольник

ConsoleHeight : Integer =0; // Текущий размер консоли

ConsoleLive : BOOL = False; // Флаг, связанный с присутствием

TextConsolel : String = '> Initialization....OK'; // Строки вывода

TextConsole2 : String = '> Loading .......OK';

TextConsole3 : String = '>_';

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

ZeroMemory(@ddsd, SizeOf(ddsd));

with ddsd do begin

dwSize := SizeOf(ddsd);

dwFlags := DDSD__CAPS or DDSD_HEIGHT or DDSD_WIDTH;

ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;

dwWidth := 640;

dwHeight := 100;

end;

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

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

hRet := FDDSConsole.SetPalette(FDDPal) ;

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

ZeroMemory(gddbltfx, SizeOf(ddbltfx));

ddbltfx.dwSize := SizeOf(ddbltfx);

ddbltfx.dwFillColor :=RGB (255, 255, 255);

FDDSConsole.Bit(nil, nil, nil, DDBLT COLORFILL or DDBLT WAIT, @ddbltfx);

SetRect (rcRectConsole, 0, 0, 640, 100);

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

if ConsoleLive then begin // Надо ли рисовать консоль

if (GlobalThisTickCount - GlobalLastTickCount > DelayConsole) then

begin // Плавное появление консоли

Inc (ConsoleHeight, 5);

if ConsoleHeight > 100 then ConsoleHeight := 100;

SetRect (rcRectConsole, 0, 0, 640, ConsoleHeight);

end;

// Собственно воспроизведение консоли

FDDSBack.BltFast(0, 0, FDDSConsole, @rcRectConsole, DDBLTFAST__WAIT);

end;

Текст в консоли выводится с помощью функций GDI:

procedure OutText (const X, Y : Integer; const TextCon : String);

var

DC : HOC;

begin

FDDSConsole.GetDC (DC) ;

SetBkColor(DC, RGB (255, 255, 255)); // Цвета фона и букв необходимо

SetTextColor (DC, 0); // задавать обязательно

TextOut (DC, X, Y, PChar(TextCon), length (TextCon));

FDDSConsole.ReleaseDC (DC);

end;

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

if diks [DIK_TAB] and $80 <> 0 then begin // Клавиша

if not ConsoleLive then begin // Включение консоли

ConsoleHeight := 0; ConsoleLive := True;

end

else ConsoleLive := False; // Выключить консоль

Sleep(lOO); // Небольшая пауза

end;

if ConsoleLive then begin // Обработка клавиш для консоли

OutText (5, 10, TextConsolel); // Вывод трех строк в консоли

OutText (5, 30, TextConsole2); OutText (5, 50, TextConsole3);

if diks [DIK_RETURN] and $80 <> 0 then begin // Ввод команды

// Введена команда "Exit"; выход из программы

if (TextConsole3 = '>EXIT_') or (TextConsole3 = '> EXIT_') then Close;

// Введена другая команда, строки стираются и поднимаются наверх

TextConsolel := ' ';