Daha küçük boyutta ve "Jpg" olarak kaydetmek isterseniz.
procedure CaptureScreen(ABitmap: TBitmap) ;
var
vDesktopDC: HDC; // variable to store the device context handle of desktop window
begin
// get the device context handle of current desktop window
vDesktopDC := GetWindowDC(GetDesktopWindow);
try
// adjust the dimension and format of the supplied bitmap to match the screen
ABitmap.PixelFormat := pf24bit;
ABitmap.Height := Screen.Height;
ABitmap.Width := Screen.Width;
// draw the content of desktop into ABitmap
BitBlt(ABitmap.Canvas.Handle, 0, 0, ABitmap.Width, ABitmap.Height, vDesktopDC, 0, 0, SRCCOPY);
finally
// mark that we have done with the desktop device context
ReleaseDC(GetDesktopWindow, vDesktopDC);
end;
end;
procedure CaptureScreenToFile(const AFilename: string);
var
vJpg: TJpegImage;
vBmp: TBitmap;
begin
// create temporary bitmap
vBmp := TBitmap.Create;
try
CaptureScreen(vBmp);
// create Jpg image object
vJpg := TJpegImage.Create;
try
vJpg.Assign(vBmp);
// compress the image to have quality 70% of original
vJpg.CompressionQuality := 70;
// save the captured screen into a file in jpg format
vJpg.SaveToFile(AFileName);
finally
vJpg.Free; //destroy the jpg image object
end;
finally
vBmp.Free; // destroy temporary bitmap
end;
end;
Kullanım Şekli : CaptureScreenToFile('C:\test.jpg');
Hocam siz PNG formatına çevirmeden bitmap olarak kaydediyorsunuz, dosya uzantısını .PNG seklinde vermeniz sonucu değiştirmez, hatayı bundan dolayı alıyorsunuz, çevirmek için gerekli kodlar burada mevcut.Ayrıca boyutu ayarlamak için compressionlevel özelliğini set ediniz.
teşekkürler arkadaşlar aşagıdaki şekilde jpg olarak sorun çözüldü.
teşekkürler saygılar sunarım.
Procedure SaveScreenShot(const aFile:string);
var
vBMP:TBitmap;
vDC : HDC;
vJpg: TJpegImage;
begin
vBMP:=TBitmap.Create;
vDC := GetDC(0);
vBMP.LoadFromDevice(vDC);
vJpg := TJpegImage.Create;
try
vJpg.Assign(vBmp);
// compress the image to have quality 70% of original
vJpg.CompressionQuality := 70;
// save the captured screen into a file in jpg format
vJpg.SaveToFile(aFile);
finally
vJpg.Free; //destroy the jpg image object
end;
Form1.Image1.Picture.LoadFromFile('capture\aaa.jpg');
ReleaseDC(0,vDC);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SaveScreenShot('capture\aaa.jpg');
end;
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
İğne sokmadan yardımcı olacaksan başımın üstünde yerin var.
arkadaşlar uygulamada bir sorunla karşılaştım konu başlığına müsadenizle devam edebilirmiyiz.
işimi gören kullandığım kod aşagıdadır.
daha sonra projeye uyarlarken bir sorunla karşılaştım.
bilğisayara bağlı 2 adet ekran var bu kod sadece ilk ekranıdan capture yapıyor.
araştırma yaptım aşağıdaki şekillerde denemeler yaptım ama ikinci monitörden bir türlü görüntü alamadım
yardımcı olabilecek var mı acaba
saygılarımla
Procedure TForm1.SaveScreenShot(const aFile:string);
var
vBmp:TBitmap;
vDC : HDC;
vJpg: TJpegImage;
begin
vBmp:=TBitmap.Create;
vDC := GetDC(0);
vBmp.LoadFromDevice(vDC);
//BitBlt(vBmp.Canvas.Handle, 0, 0, vBmp.Width, vBmp.Height, vDC, 10, 10, cmSrcCopy);
//BitBlt(vBmp.Canvas.Handle, 0, 0, 0, 0, vDC, 100, 100, cmSrcCopy);
//BitBlt(vBmp.Canvas.Handle,0,0,Screen.Width,Screen.Height,vDC,800,0,cmSrcCopy);
//BitBlt(vBmp.Canvas.Handle,0,0,Screen.Width,Screen.Height,vDC,Screen.Width,0,cmSrcCopy);
BitBlt(vBmp.Canvas.Handle,0,0,Screen.Width,Screen.Height,vDC,Screen.Monitors[1].Left,0,cmSrcCopy);
vJpg := TJpegImage.Create;
try
vJpg.Assign(vBmp);
// compress the image to have quality 70% of original
vJpg.CompressionQuality := 70;
// save the captured screen into a file in jpg format
vJpg.SaveToFile(aFile);
finally
vJpg.Free; //destroy the jpg image object
end;
ReleaseDC(0,vDC);
end;
SaveScreenShot('aa.jpg');
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
İğne sokmadan yardımcı olacaksan başımın üstünde yerin var.
(26-03-2020, Saat: 16:10)sadikacar60 Adlı Kullanıcıdan Alıntı: arkadaşlar uygulamada bir sorunla karşılaştım konu başlığına müsadenizle devam edebilirmiyiz.
işimi gören kullandığım kod aşagıdadır.
daha sonra projeye uyarlarken bir sorunla karşılaştım.
bilğisayara bağlı 2 adet ekran var bu kod sadece ilk ekranıdan capture yapıyor.
araştırma yaptım aşağıdaki şekillerde denemeler yaptım ama ikinci monitörden bir türlü görüntü alamadım
yardımcı olabilecek var mı acaba
saygılarımla
Procedure TForm1.SaveScreenShot(const aFile:string);
var
vBmp:TBitmap;
vDC : HDC;
vJpg: TJpegImage;
begin
vBmp:=TBitmap.Create;
vDC := GetDC(0);
vBmp.LoadFromDevice(vDC);
//BitBlt(vBmp.Canvas.Handle, 0, 0, vBmp.Width, vBmp.Height, vDC, 10, 10, cmSrcCopy);
//BitBlt(vBmp.Canvas.Handle, 0, 0, 0, 0, vDC, 100, 100, cmSrcCopy);
//BitBlt(vBmp.Canvas.Handle,0,0,Screen.Width,Screen.Height,vDC,800,0,cmSrcCopy);
//BitBlt(vBmp.Canvas.Handle,0,0,Screen.Width,Screen.Height,vDC,Screen.Width,0,cmSrcCopy);
BitBlt(vBmp.Canvas.Handle,0,0,Screen.Width,Screen.Height,vDC,Screen.Monitors[1].Left,0,cmSrcCopy);
vJpg := TJpegImage.Create;
try
vJpg.Assign(vBmp);
// compress the image to have quality 70% of original
vJpg.CompressionQuality := 70;
// save the captured screen into a file in jpg format
vJpg.SaveToFile(aFile);
finally
vJpg.Free; //destroy the jpg image object
end;
ReleaseDC(0,vDC);
end;
SaveScreenShot('aa.jpg');
Aşağıdaki kodda istenilen monitör deki secilen alanı kopyalıyor.
kodları kendinize göre revize edebilirsiniz.
procedure DrawScreenCursor(var Bmp: TBitmap; const MonitorID: Integer);
var
R: TRect;
CursorInfo: TCursorInfo;
Icon: TIcon;
IconInfo: TIconInfo;
begin
R:= Bmp.Canvas.ClipRect;
Icon:= TIcon.Create;
try
//MonitorID: 0=ALL screens, 1=MAIN screen, 2=ADDITIONAL screen, etc....
CursorInfo.cbSize:= SizeOf(CursorInfo);
if GetCursorInfo(CursorInfo) then
if CursorInfo.Flags = CURSOR_SHOWING then
begin
Icon.Handle:= CopyIcon(CursorInfo.hCursor);
if GetIconInfo(Icon.Handle, IconInfo) then
begin
//Draw cursor image on screenshot image
Bmp.Canvas.Draw(
CursorInfo.ptScreenPos.x - Integer(IconInfo.xHotspot) - R.Left,
CursorInfo.ptScreenPos.y - Integer(IconInfo.yHotspot) - R.Top,
Icon
);
end;
end;
finally
Icon.Free;
end;
end;
function TakeScreenshot(var bmp: TBitmap; MonitorNumber: Integer): Boolean;
const
CAPTUREBLT = $40000000;
var
DesktopCanvas: TCanvas;
DC: HDC;
Left, Top: Integer;
begin
Result := False;
if (MonitorNumber > Screen.MonitorCount) then
Exit;
DC:= GetDC(0);
try
if (DC = 0) then
Exit;
if (MonitorNumber = 0) then begin
Bmp.Width := Screen.DesktopWidth;
Bmp.Height := Screen.DesktopHeight;
Left := Screen.DesktopLeft;
Top := Screen.DesktopTop;
end else begin
Bmp.Width := Screen.Monitors[MonitorNumber-1].Width;
Bmp.Height := Screen.Monitors[MonitorNumber-1].Height;
Left := Screen.Monitors[MonitorNumber-1].Left;
Top := Screen.Monitors[MonitorNumber-1].Top;
end;
DesktopCanvas := TCanvas.Create;
try
DesktopCanvas.Handle := DC;
Result := BitBlt(
Bmp.Canvas.Handle,
0,
0,
Bmp.Width,
Bmp.Height,
DesktopCanvas.Handle,
Left,
Top,
SRCCOPY or CAPTUREBLT
);
Result:= True;
finally
DesktopCanvas.Free;
end;
finally
if (DC <> 0) then
ReleaseDC(0, DC);
end;
end;
function ScreenShot(Bmp: TBitmap; const DrawCursor: Boolean;
const Quality: TPixelFormat; const Monitor: Integer): Bool;
begin
Result:= TakeScreenshot(Bmp, Monitor);
if Result then
if DrawCursor then
DrawScreenCursor(Bmp, Monitor);
end;
"…De ki: "Hiç bilenlerle bilmeyenler bir olur mu? Şüphesiz, temiz akıl sahipleri öğüt alıp-düşünürler" (Zümer Suresi, 9)
(26-03-2020, Saat: 18:58)sadikacar60 Adlı Kullanıcıdan Alıntı: hocam aşağıdaki ekilde düzenledima ama gene 0 monitörün ekranını alıyor.
bir göz atabilirmisiniz rica etsem.
Procedure TForm1.SaveScreenShot(const aFile:string);
const
CAPTUREBLT = $40000000;
var
vBmp:TBitmap;
vDC : HDC;
vJpg: TJpegImage;
Left1, Top1: Integer;
DesktopCanvas: TCanvas;
begin
vBmp:=TBitmap.Create;
DesktopCanvas := TCanvas.Create;
vBmp.Width := Screen.Monitors[1].Width;
vBmp.Height := Screen.Monitors[1].Height;
Left1 := Screen.Monitors[1].Left;
Top1 := Screen.Monitors[1].Top;
vDC := GetDC(0);
vBmp.LoadFromDevice(vDC);
try
DesktopCanvas.Handle := vDC;
BitBlt(vBmp.Canvas.Handle,0,0,vBmp.Width,vBmp.Height,DesktopCanvas.Handle,Left1,Top1,SRCCOPY or CAPTUREBLT);
finally
DesktopCanvas.Free;
end;
vJpg := TJpegImage.Create;
try
vJpg.Assign(vBmp);
// compress the image to have quality 70% of original
vJpg.CompressionQuality := 70;
// save the captured screen into a file in jpg format
vJpg.SaveToFile(aFile);
finally
vJpg.Free; //destroy the jpg image object
end;
ReleaseDC(0,vDC);
end;
Yanlış biliyorsan bilen arkadaşlar düzeltirse sevinirim
kaç monitorünüz olursa olsun windows bunu büyük ve tek masaüstü olarak görür.
sizin yapmanız gereken ihtiyacınız olan monitörün yakalamak istediğiniz yükseklik ve genişliği almanız.
aşağıda test projesinde windows da aynı anda iki ekranıda yakalayan kod var üzerinde geliştirebilirsiniz.
denendi çalışıyor.
"…De ki: "Hiç bilenlerle bilmeyenler bir olur mu? Şüphesiz, temiz akıl sahipleri öğüt alıp-düşünürler" (Zümer Suresi, 9)
arkadaşlar lazarusda ikinci ekranın görüntüsünü almayı beceremedim ama araştırırken istediğimiz formun görünümünü kaydetmeyi öğrendim. benim için yeterliydi zira form full ekran çalışıyordu.
ScreenDC := GetDC(Form1.Handle); // bu satırda hangi formun kaydını almak istiyorsanız şekildeki gib yazmanız yeterli.
saygılarımla
çok teşekkürler.
delphican sayasinde bir çok sorunu çözdük gene.
procedure SaveScreenShot1(const aFilename:string);
var
vJpg: TJpegImage;
ScreenDC: HDC;
SaveBitmap: TBitmap;
begin
SaveBitmap := TBitmap.Create;
try
SaveBitmap.SetSize(Screen.Width, Screen.Height);
ScreenDC := GetDC(Form1.Handle);
try
SaveBitmap.LoadFromDevice(ScreenDC);
finally
ReleaseDC(0, ScreenDC);
end;
vJpg := TJpegImage.Create;
try
vJpg.Assign(SaveBitmap);
vJpg.CompressionQuality := 70; // compress the image to have quality 70% of original
vJpg.SaveToFile(aFilename); // save the captured screen into a file in jpg format
finally
vJpg.Free; //destroy the jpg image object
end;
finally
SaveBitmap.Free;
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
SaveScreenShot1('xx.jpg');
end;
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
İğne sokmadan yardımcı olacaksan başımın üstünde yerin var.
