Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Grafik / Sound / Multimedia (https://www.delphipraxis.net/21-library-grafik-sound-multimedia/)
-   -   Delphi Screenshot schnell erzeugen (https://www.delphipraxis.net/114-screenshot-schnell-erzeugen.html)

sakura 12. Jun 2002 10:13


Screenshot schnell erzeugen
 
Hi DPler,

diesen Beitrag habe ich zum ersten mal am 24.12.2001 auf Delphi3000.com veröffentlicht. Nach und nach werde ich mehrere meiner dortigen Beiträge hier unterbringen und Euch zur Verfügung stellen.

Die folgende Routine ermöglicht es, eine "Momentaufnahme" vom Bildschirm in ein Bitmap zu speichern. Das Bitmap wird durch die Funktion erstellt und als Ergebnis zurückgeliert. Also, nicht vergessen das Bitmap später wieder freizugeben.

Der Code ist auf Geschwindigkeit getrimmt. Da Windows auf vielen Rechnern ein Problem hat, den gesamten Bildschirminhalt auf einen "Schlag" zurückzliefern, wird immer nur ein kleiner Bereich angefordert und in das Ergebnis übernommen. Es ist immer noch nicht die schnellste Variante. Aber es findet auch eine automatische Konvertierung in ein device-independent Format statt, welches meistens benötigt wird.

Delphi-Quellcode:
const
  cTileSize = 50;

function TForm1.GetScreenShot: TBitmap;
var
  Locked: Boolean;
  X, Y, XS, YS: Integer;
  Canvas: TCanvas;
  R: TRect;
begin
  Result := TBitmap.Create;
  Result.Width := Screen.Width;
  Result.Height := Screen.Height;
  Canvas := TCanvas.Create;
  Canvas.Handle := GetDC(0);
  Locked := Canvas.TryLock;
  try
    XS := Pred(Screen.Width div cTileSize);
    if Screen.Width mod cTileSize > 0 then
      Inc(XS);
    YS := Pred(Screen.Height div cTileSize);
    if Screen.Height mod cTileSize > 0 then
      Inc(YS);
    for X := 0 to XS do
      for Y := 0 to YS do
      begin
        R := Rect( 
          X * cTileSize, Y * cTileSize, Succ(X) * cTileSize,
          Succ(Y) * cTileSize
        );
        Result.Canvas.CopyRect(R, Canvas, R);
      end;
  finally
    if Locked then
      Canvas.Unlock;
    ReleaseDC(0, Canvas.Handle);
    Canvas.Free;
  end;
end;
Viel Erfolg...

[edit=flomei]Wir "räumen auf", daher Titel geändert... Mfg, flomei[/edit]


Alle Zeitangaben in WEZ +1. Es ist jetzt 18:37 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz