screenshot als jpeg

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