Screenshot anhand Mausposition

[Nisbo]

Moin Moin

ich versuche gerade einen Screenshot anhand der Mausposition zu machen, also der start soll die Mausposition sein und das ende unten links, allerdings passt das alles nicht so richtig, zuerst hatte ich zwar den beginn an der richtigen stelle, nur hatte dann links und oben schwarze balken, jetzt habe ich es mit 2 rect versucht, aber dann kommen teilweise verzerrte bilder raus oder nur schwarz

wie muß ich die rects jetzt am besten anpassen ?

Delphi-Quellcode:

procedure ScreenShot(Bild: TBitMap);
var
  c   : TCanvas;
  r,a : TRect;
  breite, oben, links, hoehe : integer;
  MausPos: TPoint;
begin
  c        := TCanvas.Create;
  c.Handle := GetWindowDC(GetDesktopWindow);

  try

    GetCursorPos(MausPos);

    links  := MausPos.x;
    oben   := MausPos.y;
    hoehe  := Screen.Height - oben;
    breite := Screen.Width  - links;
  
    a           := Rect(links, oben, breite, hoehe);
    r           := Rect(0, 0, breite, hoehe);
    Bild.Width  := breite;
    Bild.Height := hoehe;
    Bild.Canvas.CopyRect(r, c, a);
  finally
    ReleaseDC(0, c.Handle);
    c.Free;
  end;
end;

[sniper_w]

Und so läuft es :wink:

Delphi-Quellcode:

procedure ScreenShot(var Bild: TBitMap);
var
  Mydc : cardinal;
  MausPos: TPoint;
begin
  MyDc := GetDC(0);
  GetCursorPos(MausPos);
  Bild.PixelFormat := pf32bit;
  Bild.Width := Screen.Width - MausPos.X;
  Bild.Height := Screen.Height - MausPos.Y;
  BitBlt(Bild.Canvas.Handle,0,0,Bild.Width,Bild.Height,Mydc,MausPos.X,MausPos.Y,SRCCOPY);
  Bild.SaveToFile('c:\Pic.bmp');
  ReleaseDC(0, Mydc);
end;

procedure TForm1.Button1Click(Sender: TObject);
 var MyPic : TBitmap;
begin
 MyPic := TBitmap.Create;
 ScreenShot(MyPic);
 MyPic.Free;
end;

[Nisbo]

Das ist ja aber leider nicht das was ich vorhabe, denn ich lade es ja in ein TImage :(
deshalb ja auch die frage wie ich die rects anpassen muß

[SirThornberry]

und was hindert dich daran das ganze in ein TImage zu laden?

[sniper_w]

Nun ja. Wie wäre es damit: :roll:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
ScreenShot(Image1.Picure.Bitmap);
end;

[Nisbo]

... das er mir für diese Zeile:

ScreenShot(Image1.Picture.BitMap);

folgenden fehler ausgibt:

Argument cant't be assigned to

[glkgereon]

wahrscheinlich is Bitmap eine property, und die können net als var-parameter mitgegeben werden (mein ich zumindes)

probier es mal so:

Delphi-Quellcode:

Temp:=TBitmap.Create;
Temp:=xxx.Bitmap;
ScreenShot(Temp);
xxx.Bitmap:=Temp;
Temp.Free;

[Nisbo]

jetzt satgt er mir:

no identifier found for xxx / Temp
als was muß das deklariert werden ?

var xxx : ???
var Temp : ???

Sorry bin nicht unbedingt der fitteste :D

EDIT:

var Temp: TBitmap;

aber xxx ?

EDIT 2: arg denke mal das war das: Image1.Picture

Delphi-Quellcode:

procedure TForm7.Button3Click(Sender: TObject);
var Temp: TBitmap;
begin
  Form7.Visible := False;
  Sleep(1000);
  // ScreenShot(Image1.Picture.BitMap);
  Temp:=TBitmap.Create;
  Temp:=Image1.Picture.Bitmap;
  ScreenShot(Temp);
  Image1.Picture.Bitmap:=Temp;
  Temp.Free;
  Form7.Visible := True;
end;

allerdings bekomme cih dann beim compilen:

Project Editor raised exteption class 'External: SIGSEGV'.

danach dann:

Die Datei "i386.inc" wurde nicht gefunden ?

[sniper_w]

Zitat:

Project Editor raised exteption class 'External: SIGSEGV'.

danach dann:

Die Datei "i386.inc" wurde nicht gefunden ?

Dieser Fehler liegt irgendwo anders, aber nicht im geposteten Code.

[Nisbo]

mmm OK vielleicht könnten wir dann meinen ursprungscode versuchen umzustellen so das es passt ? sitze da jetzt schon 3 Tage lang fest und irgendwann verliert man dann leider die Lust daran :(

[Airblader]

Zitat:

Zitat von Nisbo

mmm OK vielleicht könnten wir dann meinen ursprungscode versuchen umzustellen so das es passt ? sitze da jetzt schon 3 Tage lang fest und irgendwann verliert man dann leider die Lust daran :(

Nunja, debuggen gehört dazu und nimmt oft den größten Teil der Zeit ein ;)

[sniper_w]

Na, wenn das nicht weiter hilft, dann....

Delphi-Quellcode:

procedure ScreenShot(var Bild: TBitMap;Untenrechts : boolean = False);
var
  Mydc : cardinal;
  MausPos: TPoint;
begin
  MyDc := GetDC(0);
  GetCursorPos(MausPos);
  Bild.PixelFormat := pf32bit;

 if Untenrechts then
 begin
// unten rechts
  Bild.Width := Screen.Width - MausPos.X;
  Bild.Height := Screen.Height - MausPos.Y;
  BitBlt(Bild.Canvas.Handle,0,0,Bild.Width,Bild.Height,
         Mydc,MausPos.X,MausPos.Y,SRCCOPY);
 end
        else
 begin
// Unten links
  Bild.Width := MausPos.X;
  Bild.Height := Screen.Height - MausPos.Y;
  BitBlt(Bild.Canvas.Handle,0,0,Bild.Width,Bild.Height,
         Mydc,0,MausPos.Y,SRCCOPY);
 end;
  ReleaseDC(0, Mydc);
end;

procedure TForm1.Button1Click(Sender: TObject);
 var tempBild: TBitmap;
begin
tempBild := TBitmap.Create;
 ScreenShot(tempBild); // oder ScreenShot(tempBild, True);
 Image1.Picture.Assign(tempBild);
tempBild.Free;
end;

[Nisbo]

@ sniper_w

vielen Dank, das hat mir jetzt weitergeholfen, gibt zwar noch nen kleiens Problem das Image1 vor dem nächsten Shot nicht geleert wird, aber das bekomme schon noch hin :)

Jetzt habe ich auch gleich noch was nebenbei gelernt denn ich bin davon ausgegangen das X + Y der MausCords jeweils oben links ist

[Nisbo]

So habe fertig :)
Hier natürlich noch der komplette Code für alle die mal das selbe vorhaben:

Delphi-Quellcode:

procedure ScreenShot(var Bild: TBitMap; startX2 : string; startY2 : string; endeX2 : string; endeY2 : string);
var
  Mydc    : cardinal;
  MausPos : TPoint;
  startX, startY, endeX, endeY : integer;
begin

     startX := strtoint(startX2);
     endeX  := strtoint(endeX2);
     startY := strtoint(startY2);
     endeY  := strtoint(endeY2);

     MyDc := GetDC(0);
     GetCursorPos(MausPos);
     Bild.PixelFormat := pf32bit;

      begin
         Bild.Width  := endeX - startX;
         Bild.Height := endeY - startY;

         if Bild.Width  < 0 then Bild.Width  := Bild.Width  * -1;
         if Bild.Height < 0 then Bild.Height := Bild.Height * -1;

         BitBlt(Bild.Canvas.Handle,0,0,endeX,(Screen.Height - startY),Mydc,startX,startY,SRCCOPY);
      end;
      ReleaseDC(0, Mydc);
end;

procedure TForm7.Button3Click(Sender: TObject);
var tempBild: TBitmap;
begin
   WindowState    := wsminimized;
   Image1.picture := nil;
   tempBild       := TBitmap.Create;
   Sleep(1000);
   ScreenShot(tempBild,Edit2.Text,Edit1.Text,Edit3.Text,Edit4.Text);
   Image1.Picture.Assign(tempBild);
   tempBild.Free;
   WindowState    := wsNormal;
   Form7.BringToFront;
   SetForegroundWindow(FindWindow(nil,'Screenshot'));
end;

Info: Die Eingabe der Cords erfolgt über 4 TEdit Felder

[sniper_w]

Also nochmals...

Zitat:

Project Editor raised exteption class 'External: SIGSEGV'.

danach dann:

Die Datei "i386.inc" wurde nicht gefunden ?

Warum hast du nicht erwähnt dass es um Lazarus handelt ? :zwinker:
Mit delphi hat man dieses Problemm nicht. :wink:

[RonnyKIEL]

Hat er doch gleich in der ersten Mail geschrieben:

Sprache: Lazarus
Gruss, Ronny