Entwickler-Ecke :: Thema anzeigen - Pixel-Array effizient ausgeben

Heiko - Fr 22.06.07 19:35
Titel: Pixel-Array effizient ausgeben

Hallo,

ich habe demnächst wieder Praktikum und arbeite dann an der WebCam-Bildanalyse weiter. Dabei ist mir mal wieder aufgefallen, dass ich haufen FPS verliere beim abgreifen der Bilder. Sprich ich bekomme vom TWAIN-Treiber die Adresse zurückgeliefert, wo die Bilder liegen, und kopiere mir die dann in ein BMP um es ausgeben zu können. Aber das kopieren dauert scheinbar zu lange. Gibt es da eine effizientere Variante?

Bisheriger Code:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:

procedure GetData(hCapWnd: HWND; lpVHDR: PVideoHdr; var BMP: TBitmap);
var
  BitmapInfo: TBitmapInfo;
  src: PRGBA;
  x, y: integer;
  Width, Height: Integer;
begin
  FillChar(BitmapInfo, SizeOf(BitmapInfo), 0);
  SendMessage(hCapWnd, WM_CAP_GET_VIDEOFORMAT, SizeOf(BitmapInfo), Integer(@BitmapInfo));
  Width:=BitmapInfo.bmiHeader.biWidth;
  Height:=BitmapInfo.bmiHeader.biHeight;

  if (BMP.Width<>Width) or (BMP.Height<>Height) then
  begin
    BMP.SetSize(Width, Height);
  end;

  src:=PRGBA(lpVHdr^.lpData);
  if BitmapInfo.bmiHeader.biCompression = BI_RGB then
  begin
    case BitmapInfo.bmiHeader.biBitCount of
      24: begin
            for y := Height-1 downto 0 do
            begin
              for x := Width-1 downto 0 do
              begin
                BMP.Canvas.Pixels[x, y]:=(Src^.B shl 16) or (Src^.G shl 8) or Src^.R;
                Src:=PRGBA(Integer(Src)+3);
              end;
            end;
          end;
      32: begin
            for y := Height-1 downto 0 do
            begin
              for x := Width-1 downto 0 do
              begin
                BMP.Canvas.Pixels[x, y]:=(Src^.B shl 16) or (Src^.G shl 8) or Src^.R;
                Src:=PRGBA(Integer(Src)+4);
              end;
            end;
      end;
    end;
  end;
end;

function OnFrame(hCapWnd: HWND; lpVHDR: PVideoHdr): DWord; stdcall;
var
  newtime: Cardinal;
begin
  Result:=1;
  GetData(hCapWnd, lpVHDR, BMP);
  BitBlt(Form1.Canvas.Handle, 0, 0, BMP.Width, BMP.Height, BMP.Canvas.Handle, 0, 0, SRCCOPY);
  newtime:=GetTickCount;
  Form1.Caption:='CamAnalyzer - '+Format('%.2f', [1000/(newtime-Lasttime)])+'FPS';
  LastTime:=newtime;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BMP:=TBitmap.Create;
  CapHandle:=capCreateCaptureWindow('CamStream', WS_CHILD or WS_VISIBLE, 0, 0, 1, 1, Handle, 1);
  SendMessage(CapHandle, WM_CAP_DRIVER_CONNECT, 0, 0);
  SendMessage(CapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, Integer(@OnFrame));
  SendMessage(CapHandle, WM_CAP_SET_PREVIEWRATE, 1, 0);
end;

Und würde es vlt. etwas bringen das abfassen in einen extra Thread zu lagern (GUI entlasten)? Da wüsste ich jetzte nur nicht, wie ich den dazubringe, dass OnFrame in den anderen Frame gehört. Hat da einer vlt. auch eine Idee? So könnte ich den CPU stärker auslasten beim auswerten etc.

Grüße
Heiko

//EDIT: Am liebste wäre mir eine Variante ohne BMP, also nur mit einem "Array" ;)-

Heiko - Mo 25.06.07 07:42

BenBE hat folgendes geschrieben:

Außerdem kannst Du Dir das Drehen der Farbkanäle schenken, wenn Du gleich ein Bitmap-Handle anforderst, bei dem Du BGR im Speicher ablegen musst.

Du meinst das umdrehen durch die downto-Schleife? Eigentlich war das eher unbeabsichtitg ;). Ein Vergleich mit 0 ist nun einmal schneller, von daher rückwärts. Das umdrehen war nur ein Randeffekt ;).

Ach der neue Code, der ca. 16x schneller ist als der alte (+CPU-Last von 50% auf 2% gesenkt):

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:

procedure GetData(hCapWnd: HWND; lpVHDR: PVideoHdr; var BMP: TBitmap; bmiHeader: TBitmapInfoHeader);
var
  src: PRGBA;
  i: integer;
  p: PRGB;
  pz: Integer;
begin
  src:=PRGBA(lpVHdr^.lpData);
  if bmiHeader.biCompression = BI_RGB then
  begin
    pz:=bmiHeader.biBitCount div 8;
    p:=BMP.ScanLine[BMP.Height-1];
    for  i:= (bmiHeader.biSizeImage div 3)-1 downto 0 do
    begin
      p^.B:=Src^.B;
      p^.G:=Src^.G;
      p^.R:=Src^.R;
      Src:=PRGBA(Integer(Src)+pz);
      inc(p);
    end;
  end;
end;

procedure InterpretFrame;
var
  i: integer;
  p: array[0..1] of PRGB;
  r: PRGB;
begin
  p[0]:=BMP[0].ScanLine[BMP[0].Height-1];
  p[1]:=BMP[1].ScanLine[BMP[0].Height-1];
  r :=ResBMP.ScanLine[BMP[0].Height-1];
  for i := ResBMP.Height*ResBMP.Width-1 downto 0 do
  begin
    if (abs(p[0]^.B - p[1]^.B) < 20) and
       (abs(p[0]^.R - p[1]^.R) < 20) and
       (abs(p[0]^.G - p[1]^.G) < 20) then
    begin
      r^.R:=p[curBMP]^.R;
      r^.G:=p[curBMP]^.G;
      r^.B:=p[curBMP]^.B;
    end
    else
    begin
      r^.R:=0;
      r^.G:=255;
      r^.B:=0;
    end;
    inc(r);
    inc(p[0]);
    inc(p[1]);
  end;
end;

function OnFrame(hCapWnd: HWND; lpVHDR: PVideoHdr): DWord; stdcall;
var
  newtime: Cardinal;
begin
  Result:=1;
  curBMP:=curBMP xor 1;
  GetData(hCapWnd, lpVHDR, BMP[curBMP], bmiHeader);
  InterpretFrame;
  BitBlt(Form1.Canvas.Handle, 0, 0, ResBMP.Width, ResBMP.Height, ResBMP.Canvas.Handle, 0, 0, SRCCOPY);
  newtime:=GetTickCount;
  if newtime<>Lasttime then Form1.Caption:='CamAnalyzer - '+Format('%.2f', [1000/(newtime-Lasttime)])+'FPS';
  LastTime:=newtime;
end;

procedure ChangeFormat;
var
  BitmapInfo: TBitmapInfo;
  Width, Height: Integer;
begin
  FillChar(BitmapInfo, SizeOf(BitmapInfo), 0);
  SendMessage(CapHandle, WM_CAP_GET_VIDEOFORMAT, SizeOf(BitmapInfo), Integer(@BitmapInfo));
  Width:=BitmapInfo.bmiHeader.biWidth;
  Height:=BitmapInfo.bmiHeader.biHeight;

  if (curWidth<>Width) or (curHeight<>Height) then
  begin
    curWidth:=Width;
    curHeight:=Height;
    BMP[0].SetSize(Width, Height);
    BMP[1].SetSize(Width, Height);
    ResBMP.SetSize(Width, Height);
  end;
  bmiHeader:=BitmapInfo.bmiHeader;
end;

procedure TForm1.CamFormatButtonClick(Sender: TObject);
begin
  SendMessage(CapHandle, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
  ChangeFormat;
end;

procedure TForm1.CamSourceButtonClick(Sender: TObject);
begin
  SendMessage(CapHandle, WM_CAP_DLG_VIDEOSOURCE, 0, 0);
  ChangeFormat;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  curWidth:=0;
  curHeight:=0;
  curBMP:=0;
  ResBMP:=TBitmap.Create;
  ResBMP.PixelFormat:=pf24bit;
  BMP[0]:=TBitmap.Create;
  BMP[0].PixelFormat:=pf24bit;
  BMP[1]:=TBitmap.Create;
  BMP[1].PixelFormat:=pf24bit;
  ResBMP.PixelFormat:=pf24bit;
  CapHandle:=capCreateCaptureWindow('CamStream', WS_CHILD or WS_VISIBLE, 0, 0, 1, 1, Handle, 1);
  SendMessage(CapHandle, WM_CAP_DRIVER_CONNECT, 0, 0);
  SendMessage(CapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, Integer(@OnFrame));
  SendMessage(CapHandle, WM_CAP_SET_PREVIEWRATE, 1, 0);
  ChangeFormat;
  LastTime:=GetTickCount;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SendMessage(CapHandle, WM_CAP_DRIVER_DISCONNECT, 0, 0);
  BMP[0].Free;
  BMP[1].Free;
  ResBMP.Free;
end;

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!