eingegrenzter Screenshot

[Evian]

Ich habe in der Codelibrary folgenden Code, zum erzäugen
einens Screenshots gefunden:

Code:

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;

Nun möchte ich aber kein Bitmap vom Gesammten Bildschirm, sondern nur
eines bestimmten Bereiches. Also von Position x1/y1 bis x2/y2. Ich habe
schon ein wenig am Code rumgewurschtelt, aber bis jetzt ist nix wirklich brauchbares
rausgekommen. Kann mir vielleicht jemand einen Tip geben, was ich am Code verändern muss, damitt es
funktioniert?!

[BluesKid]

Moin moin

vieleicht kann dir das helfen..ist nich (alles) von mir ;-)

Delphi-Quellcode:

function TForm1.getScreen(aRect: TRect) : TBitmap;
var DCPuffer, DC: HDC;
  Puffer: HBitmap;
  x, y: integer;
  Bild2 : TBitmap;

begin
  (*macht einen Screenshot von aRect *)

  Bild2 := TBitmap.Create;

  (*Devicekontext holen *)
  DC:=CreateDC('DISPLAY', nil, nil, nil);

  (* relative x und y abmessungen ausrechnen *)
  x:= aRect.Right - aRect.left;
  y:= aRect.Bottom - aRect.Top;

  (*Devicekontext zum Zeischenspeichern *)
  DCPuffer:=CreateCompatibleDC(DC);
  Puffer:=CreateCompatibleBitmap(DC, x, y);
  Application.ProcessMessages;
  SelectObject(DCPuffer,Puffer);

  (*Kopieren von Bildschirmausschnitt in Puffer *)
  BitBlt(DCPuffer, 0, 0, x, y, dc, aRect.left, aRect.top, srccopy);

  Bild2.Width:=x;
  Bild2.Height:=y;

  (*Kopieren von Puffer nach TBitmap *)
  BitBlt(Bild2.canvas.Handle, 0, 0, x, y, DCPuffer, 0, 0, srcCopy);

  (*Aufräumen *)
  DeleteDC(DCPuffer);
  DeleteDC(DC);

  Application.ProcessMessages;

  result := Bild2;
end;

..und ist u.U. auch noch stark verbesserungswürdig :-)

schönen Gruß

Sam

[Evian]

Naja das Ruckelt ein Wenig zu viel :) ...

ich habs jetzt mit na Procedure von den Schweizern (Link)
gemacht. Und es funzt ganz gut!

gruss


Evian