Registriert seit: 29. Okt 2004
Ort: Halle
462 Beiträge
|
Re: nur weiße screenshotes
17. Apr 2005, 10: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.
|
|
Zitat
|