Screenshot - Rahmen um Bereich ziehen

[Mazel]

Guten Abend zur späten Stund,

nun, ich bin dabei ein Programm zu schreiben, welches vom Desktop ein Screenshot erstellen soll jedoch nur von einem bestimmten Bereich, den man mit der Maus durch ziehen eines Rahmens auswählt. Das Bild von der jeweiligen Position zu ermitteln ist nicht das Problem, vielmehr das Zeichnen und Refreshen des Rahmens auf den Desktop selbst.

Es ergibt sich das Problem, dass die alten Rahmen beim MouseMove nicht verschwinden, was sich im Anhang befindliche Bild verdeutlichen soll. Ich zeichne im pmNotXor.

Auf einer Form gibt es das Problem nicht, wenn ich mit FillRect arbeite, auf dem Desktop schon. Gibt es dafür eine Lösung?

Gruß
Marcel

[Luckie]

Ob du es glaubst oder nicht, aber dein bisheriger Code wäre bestimmt bei der Lösungsfindung äußerst hilfreich.

Warum muss man solche essentiellen Informationen immer erst fordern? :roll:

[himitsu]

Zitat:

Zitat von Mazel

Gibt es dafür eine Lösung?

Ja, aber wie Luckie schon sagte...

Zitat:

Zitat von Mazel

Auf einer Form gibt es das Problem nicht, wenn ich mit FillRect arbeite, auf dem Desktop schon.

Das heißt, ohne FillRect geht es auf der Form auch nicht?

pmNotXor ... NOT und/oder XOR ist schon gut, aber man muß den Rahmen dann auch wieder löschen.

XOR+XOR=nichts
NOT+NOT=nichts

Also einfach den Rahmen nochmal übermalen und weg ist er ... wie sollte er denn sonst verschwinden.
(OK, abgesehn von 'nem kompletten Desktop-Refresh)

[Mazel]

Mahlzeit,

Zitat:

Zitat von Luckie

[...] Warum muss man solche essentiellen Informationen immer erst fordern? :roll:

Ich nahm an, dass es sich um ein bekanntes Problem handelt, nun gut, hier der Code.

Ich hatte heute morgen noch etwas daran gearbeitet, aktuell schaut es nun so aus: Das Hauptformular wird maximiert und transparent geschalten, danach wird auf den DCanvas (Desktop Canvas) gezeichnet. Am Ende wird das Formular wird sichtbar gemacht. Die Transparentschaltung wurde hier weggelassen, lediglich die Zeichnungen.

Delphi-Quellcode:

var
 Form1: TForm1;
 xpos, ypos, xposEnd, yposEnd: integer;
 draw : boolean = false;
 DCanvas: TCanvas;
 DHandle: HWND;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 draw := true;
 Xpos := X;
 Ypos := y;
 DHandle := GetDC(0);
 DCanvas := TCanvas.Create;
 try
  DCanvas.Handle := DHandle;
  DCanvas.Brush.Style:=bsClear;
  DCanvas.Pen.Color := clRed;
  DCanvas.Pen.Mode := pmNotXor;
  DCanvas.Pen.Width := 3;
 except
  ReleaseDC(0, DHandle);
 end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);

begin
if draw and (DHandle <> 0) then
 try
  // hier vorher ein FillRect, Refresh oder Repaint eingesetzt, was nicht funktioniert
  DCanvas.Rectangle(Xpos, Ypos, x, y);
 except
   ReleaseDC(0, DHandle);
 end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
 bitmap: TBitmap;
 OldBkMode: integer;

begin
 xposend := x;
 yposEnd := y;
 draw := False;
 if DHandle <> 0 then
  try
   Bitmap := TBitmap.Create;
   Bitmap.Width := Screen.Width;
   Bitmap.Height := Screen.Height;
   BitBlt(Bitmap.Canvas.Handle, 0, 0, xposend - xpos, yposend - ypos, DHandle, xpos, ypos, SRCCOPY);
   OldBkMode := SetBkMode(Bitmap.Canvas.Handle, Ord(TRANSPARENT));
   Bitmap.Canvas.Font.Color := clred;
   Bitmap.Canvas.TextOut(10, 10, 'Captured By MJ');
   SetBkMode(Bitmap.Canvas.Handle, OldBkMode);
   Image1.Picture.Bitmap := bitmap;
  finally
   ReleaseDC(0, DHandle);
   DCanvas.Free;
   ManageVisibility(Handle);
   Image1.Visible := True;
 end;
end;

Gruß
Marcel

[himitsu]

Zugehört?

du mußt "NUR" das alte Rechteck übermalen.


[down]
Rechteck zeichnen
und Position merken

[move]
gemerktes Rechteck übermalen
neues Rechteck zeichnen
und neue Position merken

[alternatives move]
neues Rechteck zeichnen
gemerktes Rechteck übermalen
und neue Position merken

[up]
gemerktes Rechteck übermalen

[Mazel]

Vielen Dank himitsu, diese Info war hilfreich zum Erfolg.

Gruß
Marcel

[Blup]

Die eigentliche Frage ist ja schon beantwortet. Man kann auch in der Delphi-Hilfe nach pmNotXor suchen, 2. Eintrag "Bewegungen zwischenspeichern" beschreibt wie man so ein Gummiband programmiert.

Die Variablen ab xpos gehören im private-Abschnitt des Formulars/Klasse deklariert.

Hier wird DHandle zwei mal freigegeben:

Delphi-Quellcode:

ReleaseDC(0, DHandle); 
DCanvas.Free;

Einmal direkt und einmal durch den Canvas, der sich als Eigentümer des Handles betrachted.
(Aktuelle Windowsversionen sind zum Glück so stabil, daß sie solche Programmierfehler nicht mit einem Totalabsturz beantworten.)

Deshalb sind auch die Exceptblöcke mit ReleaseDC falsch.
Ist das Handle einmal dem TCanvas zugewiesen, ist die Variable DHandle überflüssig.
Überprüfen kann man Assigned(DCanvas), sollten diesen dann aber auch mit FreeAndNil(DCanvas) freigeben.

[Mazel]

Zitat:

Zitat von Blup

Die Variablen ab xpos gehören im private-Abschnitt des Formulars/Klasse deklariert.

Zum geringhalten der Codezeilen hier, habe ich diese aus dem "private" kopiert.

Zitat:

Zitat von Blup

Hier wird DHandle zwei mal freigegeben:

Delphi-Quellcode:

ReleaseDC(0, DHandle); 
DCanvas.Free;

Einmal direkt und einmal durch den Canvas, der sich als Eigentümer des Handles betrachted.
(Aktuelle Windowsversionen sind zum Glück so stabil, daß sie solche Programmierfehler nicht mit einem Totalabsturz beantworten.)

Danke für den Hinweis, war mir so nicht bewusst. :)
Ich werde die Überprüfung mit Assigned vornehmen um mögliche Probleme abzufangen.