Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.03.2018, 14:16   #1
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 867
По умолчанию DirectShow отзеркалить или перевернуть изображение

Здравствуйте.
Как, используя DirectShow, отзеркалить или перевернуть изображение? Есть ли для этого какой-нибудь интерфейс или фильтр?
Если делать это через SampleGrabberCallback, то видео тормозит.
BLACK_RAIN вне форума Ответить с цитированием
Старый 21.03.2018, 17:45   #2
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Покажите ваш код где идет обработка кадра в sampleGraberCallback, чтобы немного подправить

Я у себя в проекте с видео переворачивал картинку кадра таким вот способом, очень быстро получается

Код:
OutPict:= изображение оригинальное
InPict:= разворачиваем изображение как нужно

     For Y:= biHeight - 1 downto 0 do
      begin
      Move(OutPict^, InPict[Y*biWidth], biWidth);
      INC(PByte(OutPict), biWidth);
     end;

Последний раз редактировалось Aliens_wolfs; 21.03.2018 в 19:34.
Aliens_wolfs на форуме Ответить с цитированием
Старый 22.03.2018, 08:32   #3
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 867
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Покажите ваш код где идет обработка кадра в sampleGraberCallback, чтобы немного подправить
Код самый обычный. В другой теме уже обсуждалось, что винда не успевает рисовать 1/fps кадров даже если ничего не делать с картинкой. Тогда что тут можно подправить?
Код:


function TVideoPlayer.SampleCB(SampleTime: Double; pSample: IMediaSample): HRESULT;
var
  nLen : Integer;
  mt : TAMMediaType;
  bmpInfo : TBitmapInfo;
  vih : TVideoInfoHeader;
  bmp : TBitmap;
  HBMP : HBITMAP;
  tmp : array of Byte;
  buffer : Pointer;
  pBuffer : PByte;
begin
  if Assigned(OnGrabVideoSample) then
  begin
    Result := pSampleGrabberVideo.GetConnectedMediaType(mt);
    vih := tvideoinfoheader(mt.pbFormat^);
    ZeroMemory(@bmpinfo,SizeOf(tbitmapinfo));
    CopyMemory(@bmpinfo.bmiheader,@vih.bmiheader,SizeOf(tbitmapinfoheader));
    Buffer := nil;
    hbmp := CreateDIBSection(0,BMPInfo,DIB_PAL_COLORS, BUFFER,0,0);
    if (HBMP = 0) or (HBMP = ERROR_INVALID_PARAMETER) then
    begin
  //    ShowMessage('error');
      Exit;
    end;
    bmp := TBitmap.Create;
    bmp.Handle := HBMP;
    MediaInfo.VideoWidth := bmp.Width;
    MediaInfo.VideoHeight := bmp.Height;

    if Assigned(OnGetVideoSampleSize) then // быдлокод. Передаёт размер кадра
    begin
      if fSize then
      begin
        OnGetVideoSampleSize(Self,Point(MediaInfo.VideoWidth,MediaInfo.VideoHeight));
        fSize := False;
      end;
    end;
    nLen := pSample.GetActualDataLength;
    SetLength(tmp, nlen);
    Result := pSample.GetPointer(pBuffer);
    CopyMemory(buffer,pBuffer,nLen);

    OnGrabVideoSample(Self, bmp); //вызываем обработчик

    MoFreeMediaType(@mt);
    buffer := nil;
    bmp.Free;
  end;
  Result := S_OK;
end;
Обработчик:
Код:
procedure TEventsHandler.PlayerGrabVideoSample(Sender: TObject; Bitmap: TBitmap);
begin
//  SetRect(r, 0,0, 200,200);// допустим, что это оригинал
// тогда
  SetRect(r, 600, 0, 0, 600); // масштабируем, зеркалим
  Panel1.Canvas.StretchDraw(r, Bitmap);
end;
И всё. Это почти весь код. Чем больше у видео разрешение и FPS, тем сильнее получается слайдшоу.

Последний раз редактировалось BLACK_RAIN; 22.03.2018 в 16:34.
BLACK_RAIN вне форума Ответить с цитированием
Старый 22.03.2018, 21:08   #4
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Вот изменил ваш код, проверив при этом у себя, работает без тормозов

Код:
function TVideoPlayer.SampleCB(SampleTime: Double; pSample: IMediaSample): HResult;
var
  BitmapInfoHeader: PBitmapInfoHeader;
  MediaType: TAMMediaType;
  DIBSize, ByteWidth, Y: Integer;
  pBuffer: array of byte;
  bmp: TBitmap;
begin

 if Assigned(OnGrabVideoSample) then
begin

  if (pSample.GetSize = 0) then
    Exit;

    Result := pVideoGrabber.GetConnectedMediaType(MediaType);
  if Failed(Result) then
    Exit;

  if IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) then
  begin
    BitmapInfoHeader := NIL;
    if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
    begin
      if (MediaType.cbFormat >= SizeOf(TVideoInfoHeader)) then
        BitmapInfoHeader := @(PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader);
    end;
    if (BitmapInfoHeader = NIL) then
      Exit;

    DIBSize := BitmapInfoHeader^.biSizeImage;
    if (DIBSize = 0) then
    begin
      with BitmapInfoHeader^ do
        DIBSize := 3 * biWidth * biHeight * biPlanes;
      BitmapInfoHeader^.biSizeImage := DIBSize;
    end;

    pSample.GetPointer(PByte(pBuffer));

  bmp:= TBitmap.Create;
  bmp.PixelFormat:= pf24bit;
  bmp.Width:= BitmapInfoHeader.biWidth;
  bmp.Height:= BitmapInfoHeader.biHeight;
 try
  ByteWidth := BitmapInfoHeader.biWidth * 3;
//Быстрое разворачивание картинки по линиям в bmp
  for y := 0 to BitmapInfoHeader.biHeight - 1 do  //или на оборот for y := BitmapInfoHeader.biHeight - 1 downto 0 do
    begin
      Move(Pointer(pBuffer)^, bmp.ScanLine[Y]^, ByteWidth);
      INC(PByte(pBuffer), ByteWidth);
    end;

  OnGrabVideoSample(Self, bmp); //вызываем обработчик

 finally
  bmp.Free;
 end;
   Result := S_OK;
  end;
 end;
end;

procedure TEventsHandler.PlayerGrabVideoSample(Sender: TObject; Bitmap: TBitmap);
begin
 Image1.Picture.Bitmap:= Bitmap;
end;

Последний раз редактировалось Aliens_wolfs; 23.03.2018 в 10:30.
Aliens_wolfs на форуме Ответить с цитированием
Старый 23.03.2018, 13:36   #5
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 867
По умолчанию

При 60fps всё-равно тормозит. А если включить отзеркаливание или переворот в FFDShow, тогда всё нормально. Как он это делает?
Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
for y := 0 to BitmapInfoHeader.biHeight - 1 do
begin
Move(Pointer(pBuffer)^, bmp.ScanLine[Y]^, ByteWidth);
INC(PByte(pBuffer), ByteWidth);
end;
Это перевернуть. А отзеркалить как? Хоть и не поможет.
BLACK_RAIN вне форума Ответить с цитированием
Старый 23.03.2018, 15:48   #6
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Цитата:
Это перевернуть. А отзеркалить как? Хоть и не поможет.
так попробуйте

Код:
for y := BitmapInfoHeader.biHeight - 1 downto 0 do 
begin
      Move(Pointer(pBuffer)^, bmp.ScanLine[Y]^, ByteWidth);
      INC(PByte(pBuffer), ByteWidth);
    end;
Какой размер картинки?

Последний раз редактировалось Aliens_wolfs; 24.03.2018 в 00:29.
Aliens_wolfs на форуме Ответить с цитированием
Старый 23.03.2018, 16:39   #7
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

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

Тормозило как я заметил из за Canvas.StretchDraw по этой причине росла память, перегружался процессора видимо было наложения картинки т.к. конва не очищалась.
Вот кое что изменил у меня работает норм.

Код:
function TVideoPlayer.SampleCB(SampleTime: Double; pSample: IMediaSample): HResult;
var
  BitmapInfoHeader: PBitmapInfoHeader;
  MediaType: TAMMediaType;
  DIBSize, ByteWidth, Y: Integer;
  pBuffer: array of byte;
  pPixel: array of byte;
  bmp: TBitmap;
  iPix: integer;
begin

 if Assigned(OnGrabVideoSample) then
begin

  if (pSample.GetSize = 0) then
    Exit;

    Result := pVideoGrabber.GetConnectedMediaType(MediaType);
  if Failed(Result) then
    Exit;

  if IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) then
  begin
    BitmapInfoHeader := NIL;
    if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
    begin
      if (MediaType.cbFormat >= SizeOf(TVideoInfoHeader)) then
        BitmapInfoHeader := @(PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader);
    end;
    if (BitmapInfoHeader = NIL) then
      Exit;

    DIBSize := BitmapInfoHeader^.biSizeImage;
    if (DIBSize = 0) then
    begin
      with BitmapInfoHeader^ do
        DIBSize := 3 * biWidth * biHeight * biPlanes;
      BitmapInfoHeader^.biSizeImage := DIBSize;
    end;

    pSample.GetPointer(PByte(pBuffer));

 bmp:= TBitmap.Create;
 bmp.PixelFormat:= pf24bit;
 bmp.Width:= BitmapInfoHeader.biWidth;
 bmp.Height:= BitmapInfoHeader.biHeight;
try
  ByteWidth := BitmapInfoHeader.biWidth * 3;
    SetLength(pPixel, DIBSize);
  //Обрабатываем кадр как нам нужно
    for y := BitmapInfoHeader.biWidth * BitmapInfoHeader.biHeight - 1 downto 0 do
    begin
    PByteArray(pPixel)^[y * 3] := PByteArray(pBuffer)^[0];
    PByteArray(pPixel)^[y * 3 + 1] := PByteArray(pBuffer)^[1];
    PByteArray(pPixel)^[y * 3 + 2] := PByteArray(pBuffer)^[2];
    INC(PByte(pBuffer), 3);
    end;
 //Копируем через буфер кадр в Bitmap
    iPix:= 0;
    for y := 0 to BitmapInfoHeader.biHeight - 1 do
    begin
      Move(PByteArray(pPixel)[iPix], bmp.ScanLine[Y]^, ByteWidth);
      INC(iPix, ByteWidth);
    end;

  OnGrabVideoSample(Self, bmp);
 finally
  bmp.Free;
 end;
   Result := S_OK;
  end;
 end;
end;

procedure TEventsHandler.PlayerGrabVideoSample(Sender: TObject; Bitmap: TBitmap);
var
memDC, FDC: HDC;
begin
 MemDC:= GetDC(Panel1.Handle); //Читаем графический хендел панели
 SetStretchBltMode(MemDC, HALFTONE); //Сглаживаем фон на графическом хенделе панели
 FDC:= CreateCompatibleDC(MemDC); //Создаем графический хендел из графического хендела панели для работы Bitmap
 SelectObject(FDC, Bitmap.Handle);//Привязываем к созданному графическому хенделу Bitmap 

//Рисуем на графическом хенделе панели из привязанного созданного графического хендла Bitmap
 StretchBlt(MemDC, 0, 0, Panel1.Width, Panel1.Height, FDC, 0, 0, Bitmap.Width, Bitmap.Height, SRCCOPY);

//Удаляем все графические хендлы
 DeleteDC(FDC);
 DeleteDC(MemDC);
//Все это нужно для правильного рисования кадра и для освобождения ресурсов
 end;

Последний раз редактировалось Aliens_wolfs; 24.03.2018 в 11:02.
Aliens_wolfs на форуме Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перевернуть изображение в 256 цветном BMP-файле на 180 градусов chebppreck Общие вопросы C/C++ 2 22.12.2016 16:08
Загрузка изображения или сылка на изображение xakkkkker Работа с сетью в Delphi 5 14.01.2013 23:04
Как отображать изображение на пикчербоксе или панели? AndersonEgo C# (си шарп) 1 29.05.2011 22:32
DirectShow или что это? Rebel123 Общие вопросы Delphi 1 29.06.2009 12:38
Как перевернуть изображение по часовой стрелке John_chek Мультимедиа в Delphi 7 09.07.2007 00:24