Screenshot / Bildschirmfoto, optimiert ..

[corpsman]

Guten Morgen,

Ich habe mir ein Programm geschrieben, welches sehr viele Screenshots in sehr kurzer Zeit erstellt.

Und dazu habe ich ( http://wiki.lazarus.freepascal.org/Deve ... the_screen ) benutzt. Das Ganze geht auch wunderbar. Nun ist es aber so, dass ich in meiner Anwendung immer nur Bildbereiche von ca. 40* 80 Pixeln raus kopieren will.

Code: Alles auswählen

Procedure TForm1.Timer1Timer(Sender: TObject);
Begin
  ScreenDC := GetDC(0);
  MyBitmap.LoadFromDevice(ScreenDC);
  outbmp.Canvas.CopyRect(destr, MyBitmap.Canvas, sourcer);
  outbmp.SaveToFile(edit1.text + inttostr(fstfrme) + '.bmp');
  ReleaseDC(0, ScreenDC);
  fstfrme := fstfrme + 1;
End;

Gibt es nun irgend eine Lösung, mit welcher man nur kleine Bildbereiche kopieren kann, ohne jedes mal einen Kompletten Screenshot zu machen ?
Unter Delphi gings, allerdings habe ich den dazu gehörigen Source leider verloren, habe nur noch die Binary, und die ist ja Windows, bringt mir also nicht sehr viel

[theo]

Lustig, bei mir ist diese Woche die gleiche Frage aufgetaucht.

Bin auf folgende Erkenntnisse gekommen:
Wenn du die den Sourcecode von MyBitmap.LoadFromDevice zurückverfolgst, kommst du irgendwann auf:

Code: Alles auswählen

procedure TLazIntfImage.LoadFromDevice(DC: HDC);
...
  GetDeviceSize(DC, DeviceSize);
  R := Rect(0,0,DeviceSize.X,DeviceSize.Y);
  if not RawImage_FromDevice(RawImage, DC, R) then
...

Es ist also zumindest vorgesehen, das Rect wird aber nicht als Proc. Param. zur Verfügung gestellt.
Ich hab dann mal die LCL abgeändert, so dass ich das Rect bestimmen kann.
Es hat unter GTK2 geklappt. Warsch. geht's auch unter Windows.
Die LCLQt allerdings ignoriert den Parameter völlig.

[corpsman]

Das liest sich irgendwie kompliziert,

Aber danke für den Denkanstoß, mal schauen was ich daraus machen kann...

[mschnell]

Ich habe vor einiger Zeit 'mal ein Programm-Paar gemacht, das einen rechteckigen Bildschirm-Ausschnitt per TCP/IP von einem PC auf einen anderen in "realtime" überträgt. Dazu habe ich den Bildschirm-Auslese Code von VNC geklaut und in Pascal portiert.

Wenn ich am Dienstag wieder im Büro bin, kann ich den Code posten.

-Michael

[DiBo33]

Da musst du doch normal nur destr und sourcer in CopyRect() entsprechend anpassen.

[corpsman]

@ mschnell
Ja bitte, würde mich sehr Freuen.

@ DiBo33
destr und sourcer sind entsprechend angepasst. Es geht darum das MyBitmap den kompletten Screen beinhaltet und das vermieden werden soll.

[corpsman]

Also ich habe mal versucht dein Sample um zu setzen ..


GetDesktopWindow gibt es wohl nur unter Windows ..

Code: Alles auswählen

tr = Tpoint ( obere Linke Ecke des zu kopierenden Bereichs )
br = Tpoint ( untere Rechte Ecke des zu kopierenden Bereichs )
 
Procedure TForm1.Button6Click(Sender: TObject);
Var
  DesktopBitmap: Tbitmap;
  DesktopHDC: HDC;
  // DesktopHandle: HWND;
Begin
 
  DesktopBitmap := TBitmap.Create;
  DesktopBitmap.Width := br.x - tl.x;
  DesktopBitmap.Height := br.y - tl.y;
 
  DesktopBitmap.PixelFormat := pf24bit;
 
  //  DesktopHandle := GetDesktopWindow;
  DesktopHDC := GetDC(0);
 
  //Function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
  //{$IFDEF IF_BASE_MEMBER} virtual;
  //{$ENDIF}
 
//  outbmp.Canvas.CopyRect(destr, MyBitmap.Canvas, sourcer);
 
  BitBlt(DesktopBitmap.Canvas.Handle, 0, 0, br.x - tl.x, br.y - tl.y,
    DesktopHDC, tl.x, tl.y, SrcCopy);
 
  //  ReleaseDC(DesktopHandle, DesktopHDC);
  DesktopBitmap.SaveToFile('Blub.bmp');
  ReleaseDC(0, DesktopHDC);
  DesktopBitmap.free;
 
End;

Leider sehe ich immer nur ein schwarzes Ergebnissbild

[mschnell]

GetDesktopWindow gibt es wohl nur unter Windows ..

Falls Du meinen Code probieren willst (den ich im falschen Thread gepostet habe, den Du aber trotzdem gefunden hast):
Auch der ist für Windows (und außerdem nur mit Delphi getestet). Ich habe es aus der Windows-Version von VNC portiert. Wenn Du was für Linux brauchst, solltest Du Dir den Sourcecode vom VNC Server für Linux besorgen und den code von da nach Pascal portieren.

Gruß,
-Michael

[corpsman]

Danke für den Tipp, das klärt einiges, und ja ich brauche es für Linux ...