screenshot als jpeg

[ShoAn]

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  aScreenShot('bildsche.jpeg', 75, 640, 480);
end;

[Tim.exe]

Den Thread möchte ich nochmal kurz beleben

Bei mir funktioniert das ganze nicht so einwandfrei.

Also ich habe als erstes die Funktion um einen Screenshot zu machen:

Delphi-Quellcode:

function GetScreenShot: TBitmap; 
var 
  Desktop: HDC; 
begin 
  Result  := TBitmap.Create; 
  Desktop := GetDC(0); 
  try
    try 
      Result.PixelFormat := pf32bit; 
      Result.Width       := Screen.Width; 
      Result.Height      := Screen.Height; 
      BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY); 
      Result.Modified := True; 
    finally 
      ReleaseDC(0, Desktop); 
    end; 
  except 
    Result.Free; 
    Result := nil; 
  end;
end;

Dann die Procedure um das Bild in TImage in Jpeg zu konvertieren:

Delphi-Quellcode:

procedure aScreenShot(const aFileName: String; Quality, Width, Height : Integer);
var 
  aDC       : hDC; 
  aBmp      : TBitmap; 
  aJpg      : TJPEGImage; 
  mh, hBmp  : THandle; 

begin 
  ajpg        := TJPEGImage.Create; 
  aBmp        := TBitmap.Create;
  aBmp.Width  := Screen.DesktopWidth;
  aBmp.Height := Screen.DesktopHeight;
  aDC         := GetDC(0);
  hBmp        := CreateCompatibleBitmap(aDC, Screen.Width, Screen.Height);
  mh          := SelectObject(aDC, hBmp);

  try
    BitBlt(aBmp.Canvas.Handle, 0, 0, aBmp.Width, aBmp.Height, aDC, 0, 0, SRCCopy);

    ajpg.Assign(aBmp); 

    aBmp.Width  := Width;
    aBmp.Height := Height; 
    aBmp.Canvas.StretchDraw(Rect(0, 0, aBmp.Width, aBmp.Height), ajpg);

    ajpg.assign(aBmp);
    ajpg.CompressionQuality := Quality;
    ajpg.Compress();
    ajpg.SaveToFile(aFileName);
  finally
    ajpg.Free;
    aBmp.Free;
    SelectObject(aDC, mh);
    DeleteObject(hBmp);
    ReleaseDC(0, aDC);
  end;
end;

Um einen Screenshot manuell zu schiessen folgendes:

Delphi-Quellcode:

Image1.Picture := nil;
Image1.Picture.Bitmap := GetScreenshot;

Um den Screenshot manuell zu speichern (Datum.Caption ist der Name und in den SpinEdits steht die Bildgröße in Pixel):

Delphi-Quellcode:

procedure TForm1.suiButton2Click(Sender: TObject);
begin
Try
        aScreenShot('Screenshots\Screenshot ' + ' ' +Datum.Caption+' Uhr.jpg', 75, SpinEdit1.Value, SpinEdit2.Value);
        Except
        MKDir(ExtractFilepath(Application.Exename)+'Screenshots');
        aScreenShot('Screenshots\Screenshot ' + ' ' +Datum.Caption+' Uhr.jpg', 75, SpinEdit1.Value, SpinEdit2.Value);
end;
end;

Soweit funktioniert alles, wenn ich einen Screenshot aber automatisch (über Timer) schiessen und speichern will, z.B. jede Std. wird manchmal der erste Screenshot gemacht (nach einer Std) und bei jedem weitern erfolgt eine Fehlermeldung von wegen "...kann nicht gespeichert werden..." Code:

Delphi-Quellcode:

procedure TForm1.TScreenshotsTimer(Sender: TObject);
begin
        Image1.Picture := nil;
        Image1.Picture.Bitmap := GetScreenshot;
        Try
        aScreenShot('Screenshots\Screenshot ' + ' ' +Datum.Caption+' Uhr.jpg', 75, SpinEdit1.Value, SpinEdit2.Value);
        Except
        MKDir(ExtractFilepath(Application.Exename)+'Screenshots');
        aScreenShot('Screenshots\Screenshot ' + ' ' +Datum.Caption+' Uhr.jpg', 75, SpinEdit1.Value, SpinEdit2.Value);
end;
end;

Liegt es an der Timer Procedure oder ist die Umwandlungsprozedure (BMP->JPG) zu langsam???

[alcaeus]

Also Tim.exe, unter welchen Umständen tritt bei dir denn dieser Fehler auf? Ich hab das ganze jetzt probiert, und es funzt perfekt. Ich habe nur den Dateinamen des Pics geändert, aber ich kann mir nicht vorstellen dass das den Unterschied macht.

[Tim.exe]

Hallo,

also es kommt eine Fehlermeldung das die Datei nicht gespeichert werden kann (Screenshot wurde aber zuvor getätigt). Jetzt ist die Frage ob er das Verzeichnis "Screenshots" nicht findet oder ob es ein Problem mit dem Dateinamen gibt. Wie gesagt wird der erste Screenshot nach einer Std einwandfrei getätigt und gespeichert. Der zweite (nach 2 Std) nicht mehr (getätigt schon aber Fehler beim speichern).

Ich teste es im Moment in der Arbeit (Win2000). Wenn der Fehler kommt poste ich den Screenshot. Im Moment sieht es gut aus, der erste Screenshot wurde bereits gemacht. Sollte der zweite und alle anderen folgenden auch klappen dann liegt es wohl an meinem WinXP Prof zu Hause. Könnte das sein?

[alcaeus]

Also, ich verwende zu Hause auch WinXP Pro, habe aber keine Probleme. Versuch mal das Intervall zu verkürzen, dann kann man die ganze Sache einfacher testen. Es ist aber möglich dass es Probleme mit dem Verzeichnis gibt, versuch mal die ganzen Screenshots auf C:\ abzuspeichern. Das hat bei mir gefunzt...

[Tim.exe]

Also hier in der Arbeit klappt es wunderbar. Werde es heute abend nochmal probieren und es dann auch mal auf C: speichern lassen. Ich melde mich dann wieder, vielen Dank

[Tim.exe]

So, nu ist es auch bei Win2000 geschehen, siehe Anhang:

[alcaeus]

Aber vorher funktionierts immer? Hast du auch sicher noch genug Festplattenspeicher übrig? Das sieht mir nämlich nach so einem Problem aus...

[Tim.exe]

Hallo,

ja hab ich, aber da fällt mir noch was ein:

Als ich es heute morgen ausführlich getestet habe lief die Delphi IDE, habe das Programm also aus Delphi heraus gestartet gehabt. Jetzt bei diesem Fehler lief nur die *.exe, ohne Delphi.