DirectX Графика в проектах Delphi

       

Вывод текста



Текст можно выводить двумя способами: используя функции GDI и осуществляя блиттинг растров отдельных букв. Первый способ мы применяли неоднократно в предыдущих примерах. Рассмотрим второй.
В качестве примера я приготовил простую программу изучения английского языка. Один из методов пополнения словарного запаса состоит в том, чтобы выводить на экран строки словаря на очень маленький промежуток времени, меньший 1/24 секунды. Считается, что выводимый "в 25-м кадре" текст запоминается зрителем на подсознательном уровне. Метод не требует особых усилий от обучаемого, но я не могу сказать ничего определенного по поводу его реальной эффективности, и замечу, что применяться он должен только при условии, что пользователь информирован о работе подобных программ.
Программа проекта каталога Ех08 как раз относится к разряду подобных. После ее запуска можете выполнять текущую работу и заодно обогащать свой словарный запас.
Я подготовил небольшой файл словаря, на основе которого заполняется массив строк:

const
imageBmp = '..\font.bmp1; // Растр шрифта
NumbLines =70; // Количество строк в файле
FileName = 'dictionary.txt'; // Файл словаря
Delay =50; // Пауза между появлениями очередной фразы
var
OutLiteral : String; // Очередная выводимая строка
StrList : Array [0..NumbLines - 1] of String; // Массив строк словаря
WinWidth, PosX : Integer; // Размеры экрана и позиция строки по X
WinHeight, PosY : Integer; // Размеры экрана и позиция строки по Y
tmpRect : TRECT; // Прямоугольник, связанный с текущей строкой

Избранные символы, с кодом большим 31, нарисованы в растре шрифта, высота каждого символа - 15 пикселов (рис. 5.8).

Рис. 5.8. В этой задаче не потребуются все 255 символов

Используется нормальный уровень кооперации. Для создания вспомогательной поверхности определяем текущие установки экрана:

procedure TfrmDD.FormCreate(Sender: TObject);
var
hRet : HRESULT;
ddsd : TDDSurfaceDesc2;
t : TextFile;
i, maxLength : Integer;
begin
FDDSWork := nil;
FDDSGround := nil;
FDDSFont := nil;
FDDSPrimary := nil;
FDD := nil;
hRet := DirectDrawCreateEx (nil, FDD, IDirectDrawV, nil);
if Failed(hRet) then ErrorOut(hRet, 'DirectDrawCreateEx');
// Уровень кооперации - нормальный
hRet := FDD.SetCooperativeLevel(Handle, DDSCL_NORMAL);
if Failed(hRet) then ErrorOut(hRet, 'SetCooperativeLevel');
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, 'Create Primary Surface');
// Загружаем растр со шрифтом
FDDSFont := DDLoadBitmap(FDD, imageBmp, 0, 0) ;
if FDDSFont = nil then ErrorOut(hRet, 'DDLoadBitmap');
// Узнаем текущие размеры экрана
WinWidth := GetSystemMetrics(SM_CXSCREEN);
WinHeight := GetSystemMetrics(SM_CYSCREEN);
// Поверхность для запоминания подложки выводимой фразы
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 := WinWidth;
dwHeight := WinHeight;
end;
hRet := FDD.CreateSurface(ddsd, FDDSGround, nil);
if Failed (hRet) then ErrorOut(hRet, 'CreateSurface');
// Считываем файл словаря, находим длину самой длинной фразы
AssignFile (t, FileName);
Reset (t);
maxLength := 0;
for i := 0 to NumbLines - 1 do begin
ReadLn (t, StrList [i]);
if length (StrList [i]) > maxLength then maxLength :=
length (StrList [i]);
end;
CloseFile (t);
// Поверхность для хранения растра фразы
ZeroMemory(@ddsd, SizeOf(ddsd));
with ddsd do begin
dwSize := SizeOf(ddsd);
dwFlags := DDSD__CAPS or DDSDJiEIGHT or DDSD_WIDTH;
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
dwWidth := maxLength * 15; // Должны вместиться все фразы
dwHeight := 15;
end;
hRet := FDD.CreateSurface(ddsd, FDDSWork, nil);
if Failed (hRet) then ErrorOut(hRet, 'CreateSurface');
Randomize;
OutLiteral := StrList [random (NumbLines)]; // Генерируем первую фразу
GeneratePos; // Случайно генерируем позицию фразы на экоане
LastTickCount := GetTickCount;
end;


Для обеспечения максимальной скорости ошибки вообще не обрабатываются. Фразы побуквенно выводятся на вспомогательную поверхность, чтобы затем на первичной поверхности отобразить всю строку целиком:
procedure TfrmDD.ApplicationEventslIdle(Sender: TObject;
var Done: Boolean);
var
rcRect : TRECT;
i, X, Y : Integer;
// Вывод одного символа на вспомогательную поверхность
procedure OutChar (ch : Char; PosX : Integer);
var
chRect : TRECT;
wrkl : integer;
begin
// В растре шрифта представлены символы, начиная с пробела
wrkl := ord (ch) - 32;
chRect.Left := wrkl rriod 16 * 15; // Прямоугольник буквы в растре шрифта
chRect.Top := wrkl div 16 * 15;
chRect.Right := chRect.Left + 15;
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 с небольшой задержкой, но для небыстрых компьютеров это может привести к тому, что строки начнут неприятно мерцать по всему экрану.

Содержание раздела