Entwickler-Ecke :: Thema anzeigen - Schneller ScreenShot oder direkter zugriff auf Desktop Pixel

Entwickler-Ecke

Multimedia / Grafik - Schneller ScreenShot oder direkter zugriff auf Desktop Pixel

shana-chan - Do 21.10.10 19:51
Titel: Schneller ScreenShot oder direkter zugriff auf Desktop Pixel

Ich habe ein Programm geschrieben mit dem ich ein "Ambient Light"(Raumbeleuchtung dem Bildschirm angepasst) ansteuere.
Das funktioniert auch, aber leider habe ich ständig ca. 30-40% CPU Auslastung.
Das Hauptproblem scheint die BitBlt/CopyRect Rutine zu sein. Weis jemand vieleicht ne bessere Lösung?

Hier mein Quellcode: (Timer1+2 Intervall=16)

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:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, SerDlgs, Serial;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Serial1: TSerial;
    SerPortComboBox1: TSerPortComboBox;
    Timer2: TTimer;
    pr: TCheckBox;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SerPortComboBox1Change(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1; 
  dat:array[0..7] of byte;

implementation

{$R *.dfm}


// *** Erstellt von einem Formular ein ScreenShot ***
function FormularScreenShot(Bmp: TBitmap; h : hWnd): Boolean;
var
  Rec: TRect;
  iWidth, iHeight: Integer;
begin
  with Bmp do try
    GetWindowRect(h, Rec);

    iWidth  := Rec.Right - Rec.Left;
    iHeight := Rec.Bottom - Rec.Top;

    Width := iWidth;
    Height := iHeight;

    BitBlt(Canvas.Handle, 0, 0, iWidth, iHeight, GetWindowDC(h), 0, 0, SRCCOPY);
  //  StretchBlt(canvas.Handle, 0, 0, 100, 100, GetWindowDC(h), 0, 0, iWidth, iHeight, SRCCOPY);

    Result := True;
  finally
    ReleaseDC(h, GetWindowDC(h));
  end;
end;

 procedure ScreenShot(DestBitmap : TBitmap) ;
 var
   DC : HDC;
 begin
   DC := GetDC (GetDesktopWindow) ;
   try
    DestBitmap.Width := GetDeviceCaps (DC, HORZRES) ;
    DestBitmap.Height := GetDeviceCaps (DC, VERTRES) ;
    BitBlt(DestBitmap.Canvas.Handle, 0, 0, DestBitmap.Width, DestBitmap.Height, DC, 0, 0, SRCCOPY) ;
   finally
    ReleaseDC (GetDesktopWindow, DC) ;
   end;
 end;

 procedure ScreenShot2(Bild: TBitMap);
var
  c: TCanvas;
  r: TRect;
begin
  c := TCanvas.Create;
  c.Handle := GetWindowDC(GetDesktopWindow);
  try
    r := Rect(0, 0, Screen.Width, Screen.Height);
    Bild.Width := Screen.Width;
    Bild.Height := Screen.Height;
    Bild.Canvas.CopyRect(r, c, r);
  finally
    ReleaseDC(0, c.Handle);
    c.Free;
  end;
end;

function red(c:tcolor):integer;
begin
result:=(c and $0000FF)
end;

function green(c:tcolor):integer;
begin
result:=(c and $00FF00)div 256
end;

function blue(c:tcolor):integer;
begin
result:=(c and $FF0000)div 256 div 256
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
  bmp: TBitmap;
  Rec: TRect;
  c:Tcolor;
  cr,cg,cb,x,y,z:integer;

begin
  bmp := TBitmap.Create;
  cr:=0;
  cg:=0;
  cb:=0;
  z:=0;
  try
    GetWindowRect(GetDeskTopWindow, Rec);
    //FormularScreenShot(bmp,GetDeskTopWindow); 
    ScreenShot2(bmp);
    for x:=0 to bmp.Width div 32 do
      for y:=0 to bmp.Height div 32 do
        begin
          z:=z+1;
          c:=bmp.Canvas.Pixels[x*32,y*32];
          cr:=cr+red(c);
          cg:=cg+green(c);
          cb:=cb+blue(c);
        end;
  finally
    Bmp.Free;
    cr:=cr div z;
    cg:=cg div z;
    cb:=cb div z;
    if cr>250 then cr:=250;
    if cg>250 then cg:=250;
    if cb>250 then cb:=250;
        Label1.Caption:='R:'+IntToStr(cr);
        Label2.Caption:='G:'+IntToStr(cg);
        Label3.Caption:='B:'+IntToStr(cb);  
        Label1.Font.Color:=RGB(250-cr,250-cg,250-cb);
        Label2.Font.Color:=RGB(250-cr,250-cg,250-cb);
        Label3.Font.Color:=RGB(250-cr,250-cg,250-cb);
        Form1.Color:=RGB(cr,cg,cb);
    //Application.ProcessMessages;
    dat[0]:=byte(255);
    dat[1]:=byte(cr);
    dat[2]:=byte(cg);
    dat[3]:=byte(cb);
    dat[4]:=byte(cr);
    dat[5]:=byte(cg);
    dat[6]:=byte(cb);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    serial1.OpenComm;
    skip:=False;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    serial1.CloseComm;
end;

procedure TForm1.SerPortComboBox1Change(Sender: TObject);
begin
    serial1.CloseComm;
    serial1.OpenComm;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
    serial1.TransmittData(dat,7);
end;

end.

elundril - Do 21.10.10 19:58

Hallo,

was bei dir vermutlich derbstens bremst ist der zugriff auf die Pixel mittels Canvas.Pixels[x,y];. Verwende lieber die Scanline-Methode, das geht um einiges schneller.

BTW: Du weißt das es schon methoden gibt um die einzelnen RGB werte aus einer Farbe zu bekommen? Dann brauchtest du es nicht selbst implementieren.

BTW: Das BitBlt ist ne Windowsfunktion die, glaub ich mal gelesen zu haben, direkt auf die grafikkarte zugreift. Demnach sollte sie ziemlich schnell sein. Bei CopyRect weiß ichs nicht genau, vermute aber das selbe.

lg elundril

jaenicke - Do 21.10.10 20:12

Du hast da diverse Speicherlecks drin. Denn du ruft GetWindowDC auf und übergibst das Handle dann direkt. Dadurch, dass du es nicht zwischenspeicherst, kannst du es dann nicht mehr freigeben...

Lustig ist, dass du in finally dann nochmal ein neues Handle erzeugst und direkt wieder freigibst (Zeile 59). ;-)

shana-chan - Do 21.10.10 20:13

@elundril:

BitBlt hatte ich mal testweise rausgenommen, so das nur der restliche Code läuft. Damit war die CPU Auslastung deutlich niedriger.

Zu CopyRect habe ich gelesen das es selbst auf die StretchBlt funktion zurückgreift.

EDIT:
@jaenicke: Die Screenshot Funktionen sind nicht von mir. Die hab ich irgendwo gefunden. Da ich Delphi nicht sooo oft benutze, kenn ich mich da nicht so gut aus.

platzwart - Do 21.10.10 20:23

Schau dir mal Scanline an und zur weiteren Beschleunigung die Graphics32.

jaenicke - Do 21.10.10 20:41

shana-chan hat folgendes geschrieben :

Da ich Delphi nicht sooo oft benutze, kenn ich mich da nicht so gut aus.

Grundsätzlich muss zu jedem GetWindowDC auch ein ReleaseDC da sein. Und zwar mit genau dem Rückgabewert von GetWindowDC. Der muss also immer zwischengespeichert werden.

Wenn du das nicht machst, kann das schwerwiegende Probleme bei der Darstellung der Fenster geben...

Delete - Do 21.10.10 20:54

Man sollte auch nicht jeden Code blind übernehmen.

shana-chan - Do 21.10.10 22:11

Danke schonmal fur die Tipps. Ich werde Morgen versuchen den Code nochmal zu überarbeiten.

PS: Wen es intressiert, der kann sich hier ein Video davon anschauen: http://youtu.be/Sl6KtkffwmM

Flamefire - Fr 22.10.10 11:24

Sieht ziemlich geil aus. Was ist das für ein Licht bzw die Ansteuerung davon? (Nicht das Programm ;) )

Martok - Fr 22.10.10 11:38

Und wieder die DF-Hausband Nightwish :D
Müssen wir bald echt was kriegen von denen, so oft wie sie hier Beispiel sind und beworben werden :mrgreen:

Achja: CopyRect nutzt tatsächlich StretchBlt, die WESENTLICH langsamer ist als BitBlt, wie ich neulich bei einem anderen Projekt feststellen musste. Wenn du das selbst baust und BitBlt verwendest sollte das schon viel bringen.

shana-chan: hab übrigens deinen Doppelpost beräumt. Einfach Beitrag an den VA melden, dann kümmert sich wer drum ;)

shana-chan - Fr 22.10.10 14:09

Zitat:

Sieht ziemlich geil aus. Was ist das für ein Licht bzw die Ansteuerung davon? (Nicht das Programm ;) )

Den LED Streifen hab ich bei eBay gekauft (5 Meter 300 LEDs mit Fernbedinung).
Statt der Fernbedinung hab ich mir aber mit nem PIC-Microcontroller eine Ansteuerung gebaut. Der beckommt die Daten via RS232 (FTDI-Kabel).
Daten sind dan halt 255(Anfang),0-250(Rot),0-250(Grün),0-250(Blau),...ggf. rot2,grün2,....

Zitat:

Und wieder die DF-Hausband Nightwish

Hab das Video genommen weil da die Farben Kräftig sind und man das damit gut testen kann.

Ich hab das Programm nochmal neu geschrieben. Läuft etwas besser aber immernoch mit ca. 25% CPU Belastung. Mein Windows 7 hat sogar eine Meldung angezeigt, dass das System beeinträchtigt ist und Fragt ob das "Aero" Style ausgeschaltet werden soll...

Hier nochmal der neue 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:
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:
129:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Serial, ExtCtrls, ComCtrls, Grids, ValEdit;

type
  TForm1 = class(TForm)
    ser: TSerial;
    conf: TMemo;
    Timer1: TTimer;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    adjr: TTrackBar;
    adjg: TTrackBar;
    adjb: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;  
  dat:array[0..6] of byte;
  matrix:integer;

implementation

{$R *.dfm}

function ScreenColor(): TColor;
var
  s: pByteArray;
  d: TBitMap;
  DC: hdc;     
  Rec: TRect;
  r,g,b:int64;
  p,x,y,z:integer;
begin
  GetWindowRect(GetDesktopWindow, Rec);
  d := TBitMap.Create;
  d.PixelFormat:=pf32Bit;
  d.Width  := Rec.Right - Rec.Left;
  d.Height := Rec.Bottom - Rec.Top;
  DC := GetWindowDC(GetDesktopWindow);
  BitBlt(d.Canvas.Handle, 0, 0, d.Width, d.Height, DC, 0, 0, SRCCOPY) ;
  r:=0;
  g:=0;
  b:=0;
  z:=1;
  try    
    for y:=0 to (d.Height-1) div matrix do
      begin
        s:=d.ScanLine[y*matrix];
        for x:=0 to (d.Width-1) div matrix do
          begin
            z:=z+1;
            r:=r+s[x*matrix*4+2];
            g:=g+s[x*matrix*4+1];
            b:=b+s[x*matrix*4+0];
          //  p:=d.Canvas.Pixels[x*matrix,y*matrix];
          //  p:=getpixel(DC,x*matrix,y*matrix);  //DAUERT EEEEEWIG!
          //  r:=r+GetRValue(p);
          //  g:=g+GetGValue(p);
          //  b:=b+GetBValue(p);
          end;
        end; 
  finally
    ReleaseDC(0, DC);
    d.Free;      
    r:=r div z;
    g:=g div z;
    b:=b div z; 
    if r>250 then r:=250;
    if g>250 then g:=250;
    if b>250 then b:=250;
    result:=RGB(r,g,b);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
conf.Lines.LoadFromFile('config.ini');
adjr.Position:=StrToInt(conf.Lines[10]);
adjg.Position:=StrToInt(conf.Lines[11]);
adjb.Position:=StrToInt(conf.Lines[12]);
matrix:=StrToInt(conf.Lines[7]);
Timer1.Interval:=StrToInt(conf.Lines[4]);
ser.COMPort:=StrToInt(conf.Lines[1]);
ser.OpenComm;
Timer1.Enabled:=True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
conf.Lines[10]:=IntToStr(adjr.Position);
conf.Lines[11]:=IntToStr(adjg.Position);
conf.Lines[12]:=IntToStr(adjb.Position);
conf.Lines[7]:=IntToStr(matrix);
conf.Lines[4]:=IntToStr(Timer1.Interval);
conf.Lines[1]:=IntToStr(ser.COMPort);
conf.Lines.SaveToFile('config.ini');
ser.CloseComm;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  clr: TColor;
begin
  clr:=ScreenColor();
  color:=clr;
  dat[0]:=byte(255);
  dat[1]:=GetRValue(clr) * adjr.Position div 100;
  dat[2]:=GetGValue(clr) * adjg.Position div 100;
  dat[3]:=GetBValue(clr) * adjb.Position div 100;
  dat[4]:=dat[1];
  dat[5]:=dat[2];
  dat[6]:=dat[3];
  ser.TransmittData(dat,7);
end;

end.

Naja.. warscheinlich werd ich das dann so lassen. Funktionieren tuts ja.
Bei schnellen Bildänderungen hängt es zwar etwas. Aber da kann man wohl nicht machen.
Eigentlich Brauch ich ja nur die Durchschnitsfarbe vom Desktop bzw. dem Video und das am besten in der Aktuaellisierungsrate vom Bild.
Wenn noch wer nen Geistesblitz hat oder einen Fehler im neuem Code finted kanns ja schreiben.
Ansonsten nochmal Danke für die Hilfe.

platzwart - Fr 22.10.10 14:16

Kannst du bitte mal die Zeiten der einzelnen Schritte messen, um herauszufinden, was so ewig dauert? Dann könnte man dort nochmal punktuell optimieren...

Flamefire - Fr 22.10.10 14:31

Noch besser ist 1 Schleife. Die Anzahl der Pixel z kannst du berechnen (aus der Größe).
Dann nur einmal Scanline aufrufen und das Ergebnis als Pointer nehmen, und den dann einfach entsprechend erhöhen. Dürfte nochmal etwas schneller sein.

Kannst du dann das Projekt mal anhängen? Dann guck ich mal drüber, wo noch was geht.

Hast du nen Link zu der Leiste und dem Controller? Würd mir das gern mal angucken. Klingt sehr intressant.

Delete - Fr 22.10.10 17:05

Wie schnell läuft der Timer?
Ein Intervall von 40ms sollte genügen - entspricht 25 Änderungen pro Sekunde.

shana-chan - Fr 22.10.10 17:21

Zitat:

Kannst du bitte mal die Zeiten der einzelnen Schritte messen, um herauszufinden, was so ewig dauert? Dann könnte man dort nochmal punktuell optimieren...

Wuste garnich das man das kann.. Kanst du mir sagen wie ich das mache?

Zitat:

Kannst du dann das Projekt mal anhängen? Dann guck ich mal drüber, wo noch was geht.

Hast du nen Link zu der Leiste und dem Controller? Würd mir das gern mal angucken. Klingt sehr intressant.

Anhang unten...
LED-Stripe: http://cgi.ebay.de/5m-300-SMD-5050-RGB-Strip-RC-Wasserdicht-LED-NEU-/290429462216?pt=LH_DefaultDomain_77&hash=item439ef1e6c8
(Nicht sicher ob es der ist. Es gibt 2 varianten. Einmal mit Plus und einmal mit Minus geschaltet. Meiner ist Plus geschaltet.)
FTDI-Cable: http://www.ftdichip.com/Products/Cables/USBTTLSerial.htm
PIC16F688: http://www.microchip.com/wwwproducts/Devices.aspx?dDocName=en010215
VNQ660: http://www.st.com/stonline/stappl/productcatalog/app?path=/comp/stcom/PcStComOnLineQuery.showresult&querytype=type=product$$view=table$$orderable=yes&querycriteria=RNP139=1037$$rpncode=65684
Wo man die sachen bekommt must du sonst schauen. Das meiste hab ich über meine Arbeit besorgt.

Das Programm für den PIC kann ich leider nicht weitergeben da ich 99% vom Code von einem Produkt das wir herstellen kopiert hab.
Das Platinenlayout hab ich nicht hier. Könnte ich am Montag nachliefern.Edit: Platinenlayout angehängt.

Zitat:

Wie schnell läuft der Timer?
Ein Intervall von 40ms sollte genügen - entspricht 25 Änderungen pro Sekunde.

Ich habe einige Videos mit 60 FPS und wollte gerne dass das auch geht. Timer Leuft bei mir mit 17ms (ca. 58FPS) kann man aber in der config.ini ändern.

Hier noch das Programm/Source:
PS: Für die Serielle Schnittstelle verwende ich die "TSerial 4.2" Komponente die man anscheind nur mit der Zeitschrift "Toolbox" bekommt. Mir ist zumindest keine andere Quelle bekannt. (INFO: http://toolbox.reworld.eu/projekte/serial/index.html)

Delete - Fr 22.10.10 17:40

Von 17 auf 34ms geändert:

Vorher steigende CPU-Temperaturen und hohe Auslastung, danach "normal".

Bedenke, dass Videos normalerweise höchstens mit 30 FPS aufgenommen werden.
Wenn sie mit 60 FPS auf dem LCD gezeigt werden, ist jedes 2. Bild mit dem vorhergehenden identisch.

shana-chan - Fr 22.10.10 17:52

hathor hat folgendes geschrieben :

Ich habs eben mit 40ms getestet und da hat sich bei mir von der CPU Auslastung nichts geändert.
Bei den 60FPS Videos handelt es sich meist un zusammengeschnittene Videos die oft schneller abgespielt sind bzw. in denen Effekte z.B. Blitzen eingebaut sind.

Flamefire - Fr 22.10.10 18:13

Habs mal auf performance getestet:
Die BitBlt Funktion verbraucht 40-50ms

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:

function ScreenColor(): TColor;
var
  s: pByteArray;
  d: TBitMap;
  DC: hdc;     
  Rec: TRect;
  r,g,b:int64;
  p,x,y,z:integer;
  q1,q2,f:Int64;
begin
  QueryPerformanceFrequency(f);
  GetWindowRect(GetDesktopWindow, Rec);
  d := TBitMap.Create;
  d.PixelFormat:=pf32Bit;
  d.Width  := Rec.Right - Rec.Left;
  d.Height := Rec.Bottom - Rec.Top;
  DC := GetWindowDC(GetDesktopWindow);
  QueryPerformanceCounter(q1);
  BitBlt(d.Canvas.Handle, 0, 0, d.Width, d.Height, DC, 0, 0, SRCCOPY) ;
  QueryPerformanceCounter(q2);
  Form1.conf.Lines.Add(inttostr((q2-q1)*1000 div f));
  r:=0;
  g:=0;
  b:=0;
  z:=1;
  try
    for y:=0 to (d.Height-1) div matrix do
      begin
        s:=d.ScanLine[y*matrix];
        for x:=0 to (d.Width-1) div matrix do
          begin
            z:=z+1;
            r:=r+s[x*matrix*4+2];
            g:=g+s[x*matrix*4+1];
            b:=b+s[x*matrix*4+0];
          //  p:=d.Canvas.Pixels[x*matrix,y*matrix];
          //  p:=getpixel(DC,x*matrix,y*matrix);  //DAUERT EEEEEWIG!
          //  r:=r+GetRValue(p);
          //  g:=g+GetGValue(p);
          //  b:=b+GetBValue(p);
          end;
        end; 
  finally
    ReleaseDC(0, DC);
    d.Free;      
    r:=r div z;
    g:=g div z;
    b:=b div z; 
    if r>250 then r:=250;
    if g>250 then g:=250;
    if b>250 then b:=250;
    result:=RGB(r,g,b);
  end;
end;

Da also mal gucken, obs was besseres gibt. Der Rest zusammen ist ~0ms

shana-chan - Fr 22.10.10 20:10

Zitat:

Die BitBlt Funktion verbraucht 40-50ms

Genau das meinte ich ganz am Anfang:

Zitat:

Das Hauptproblem scheint die BitBlt/CopyRect Rutine zu sein.

Aber jetzt ist es wissenschaftlich untermauert.
Ich habs selbst noch auf 3 PCs getestet. Waren immer 40-60ms. EDIT: mit laufendem Video sogar 70-80ms (teilweise sogar über 100ms)
Ich hab gelesen, dass es iregendwie mit directx gehen soll. Aber wie das geht hab ich leider nichts zu gefunden.

EDIT2: wenn ich die Farbtiefe von Windows auf 16 Bit stelle komme ich auf 10-20ms, was schon deutlich zu merken ist. Aber so die ganz schöne Lösung ist das auch nicht...

EDIT3 ich verwende jetzt "GetForeGroundWindow" statt "GetDesktopWindow" damit holt der sich nur das ausgewählte Fenster ist aber auch bei einem Video in Vollbild deutlich schneller. (10-20ms)

elundril - Fr 22.10.10 20:48

Bringt zwar nicht viel aber das z kannst du auch anders berechnen und zwar außerhalb der schleife:

Delphi-Quelltext

1:	z := MulDiv(d.Height-1, d.Width-1, matrix);

das einfach vor oder nach der schleife und statt das es nun n mal ein inc eingesetzt wird hast du eine konstante laufzeit unabhängig von der größe. Zusätzlich ist MulDiv angeblich sehr schnell.

lg elundril

Delete - Fr 22.10.10 21:26

Das ideale Pixelformat für die Bearbeitung mit ScanLine ist 24Bit, deshalb d.PixelFormat:= pf24Bit;

elundril - Fr 22.10.10 21:51

Müsst man halt eine gute Balance finden. Warum sollt ich auf Scanline optimieren wenn BitBlt viel mehr Laufzeit verbraucht? Da schau ich doch das ich BitBlt schneller läuft und das scanline nicht so viel dazubekommt.

lg elundril

//Edit: hab zwar nicht das komplette Topic durchgelesen aber hier mal die DirectX-Variante: http://www.delphipraxis.net/22278-screenshot-mit-directx.html

shana-chan - Sa 23.10.10 01:12

hathor hat folgendes geschrieben :

Das ideale Pixelformat für die Bearbeitung mit ScanLine ist 24Bit, deshalb d.PixelFormat:= pf24Bit;

Hab garnicht gesehen das es schon eine 2te Seite gibt. War grade selbst drauf gekommen .. hat aber leider nur wenig gebracht.

Auserdem verwende ich jetzt "GetForeGroundWindow" statt "GetDesktopWindow" damit holt der sich nur das ausgewählte Fenster ist aber auch bei einem Video in Vollbild deutlich schneller. (10-20ms) EDIT: Nachteil ist, dass man abundzu Felermeldungen bekommt. ("Ungültiges Handle" und "Division durch Null") EDIT2: korrigiert.. scheint so besser zu gehen. EDIT3: Doch nicht besser. EDIT4: und die meldung "Scanline out of range".

Neuer 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:
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:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Serial, ExtCtrls, ComCtrls, Grids, ValEdit;

type
  TForm1 = class(TForm)
    ser: TSerial;
    conf: TMemo;
    Timer1: TTimer;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    adjr: TTrackBar;
    adjg: TTrackBar;
    adjb: TTrackBar;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;  
  dat:array[0..6] of byte;
  matrix:integer;

implementation

{$R *.dfm}

function ScreenColor(): TColor;
var
  s: pByteArray;
  d: TBitMap;
  DC: hdc;     
  Rec: TRect;
  r,g,b:int64;
  p,x,y,z:integer;    
  q1,q2,f:Int64;
begin            
  QueryPerformanceFrequency(f);
  try GetWindowRect(GetForeGroundWindow, Rec);
  finally
    d := TBitMap.Create;
    d.PixelFormat:=pf24Bit;
    d.Width  := Rec.Right - Rec.Left;
    d.Height := Rec.Bottom - Rec.Top;
    DC := GetWindowDC(GetForeGroundWindow);
    QueryPerformanceCounter(q1);
    BitBlt(d.Canvas.Handle, 0, 0, d.Width, d.Height, DC, 0, 0, SRCCOPY) ;
    QueryPerformanceCounter(q2);
    Form1.Label1.Caption:='ms for BilBlt: '+inttostr((q2-q1)*1000 div f);
    r:=0;
    g:=0;
    b:=0;
    for y:=0 to (d.Height-1) div matrix do
      begin
        s:=d.ScanLine[y*matrix];
        for x:=0 to (d.Width-1) div matrix do
          begin
            r:=r+s[x*matrix*3+2];
            g:=g+s[x*matrix*3+1];
            b:=b+s[x*matrix*3+0];
          end;
        end;
    ReleaseDC(0, DC);
    z:=((d.Height-1) div matrix)*((d.Width-1) div matrix);
    d.Free;
    r:=r div z;
    g:=g div z;
    b:=b div z;
    if r>250 then r:=250;
    if g>250 then g:=250;
    if b>250 then b:=250;
    result:=RGB(r,g,b);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
conf.Lines.LoadFromFile('config.ini');
adjr.Position:=StrToInt(conf.Lines[10]);
adjg.Position:=StrToInt(conf.Lines[11]);
adjb.Position:=StrToInt(conf.Lines[12]);
matrix:=StrToInt(conf.Lines[7]);
Timer1.Interval:=StrToInt(conf.Lines[4]);
ser.COMPort:=StrToInt(conf.Lines[1]);
ser.OpenComm;
Timer1.Enabled:=True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
conf.Lines[10]:=IntToStr(adjr.Position);
conf.Lines[11]:=IntToStr(adjg.Position);
conf.Lines[12]:=IntToStr(adjb.Position);
conf.Lines[7]:=IntToStr(matrix);
conf.Lines[4]:=IntToStr(Timer1.Interval);
conf.Lines[1]:=IntToStr(ser.COMPort);
conf.Lines.SaveToFile('config.ini');
ser.CloseComm;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  clr: TColor;
begin
  clr:=ScreenColor();
  color:=clr;
  dat[0]:=byte(255);
  dat[1]:=GetRValue(clr) * adjr.Position div 100;
  dat[2]:=GetGValue(clr) * adjg.Position div 100;
  dat[3]:=GetBValue(clr) * adjb.Position div 100;
  dat[4]:=dat[1];
  dat[5]:=dat[2];
  dat[6]:=dat[3];
  ser.TransmittData(dat,7);
end;

end.

elundril - Sa 23.10.10 01:17

bei deiner z-berechnung könntest du das div Matrix rausheben.

Quelltext

1:	(a/b) * (c/b) = (a*c) /b

Und dafür gibts dann die Methode MulDiv, welche schneller ist als eine multiplikation mit anschließender Division durch delphi. ;) Eben so wie ich gepostet habe. ;)

btw: so wie du das try finally verwendest hat es gar keinen sinn.

lg elundril

shana-chan - Sa 23.10.10 01:28

elundril hat folgendes geschrieben :

bei deiner z-berechnung könntest du das div Matrix rausheben.

Quelltext

1:	(a/b) * (c/b) = (a*c) /b

Da spuckt er mir nurnoch ein schwarzes Bild aus?

elundril hat folgendes geschrieben :

Und dafür gibts dann die Methode MulDiv, welche schneller ist als eine multiplikation mit anschließender Division durch delphi. ;) Eben so wie ich gepostet habe. ;)

lg elundril

Und hier eine Felermeldung (Zugriffsverletzung)?

Naja.. hab mir dan gedacht: Das bischen rechnen wird der jetzt wohl noch abkönnen.

elundril - Sa 23.10.10 01:36

:autsch: hast recht. das distributivgesetz gilt ja nur bei (a+b)*(a+c). mein fehler, sorry!

//Edit: Könnte dir vielleicht CreatecompatibleBitmap(GetWindowDC(GetForegroundWindow), width, height); einen Geschwindigkeitsvorteil bieten. Eventuell umgeht das das BitBtl und du bekommst ein fix und fertiges Bitmap zurückgeliefert. Bzw das Handle auf ein Bitmap und das wiederrum bietet das ganze Zeug fürs Scanline.

lg elundril

shana-chan - Sa 23.10.10 02:26

elundril hat folgendes geschrieben :

CreatecompatibleBitmap(GetWindowDC(GetForegroundWindow), width, height);

Bekomme ich nur schwarz/weiss. Oder ich mach was falsch.

Ich hab
BitBlt(d.Canvas.Handle, 0, 0, d.Width, d.Height, DC, 0, 0, SRCCOPY) ;
in
d.Handle:=CreatecompatibleBitmap(GetWindowDC(GetForegroundWindow), d.width, d.height); <- Schwarz
oder
d.Canvas.Handle:=CreatecompatibleBitmap(GetWindowDC(GetForegroundWindow), d.width, d.height); <- Weiss
geändert.

elundril - Sa 23.10.10 03:27

Hmm, mein Fehler. Ich hab gerade nochmal nachgesehen und bin draufgekommen das in der nacht wohl mein Englisch nachlässt. Dieser Code erzeugt leider nur ein Bitmap, das wohl noch nicht gefüllt ist, jedoch anscheinend das selbe Pixelformat usw wie der DeviceContext hat. Mea Culpa.

lg elundril

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!