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

markieren

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?!

Moin moin

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

zusammenfalten · markieren

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

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