У меня есть приложение Delphi 6, которое отправляет растровые изображения в DLL-библиотеку DirectShow в режиме реального времени со скоростью 25 кадров в секунду. DirectShow DLL - тоже мой код, он также написан на Delphi 6 с использованием набора компонентов DSPACK DirectShow. У меня есть простой блок кода, который проходит через каждый пиксель в растровом изображении, изменяя яркость и контрастность изображения, если установлен определенный флаг, в противном случае растровое изображение выталкивается из библиотеки DirectShow DLL без изменений (push-фильтр видео). Код был в основном приложении, а затем я просто переместил его в DLL-библиотеку DirectShow. Когда он был в основном приложении, он работал нормально. Я мог видеть изменения в растровом изображении, как и ожидалось. Однако теперь, когда код находится в DLL-библиотеке DirectShow, возникают следующие проблемы:
Когда блок кода ниже активен, DLL-библиотека DirectShow работает очень медленно. У меня четырехъядерный процессор i5 и он очень медленный. Я также вижу большой всплеск потребления процессора. Напротив, тот же самый код, работающий в основном приложении , прекрасно работал на старом одноядерном процессоре P4 . Он заметно ударил по процессору на этой старой машине, но видео было плавным, и проблем не было. Размер изображения составляет всего 352 x 288 пикселей.
Я не вижу ожидаемых изменений в видимом растровом изображении. Я могу проследить код в DLL-библиотеке DirectShow и увидеть числовые значения каждого пикселя, должным образом измененные кодом, но видимое изображение в окне «Редактирование графика ActiveMovie» выглядит совершенно без изменений.
Если я деактивирую код, что я могу сделать в режиме реального времени, в окне ActiveMovie будет отображаться видео, такое же гладкое, как стекло, которое идеально воспроизводится при едва затронутом процессоре. Если я повторно активирую код, видео теперь действительно прерывистое, вероятно, показывая только 1 - 2 кадра в секунду с большой задержкой, прежде чем показывается первый кадр, и всплески ЦП. Не полностью, но намного больше, чем я ожидал.
Я попытался скомпилировать DLL-библиотеку DirectShow со всем, включая проверку диапазона, проверку переполнения и т. Д., И во время выполнения не было предупреждений или ошибок. Затем я попытался скомпилировать для максимальной скорости, и у меня все те же проблемы, перечисленные выше. Что-то действительно не так, и я не могу понять, что. Обратите внимание, я действительно блокирую холст перед изменением растрового изображения и разблокирую его после того, как я закончу. Если бы не прогон компиляции «все включено», о котором я упоминал выше, я бы сказал, что чувствовалось, что исключение FPU вызывалось и молча проглатывалось при каждом расчете пикселя, но, как я уже сказал, никаких ошибок или исключений не возникает.
ОБНОВЛЕНИЕ : Я помещаю это здесь, чтобы решение, которое включено в один из комментариев Романа Р., было ясно видно. Проблема в том, что я не устанавливал для свойства PixelFormat значение pf24Bit до получения доступа к свойству ScanLine. Как предположил Роман, если этого не сделать, код TBitmap создаст временную копию растрового изображения. Как только я добавил строку кода ниже, проблемы исчезли, и изменения не были видны, и ошибки программной страницы. Это коварная проблема, потому что затрагивается только один объект - указатель, который вы используете для доступа к свойству ScanLine, поскольку (предположительно) он содержит указатель на временную копию растрового изображения. Именно поэтому последующий вызов TextOut () все еще работал, поскольку он работал с исходной копией растрового изображения.
clip.PixelFormat := pf24bit; // The missing code line that fixes the problem.
Вот блок кода, на который я ссылался:
function IntToByte(i: Integer): Byte;
begin
if i > 255 then
Result := 255
else if i < 0 then
Result := 0
else
Result := i;
end;
// ---------------------------------------------------------------
procedure brightnessTurboBoost(var clip: TBitmap; rangeExpansionPowerOf2: integer; shiftValue: Byte);
var
p0: PByte;
x,y: Integer;
begin
if (rangeExpansionPowerOf2 = 0) and (shiftValue = 0) then
exit; // These parameter settings will not change the pixel values.
for y := 0 to clip.Height-1 do
begin
p0 := clip.scanline[y];
// Can't just do the whole buffer as a big block of bytes since the
// individual scan lines may be padded for CPU alignment.
for x := 0 to (clip.Width - 1) * 3 do
begin
if rangeExpansionPowerOf2 >= 1 then
p0^ := IntToByte((p0^ shl rangeExpansionPowerOf2) + shiftValue)
else
p0^ := IntToByte(p0^ + shiftValue);
Inc(p0);
end;
end;
end;