Screenshot anhand Mausposition

[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