Поворот TBitMap через массив байтов

[Adult_Master]

Здравствуйте. Использую компонент DSPack в связке с vgScene (это прородитель FireMonkey). В SampleGrabber1Buffer использую pBuffer для своих манипуляций, а затем привожу его к типу:
PvgColorArray = ^TvgColorArray;
TvgColorArray = array [0..4] of TvgColor;
и перевожу его через Skanline в TvgBitMap (TBitMap сам движок не поддерживает). На каком то этапе мне нужно повернуть (очень быстро) картинку на 90°, точка поворота: середина картинки. В движке есть своя функция поворота, но она работает медленно, собственно как и bitblt. У кого-нибуть есть примеры функций поворота через массив байтов ? мне кажется это будет самый быстрый способ, если учесть что массив получаем как входной параметр обработчика.
Думаю тут нужно использовать матрицы, но я с ними никогда не работал.

P.S. ещё больше мне подошёл бы вариант заставить DSPack сразу же давать повёрнутую картинку (изображение снимается с web-камеры).

[ResourceSpace]

0) Поворот через чего?
1) BitBlt() работает быстро.
2) BitBlt() в принципе не делает поворотов.
3) Матрицы используются в большинстве случаев неявно, а уж поворот 90 градусов...
4) Чем вам PlgBlt() не угодил?
5) Как вы определяете "медленно"?

Картинка квадратная? Где она вообще потом использоваться планирует?

[Adult_Master]

Цель такая: Есть веб-камера которая выдаёт картинку 1920х1080, нужно это изображение вывести на форму, в таком же размере, но картинка должна быть перевёрнутой (т.е. уже высота 1920 а ширина 1080). Сама картинка на форме это объект vgScene -> TvgBitmap), т.е. в любом случае потребуется конвертация из TBitmap. Перепробовал уже кучу компонентов, пока остановился на DSPack, его граббер выдаёт изображение в виде массива байт, которое крайне быстро переводится в TvgImage, но если начать его переворачивать.....всё тормозит.
Я понимаю что DSPack это всего лишь обёртка над DirectShow, но на его изучение уйдёт масса времени, потому и ищу готовые примеры/решения.

[ResourceSpace]

веб-камера которая выдаёт картинку 1920х1080

Ох, нифига себе! Такие бывают? Самая крутая побывавшая в моих руках (хоть и было написано FullHD) только фотки могло делать таким размером, видео лагало до чёртиков, приходилось 800х600 ставить.

А зачем вам именно DSPack / vgScene / TvgBitmap ? Просто выводить на окно не пойдёт?

Разь:

Unit Unit1;

Interface

Uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;

Const SW = 1920; SH = 1080; Z = 0.3;

Type
      TForm1 = Class(TForm)
            Procedure FormCreate(Sender: TObject);
            Procedure FormDestroy(Sender: TObject);
            Procedure FormPaint(Sender: TObject);
      Private { Private declarations }
            Src: TBitmap;
            Dst: TBitmap;
            pa: Array [0..2] Of TPoint;
      Public { Public declarations }
      End;

Var Form1: TForm1;

Implementation

{$R *.dfm}

Procedure TForm1.FormCreate(Sender: TObject);
Begin
Src:=TBitmap.Create;
Dst:=TBitmap.Create;
Src.LoadFromFile('C:\dev\res\bmp\1920x1080.bmp');
Src.PixelFormat:=pf24bit;
Src.Width:=SW;
Src.Height:=SH;
Dst.PixelFormat:=pf24bit;
Dst.Width:=Trunc(SH*Z);
Dst.Height:=Trunc(SW*Z);
pa[0].X:=0;
pa[0].Y:=Dst.Height;
pa[1].X:=0;
pa[1].Y:=0;
pa[2].X:=Dst.Width;
pa[2].Y:=Dst.Height;
// PlgBlt(Dst.Canvas.Handle, pa, Src.Canvas.Handle, 0, 0, SW, SH, 0, 0, 0);
End;

Procedure TForm1.FormDestroy(Sender: TObject);
Begin
Src.Free;
Dst.Free;
End;

Procedure TForm1.FormPaint(Sender: TObject);
Begin
Canvas.StretchDraw(Rect(0, 0, Trunc(SW*Z), Trunc(SH*Z)), Src);
PlgBlt(Canvas.Handle, pa, Src.Canvas.Handle, 0, 0, SW, SH, 0, 0, 0);
End;

End.

Дьва:

Unit Unit1;

Interface

Uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;

Const SW = 1920; SH = 1080; Z = 0.3;

Type
      TForm1 = Class(TForm)
            Procedure FormCreate(Sender: TObject);
            Procedure FormDestroy(Sender: TObject);
            Procedure FormPaint(Sender: TObject);
      Private { Private declarations }
            Src: TBitmap;
      Public { Public declarations }
      End;

Var Form1: TForm1;

Implementation

{$R *.dfm}

Procedure TForm1.FormCreate(Sender: TObject);
Begin
Src:=TBitmap.Create;
Src.LoadFromFile('C:\dev\res\bmp\1920x1080.bmp');
Src.PixelFormat:=pf24bit;
Src.Width:=SW;
Src.Height:=SH;
End;

Procedure TForm1.FormDestroy(Sender: TObject);
Begin
Src.Free;
End;

Procedure TForm1.FormPaint(Sender: TObject);
Var Matrix: TXForm;
Begin
Canvas.StretchDraw(Rect(0, 0, Trunc(SW*Z), Trunc(SH*Z)), Src);
SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
Matrix.eM11:=0;
Matrix.eM12:=-1*Z;
Matrix.eM21:=1*Z;
Matrix.eM22:=0;
Matrix.eDx:=0;
Matrix.eDy:=SW*Z;
SetWorldTransform(Canvas.Handle, Matrix);
Canvas.Draw(0, 0, Src);
End;

End.

Тири:

Unit Unit1;

Interface

Uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;
                       
Const SW = 1920; SH = 1080; Z = 0.3;

Type
      TForm1 = Class(TForm)
            Procedure FormCreate(Sender: TObject);
            Procedure FormDestroy(Sender: TObject);
            Procedure FormPaint(Sender: TObject);
      Private { Private declarations }
            Src: TBitmap;
            Dst: TBitmap;
            Procedure Rotate();
      Public { Public declarations }
      End;

Var Form1: TForm1;

Implementation

{$R *.dfm}

Procedure TForm1.FormCreate(Sender: TObject);
Begin
Src:=TBitmap.Create;
Dst:=TBitmap.Create;
Src.LoadFromFile('C:\dev\res\bmp\1920x1080.bmp');
Src.PixelFormat:=pf24bit;
Src.Width:=SW;
Src.Height:=SH;
Dst.PixelFormat:=pf24bit;
Dst.Width:=SH;
Dst.Height:=SW;  
// Rotate();
End;

Procedure TForm1.FormDestroy(Sender: TObject);
Begin
Src.Free;
Dst.Free;
End;

Procedure TForm1.FormPaint(Sender: TObject);
Begin
Canvas.StretchDraw(Rect(0, 0, Trunc(SW*Z), Trunc(SH*Z)), Src);
Rotate();
Canvas.StretchDraw(Rect(0, 0, Trunc(SH*Z), Trunc(SW*Z)), Dst);
End;

Procedure TForm1.Rotate();
Var x, y: Integer; SP, DP: PRGBTriple;
Begin
For y:=0 To SH-1 Do
      Begin
      SP:=Src.ScanLine[y];
      For x:=SW-1 DownTo 0 Do
            Begin
            DP:=Dst.ScanLine[x];
            Inc(DP, y);
            DP.rgbtRed:=SP.rgbtRed;
            DP.rgbtGreen:=SP.rgbtGreen;
            DP.rgbtBlue:=SP.rgbtBlue;
            Inc(SP);
            End;
      End;
End;

End.

[ResourceSpace]

Титири:

Unit Unit1;

Interface

Uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;

Const SW = 1920; SH = 1080; Z = 0.3;

Type
      TForm1 = Class(TForm)
            Procedure FormCreate(Sender: TObject);
            Procedure FormDestroy(Sender: TObject);
            Procedure FormPaint(Sender: TObject);
      Private { Private declarations }
            Src: TBitmap;
            Dst: TBitmap;
            Pixlz: Array [0..SH-1] Of Array [0..SW-1] Of PRGBTriple; 
            Procedure Rotate();
      Public { Public declarations }
      End;

Var Form1: TForm1;

Implementation

{$R *.dfm}

Procedure TForm1.FormCreate(Sender: TObject);
Var x, y: Integer; SP, DP: PRGBTriple;
Begin
Src:=TBitmap.Create;
Dst:=TBitmap.Create;
Src.LoadFromFile('C:\dev\res\bmp\1920x1080.bmp');
Src.PixelFormat:=pf24bit;
Src.Width:=SW;
Src.Height:=SH;
Dst.PixelFormat:=pf24bit;
Dst.Width:=SH;
Dst.Height:=SW;
For y:=0 To SH-1 Do
      For x:=0 To SW-1 Do
            Begin
            DP:=Dst.ScanLine[x];
            Inc(DP, y);
            Pixlz[y, SW-1-x]:=DP;
            End;
End;

Procedure TForm1.FormDestroy(Sender: TObject);
Begin
Src.Free;
Dst.Free;
End;

Procedure TForm1.FormPaint(Sender: TObject);
Begin
Canvas.StretchDraw(Rect(0, 0, Trunc(SW*Z), Trunc(SH*Z)), Src);  
Rotate();
Canvas.StretchDraw(Rect(0, 0, Trunc(SH*Z), Trunc(SW*Z)), Dst);
End;   

Procedure TForm1.Rotate();
Var x, y: Integer; SP: PRGBTriple;
Begin
For y:=0 To SH-1 Do
      Begin
      SP:=Src.ScanLine[y];
      For x:=0 To SW-1 Do
            Begin
            Pixlz[y, x].rgbtRed:=SP.rgbtRed;
            Pixlz[y, x].rgbtGreen:=SP.rgbtGreen;
            Pixlz[y, x].rgbtBlue:=SP.rgbtBlue;
            Inc(SP);
            End;
      End;
End;

End.

[Adult_Master]

Ох, нифига себе! Такие бывают?

Я использую Logitech HD Pro C920, получаю все доступные режимы в TEnumMediaType, и там есть 1920х1080.

А зачем вам именно DSPack / vgScene / TvgBitmap ?

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

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

Я уже поэкспериментировал с DirectShow, в ходе чего выяснилось что тормоза выдаёт не сам DSPack (на который я грешил изначально), а всё таки моя функция обработки.

Сейчас более подробно опишу о чём идёт речь:
Вот функция обработки, это событие OnBuffer у TSampleGrabber (DSPack):

procedure TFrmMain.SampleGrabber1Buffer(sender: TObject; SampleTime: Double;
  pBuffer: Pointer; BufferLen: Integer);
var
 row: integer;
 B: TBitMap;
begin
  { skip transfer if scene is drawing }
  if vgScene1.IsDrawing or s then Exit;

  { grab stream to TvgBitmap }
  if ImgVideo.Tag = 0 then
  begin
    { First time we need to get video size }
    B := TbitMap.Create;
    SampleGrabber1.GetBitmap(B);
    VideoWidth  := B.Width;
    VideoHeigth := B.Height;
    ImgVideo.Bitmap.SetSize(B.Width, B.Height);
    // set load flag
    ImgVideo.Tag := 1;

    B.Free;
  end;

  { grabbing }
  if ImgVideo.Tag > 0 then
   begin
    // transfer - need to flip - because source have different orientation
    for row := 0 to ImgVideo.Bitmap.Height - 1 do
      Move(PvgColorArray(pBuffer)[(ImgVideo.Bitmap.Height - row - 1) * ImgVideo.Bitmap.Width], ImgVideo.Bitmap.Scanline[row]^, ImgVideo.Bitmap.Width * 4);
    // set alpha-channel
    vgFillAlpha(ImgVideo.Bitmap.Startline, BufferLen div 4, $FF);
   end;

 ImgVideo.Repaint;
end;

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

Я не копал DSPack глубоко, но мне думается эта функция всего лишь callback, так вот, когда я вставляю сюда функцию переворота изображения, то начинаются жуткие тормоза, а спустя какое то время прога вовсе вываливается в AV. Без переворота всё Ок.

Я думаю самое быстрое это произвести поворот напрямую в pBuffer это и есть указатель на массив байт, который приводится к типу PvgColorArray т.к. я уже сказал что vgScene не работает с TBitmap, у неё там свои типы.

To ResourceSpace сейчас буду экспериментировать с вашими примерами, спасибо за ответы, просто может всё вышеизложенное наведёт ещё на какие то мысли ?

[Aliens_wolfs]

Еще можно попробовать сделать обработку изображения в потоке кидая pBuffer в тело потока а в нем уже делать обработку этого буфера

[Adult_Master]

Сообщение от Aliens_wolfs

Еще можно попробовать сделать обработку изображения в потоке кидая pBuffer в тело потока а в нем уже делать обработку этого буфера

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

[Aliens_wolfs]

Bitmap вообще тормозит даже в загрузке на больших картинках, я думаю наверное в этом и есть беда небольших подтормаживаний кадров. ScaleLine тоже долгая обработка. Я тут сделал на вашем коде, что для каждого кадра создается свой обработчик картинки, может поможет. И еще одно хотел у вас спросить, когда камера без обработки работает так же тормозит или нет?
Если этот код не поможет, то нужно посмотреть в сторону графических обработчиков типа OpenGL, DirectShow и тому подобных, так как вам нужно делать обработку обращаясь напрямую к ресурсом видеокарты

 type
    TWorkImage = class(TThread)
  private
    FpBuffer: Pointer;
    FBufferLen: integer;
    FBitmap: TBitmap;
    constructor Create(); virtual;
  protected
    procedure Execute; override;
  end;

constructor TWorkImage.Create();
begin
  FreeOnTerminate := True; // чтобы поток уничтожался по завершению
  inherited Create(false);
end;

procedure TWorkImage.Execute;
var
row: integer;
begin
    // transfer - need to flip - because source have different orientation
    for row := 0 to FBitmap.Height - 1 do
    Move(PvgColorArray(FpBuffer)[(FBitmap.Height - row - 1) * FBitmap.Width],
    FBitmap.Scanline[row]^, FBitmap.Width * 4);
    // set alpha-channel
    vgFillAlpha(FBitmap.Startline, FBufferLen div 4, $FF);
end;

procedure SampleGrabber1Buffer(sender: TObject; SampleTime: Double;
  pBuffer: Pointer; BufferLen: Integer);
var
 row: integer;
 B: TBitMap;
begin
  { skip transfer if scene is drawing }
  if vgScene1.IsDrawing or s then Exit;

  { grab stream to TvgBitmap }
  if ImgVideo.Tag = 0 then
  begin
    { First time we need to get video size }
    B := TbitMap.Create;
    SampleGrabber1.GetBitmap(B);
    VideoWidth  := B.Width;
    VideoHeigth := B.Height;
    ImgVideo.Bitmap.SetSize(B.Width, B.Height);
    // set load flag
    ImgVideo.Tag := 1;

    B.Free;
  end;

  { grabbing }
  if ImgVideo.Tag > 0 then
  With TWorkImage.Create do
  begin
    FpBuffer:= pBuffer;
    FBufferLen:= BufferLen;
    FBitmap:= ImgVideo.Bitmap;
   end;

end;

[Adult_Master]

Приведённый мной код работает нормально если просто выводить НЕБОЛЬШУЮ картинку на форму (на сцену), при увеличения размера до FULL HD уже появляются небольшие лаги если резко перемещать камеру (когда меняется вся картинка целиком), но тут я думаю виновата сама камера, если же просто двигать объекты в камере то скорость вывода изображения вполне годная для работы. Проблемы начинаются при повороте изображения на 90°, FPS падает, и обновление происходит 1-2 кадра в секунду ...
А кроме поворота мне ещё нужно отзеркалить изображение по вертикали, что бы получить эффект "зеркала" но как ни странно эта функция работает довольно быстро. В общем основная проблема кроется в падении скорости при повороте изображения.
За код спасибо, сейчас буду пробовать, о результатах отпишусь.