Thema: Delphi nur weiße screenshotes

Einzelnen Beitrag anzeigen

Benutzerbild von Harry M.
Harry M.

Registriert seit: 29. Okt 2004
Ort: Halle
462 Beiträge
 
#3

Re: nur weiße screenshotes

  Alt 17. Apr 2005, 09:24
nimm meine glaskugel...
*g

Delphi-Quellcode:
// procedure zum anlegen des screenshotes
procedure ScreenCapture(Bmp: TBitmap);
var
  DeskWnd: HWnd;
  DeskDC: HDC;
  DeskCv: TCanvas;
  R: TRect;
  W, H: Integer;
begin
  if Bmp = nil then Exit;
  DeskWnd := GetDesktopWindow;
  DeskDC := GetWindowDC(DeskWnd);
  DeskCv := TCanvas.Create;
  DeskCv.Handle := DeskDC;
  W := Screen.Width;
  H := Screen.Height;
  R := Bounds(0, 0, W, H);
  try
    Bmp.HandleType := bmDIB;
    Bmp.PixelFormat := pf24Bit;
    Bmp.Width := W;
    Bmp.Height := H;
    Bmp.Canvas.CopyMode := cmSrcCopy;
    Bmp.Canvas.CopyRect(R, DeskCv, R);
  finally
    DeskCv.Free;
    ReleaseDC(DeskWnd, DeskDC);
  end;
end;

// zum kovertieren in jpg
function setJPGFileName(fbmp: string):string;
var
  I : integer;
begin
  s := ExtractFileName(fbmp);
  for i := 1 to 3 do Delete(s,Length(s),1);
  result := s + 'JPG'
end;

// screenshot machen
self.Image1.Picture.Bitmap:=TBitmap.Create;
ScreenCapture(self.Image1.Picture.Bitmap);

// und kovertieren
    Try
    pic := TImage.Create(nil);
    //pic.Picture.LoadFromFile('Temp.bmp');
    pic.Picture := Image1.Picture;
    with TJPEGImage.Create do begin
      Performance := jpBestQuality;
      CompressionQuality := 20;
      Assign(pic.Picture.Graphic);
      //fNameJPG := setJPGFileName('Temp.bmp');
      SaveToFile('Temp.jpg');
      Free
    end;
    except; end;
    pic.Free;
wie gesagt auf meinem rechner läuft alles wunderbar.
Harry
Gruß Harry
www.H-Soft.info
  Mit Zitat antworten Zitat