Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
çözüldü-screenshot yapmak hk.
#1
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');
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

Cevapla
#2
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/
Cevapla
#3
(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.
Herhangi bir basit problem, hakkında yeterince toplantı yapılarak, çözümsüz hale getirilebilir.

Cevapla
#4
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.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

Cevapla
#5
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.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

Cevapla
#6
(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)
Cevapla
#7
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;    
Ekmeğimi yazılımdan kazanmıyorum kendi halimde bir şeyler yapıyorum. 49 yaşında emekliyim.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

Cevapla
#8
(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.


Ek Dosyalar
.zip   test.zip (Dosya Boyutu: 52,99 KB / İndirme Sayısı: 3)
"…De ki: "Hiç bilenlerle bilmeyenler bir olur mu? Şüphesiz, temiz akıl sahipleri öğüt alıp-düşünürler" (Zümer Suresi, 9)
Cevapla
#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.
iyne sokmadan yardımcı olacaksan başımın üstünde yerin var.

Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  çözüldü-lazarusda md5 işlemi hk. sadikacar60 3 106 06-04-2020, Saat: 22:13
Son Yorum: ihalilcoban
  çözüldü-IdTrivialFTP1 ve IdTrivialFTPServer1 kompenantları hk. sadikacar60 28 1.023 26-03-2020, Saat: 10:48
Son Yorum: Bay_Y
  [ÇÖZÜLDÜ-SOLVED] StringGrid Satır Taşıma(Move Row) 3ddark 7 378 23-03-2020, Saat: 13:08
Son Yorum: 3ddark
  ÇÖZÜLDÜ-random un istediğimz sayıdan başlaması mümkün mü? sadikacar60 7 433 16-03-2020, Saat: 23:31
Son Yorum: sadikacar60
  ÇÖZÜLDÜ formu dialog alarak kullanmak mümkünmü? sadikacar60 7 419 12-03-2020, Saat: 00:25
Son Yorum: uparlayan



Konuyu Okuyanlar: 1 Ziyaretçi