Delphi Can

Delphi Can > Delphi > Genel Programlama > çözüldü-screenshot yapmak hk.
Orjinalini görmek için tıklayınız: çözüldü-screenshot yapmak hk.
Şu anda (Arşiv) modunu görüntülemektesiniz. Orjinal Sürümü Görüntüle internal link
Sayfalar: 1 2

sadikacar60

13-03-2020, Saat: 23:49
arkadaşlar aşagıdaki kod ile ekran resmini alıyorum ama 2 problemim var.

birincisi bu kod sadece bmp için örnek olarak buldum ama png olarakta resim alıyor almasına alıyor ama
resim 5mb olarak kaydediliyor  ayrıca

Image23.Picture.LoadFromFile(yol+'Capture\gozle.png')  ;     kodu ile resmi forma almak istediğimde

FPImageException  wrong image format hatası alıyorum 
bu sorunu nasıl çözeriz acaba

saygılarımla

procedure SaveScreenShot(const aFilename:string);
var
 ScreenDC: HDC;
 SaveBitmap: TBitmap;
begin
 SaveBitmap := TBitmap.Create;
 try
   SaveBitmap.SetSize(Screen.Width, Screen.Height);
   ScreenDC := GetDC(0);
   try
     SaveBitmap.LoadFromDevice(ScreenDC);
   finally
     ReleaseDC(0, ScreenDC);
   end;
   SaveBitmap.SaveToFile(aFilename);
 finally
   SaveBitmap.Free;
 end;
 
end;
     

SaveScreenShot('Capture\gozle.png');

Bay_Y

14-03-2020, Saat: 09:27
Sanırım aşağıdaki kod işinizi çözecektir.

function CaptureWindow(const WindowHandle: HWnd): TBitmap;
var
 DC: HDC;
 wRect: TRect;
 Width, Height: Integer;
begin
 DC := GetWindowDC(WindowHandle);
 Result := TBitmap.Create;
 try
   GetWindowRect(WindowHandle, wRect);
   Width := wRect.Right - wRect.Left;
   Height := wRect.Bottom - wRect.Top;
   Result.Width := Width;
   Result.Height := Height;
   Result.Modified := True;
   BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
 finally
   ReleaseDC(WindowHandle, DC);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 Capture: TBitmap;
begin
 //  For active window, change Handle to GetForegroundWindow()
 Capture := CaptureWindow(Handle);  
 try
   Capture.SaveToFile('E:\TempFiles\ScreenCapture2014.bmp');
 finally
   Capture.Free;
 end;
end;


Dosya boyutu : 860 KB

daha detaylı incelemek isterseniz. Kaynağı burası

https://stackoverflow.com/questions/2341...screenshot

Kolay Gelsin.


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');

Dosya Boyutu : 150K

kaynak Kod : http://forum.codecall.net/topic/60613-ho...lphi-code/

savasabd

14-03-2020, Saat: 10:07
(13-03-2020, Saat: 23:49)sadikacar60 Adlı Kullanıcıdan Alıntı: [ -> ]arkadaşlar aşagıdaki kod ile ekran resmini alıyorum ama 2 problemim var.

birincisi bu kod sadece bmp için örnek olarak buldum ama png olarakta resim alıyor almasına alıyor ama
resim 5mb olarak kaydediliyor  ayrıca

Image23.Picture.LoadFromFile(yol+'Capture\gozle.png')  ;     kodu ile resmi forma almak istediğimde

FPImageException  wrong image format hatası alıyorum 
bu sorunu nasıl çözeriz acaba

saygılarımla

procedure SaveScreenShot(const aFilename:string);
var
 ScreenDC: HDC;
 SaveBitmap: TBitmap;
begin
 SaveBitmap := TBitmap.Create;
 try
   SaveBitmap.SetSize(Screen.Width, Screen.Height);
   ScreenDC := GetDC(0);
   try
     SaveBitmap.LoadFromDevice(ScreenDC);
   finally
     ReleaseDC(0, ScreenDC);
   end;
   SaveBitmap.SaveToFile(aFilename);
 finally
   SaveBitmap.Free;
 end;
 
end;
     

SaveScreenShot('Capture\gozle.png');

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.

sadikacar60

14-03-2020, Saat: 17:29
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;
     

sadikacar60

26-03-2020, Saat: 16:10
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');

cinarbil

26-03-2020, Saat: 16:57
(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;

sadikacar60

26-03-2020, Saat: 18:58
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;    

cinarbil

27-03-2020, Saat: 11:17
(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.

sadikacar60

27-03-2020, Saat: 21:11
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;
     

bydelphi

09-06-2024, Saat: 15:49
Merhabalar,

Windows hizmetlerin içinde desktop screenshot alıyorum hatta sıkıştırıp jpg de yapıyorum, image obje oluşuyor erişiliyor , hizmet çalışıyor ancak her seferinde beyaz bir bitmap geçiyor elime.
acaba hizmetlerden bu mümkün değilmi yada dikkat etmek gereken bir şey mi var. tabi şunuda söylemeliyim, aynı kod  vcl exe uygulamamda sorunsuz işliyor .
jpg'e dönüştürmeden de aldığımda da yine beyaz. Yardımcı olabilirmisiniz.

    DSK := GetDC(GetDesktopWindow);
   BMP := TBitmap.Create;
   BMP.Width := Screen.Width;
   BMP.Height := Screen.Height;
   BitBlt(BMP.Canvas.Handle, 0, 0, BMP.Width, BMP.Height,DSK, 0, 0,SrcCopy);
   JPG := TJPEGImage.Create;
   JPG.Assign(BMP);
   JPG.CompressionQuality := 70;
   JPG.Compress;
Sayfalar: 1 2
Delphi Can > Delphi > Genel Programlama > çözüldü-screenshot yapmak hk.