screen capture (cursoru ve video görüntüsü alma)

[myalcin]

herkese merhaba.
arkadaşlar ekran görüntüsünü almak için şu fonksiyonu kullanıyorum.

Kod: Tümünü seç

function TForm1.GetSCREENSHOT: TBitmap;
var
  Locked: Boolean;
  X, Y, XS, YS: Integer;
  Canvas: TCanvas;
  R: TRect;
begin
  Result := TBitmap.Create;
  Result.Width := Screen.Width;
  Result.Height := Screen.Height;
  Canvas := TCanvas.Create;
  Canvas.Handle := GetDC(0);
  Locked := Canvas.TryLock;
  try
    XS := Pred(Screen.Width div cTileSize);
    if Screen.Width mod cTileSize > 0 then
      Inc(XS);
    YS := Pred(Screen.Height div cTileSize);
    if Screen.Height mod cTileSize > 0 then
      Inc(YS);
    for X := 0 to XS do
      for Y := 0 to YS do
      begin
        R := Rect(
          X * cTileSize, Y * cTileSize, Succ(X) * cTileSize,
          Succ(Y) * cTileSize);
        Result.Canvas.CopyRect(R, Canvas, R);
      end;
  finally
    if Locked then
      Canvas.Unlock;
    ReleaseDC(0, Canvas.Handle);
    Canvas.Free;
  end;
end;

bitmap nesnesine aktarıp kaydediyorum . fakat fare imleci ve video görüntülerini almıyor bilindiği üzere.
bunları nasıl almasını sağlaybilirim?
teşekkürler.

[myalcin]

hayret bişi. ben de akşama kadar arıyorum.Bulamayınca foruma yazıyorum. 5dk sonra buluyorum.
neyse kodu sizlerle paylaşayım arkadaşlar.

Kod: Tümünü seç

//cursor bilgisini alarak capture da kullanacağız
function GetCursorInfo2: TCursorInfo;
var
 hWindow: HWND;
 pt: TPoint;
 pIconInfo: TIconInfo;
 dwThreadID, dwCurrentThreadID: DWORD;
begin
 Result.hCursor := 0;
 ZeroMemory(@Result, SizeOf(Result));
 // Find out which window owns the cursor
 if GetCursorPos(pt) then
 begin
   Result.ptScreenPos := pt;
   hWindow := WindowFromPoint(pt);
   if IsWindow(hWindow) then
   begin
     // Get the thread ID for the cursor owner.
     dwThreadID := GetWindowThreadProcessId(hWindow, nil);

     // Get the thread ID for the current thread
     dwCurrentThreadID := GetCurrentThreadId;

     // If the cursor owner is not us then we must attach to
     // the other thread in so that we can use GetCursor() to
     // return the correct hCursor
     if (dwCurrentThreadID <> dwThreadID) then
     begin
       if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
       begin
         // Get the handle to the cursor
         Result.hCursor := GetCursor;
         AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
       end;
     end
     else
     begin
       Result.hCursor := GetCursor;
     end;
   end;
 end;
end;

// 2. Capture the screen
function CaptureScreen: TBitmap;
var
 DC: HDC;
 ABitmap: TBitmap;
 MyCursor: TIcon;
 CursorInfo: TCursorInfo;
 IconInfo: TIconInfo;
begin
 // Capture the Desktop screen
 DC := GetDC(GetDesktopWindow);
 ABitmap := TBitmap.Create;
 try
   ABitmap.Width  := GetDeviceCaps(DC, HORZRES);
   ABitmap.Height := GetDeviceCaps(DC, VERTRES);
   // BitBlt on our bitmap
   BitBlt(ABitmap.Canvas.Handle,
     0,
     0,
     ABitmap.Width,
     ABitmap.Height,
     DC,
     0,
     0,
     SRCCOPY);
   // Create temp. Icon
   MyCursor := TIcon.Create;
   try
     // Retrieve Cursor info
     CursorInfo := GetCursorInfo2;
     if CursorInfo.hCursor <> 0 then
     begin
       MyCursor.Handle := CursorInfo.hCursor;
       // Get Hotspot information
       GetIconInfo(CursorInfo.hCursor, IconInfo);
       // Draw the Cursor on our bitmap
       ABitmap.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot,
                           CursorInfo.ptScreenPos.Y - IconInfo.yHotspot, MyCursor);
     end;
   finally
     // Clean up
     MyCursor.ReleaseHandle;
     MyCursor.Free;
   end;
 finally
   ReleaseDC(GetDesktopWindow, DC);
 end;
 Result := ABitmap;
end;

bu kısmı tamam ama video yakalama kaldı sadece

[Commandx]

üstteki bu kod belli bir süre çalıştıktan sonra hata veriyor timer nesnesine ekleyip form üzerinde yerleştirdiğim image nesnesine assign ettikten sonra biraz çalışıyor böyle çalıştıktan sonra hafıza yetersiz deyip artık işlem yapmıyor

///cursor bilgisini alarak capture da kullanacağız
function GetCursorInfo2: TCursorInfo;
var
hWindow: HWND;
pt: TPoint;
pIconInfo: TIconInfo;
dwThreadID, dwCurrentThreadID: DWORD;
begin
Result.hCursor := 0;
ZeroMemory(@Result, SizeOf(Result));
// Find out which window owns the cursor
if GetCursorPos(pt) then
begin
Result.ptScreenPos := pt;
hWindow := WindowFromPoint(pt);
if IsWindow(hWindow) then
begin
// Get the thread ID for the cursor owner.
dwThreadID := GetWindowThreadProcessId(hWindow, nil);

// Get the thread ID for the current thread
dwCurrentThreadID := GetCurrentThreadId;

// If the cursor owner is not us then we must attach to
// the other thread in so that we can use GetCursor() to
// return the correct hCursor
if (dwCurrentThreadID <> dwThreadID) then
begin
if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
begin
// Get the handle to the cursor
Result.hCursor := GetCursor;
AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
end;
end
else
begin
Result.hCursor := GetCursor;
end;
end;
end;
end;

// 2. Capture the screen
function CaptureScreen: TBitmap;
var
DC: HDC;
ABitmap: TBitmap;
MyCursor: TIcon;
CursorInfo: TCursorInfo;
IconInfo: TIconInfo;
begin
// Capture the Desktop screen
DC := GetDC(GetDesktopWindow);
ABitmap := TBitmap.Create;
try
ABitmap.Width := GetDeviceCaps(DC, HORZRES);
ABitmap.Height := GetDeviceCaps(DC, VERTRES);
// BitBlt on our bitmap
BitBlt(ABitmap.Canvas.Handle,
0,
0,
ABitmap.Width,
ABitmap.Height,
DC,
0,
0,
SRCCOPY);
// Create temp. Icon
MyCursor := TIcon.Create;
try
// Retrieve Cursor info
CursorInfo := GetCursorInfo2;
if CursorInfo.hCursor <> 0 then
begin
MyCursor.Handle := CursorInfo.hCursor;
// Get Hotspot information
GetIconInfo(CursorInfo.hCursor, IconInfo);
// Draw the Cursor on our bitmap
ABitmap.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot,
CursorInfo.ptScreenPos.Y - IconInfo.yHotspot, MyCursor);
end;
finally
// Clean up
MyCursor.ReleaseHandle;
MyCursor.Free;
end;
finally
ReleaseDC(GetDesktopWindow, DC);
end;
Result := ABitmap;
end;

biraz uğraştım Yeniden kodu düzelttim sorunsuz çalışıyor şimdi

Kod: Tümünü seç

//cursor bilgisini alarak capture da kullanacağız
function GetCursorInfo2: TCursorInfo;
var
hWindow: HWND;
pt: TPoint;
pIconInfo: TIconInfo;
dwThreadID, dwCurrentThreadID: DWORD;
begin
Result.hCursor := 0;
ZeroMemory(@Result, SizeOf(Result));
// Find out which window owns the cursor
if GetCursorPos(pt) then
begin
   Result.ptScreenPos := pt;
   hWindow := WindowFromPoint(pt);
   if IsWindow(hWindow) then
   begin
     // Get the thread ID for the cursor owner.
     dwThreadID := GetWindowThreadProcessId(hWindow, nil);

     // Get the thread ID for the current thread
     dwCurrentThreadID := GetCurrentThreadId;

     // If the cursor owner is not us then we must attach to
     // the other thread in so that we can use GetCursor() to
     // return the correct hCursor
     if (dwCurrentThreadID <> dwThreadID) then
     begin
       if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
       begin
         // Get the handle to the cursor
         Result.hCursor := GetCursor;
         AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
       end;
     end
     else
     begin
       Result.hCursor := GetCursor;
     end;
   end;
end;
end;




procedure ScreenShot(activeWindow: bool; destBitmap : TBitmap) ;
 var
    w,h : integer;
    DC : HDC;
    hWin : Cardinal;
    r : TRect;
  MyCursor: TIcon;
CursorInfo: TCursorInfo;
IconInfo: TIconInfo;  
 begin
    if activeWindow then
    begin
//      hWin := GetForegroundWindow;
      dc := GetWindowDC(hWin) ;
      GetWindowRect(hWin,r) ;
      w := r.Right - r.Left;
      h := r.Bottom - r.Top;
    end
    else
    begin
      hWin := GetDesktopWindow;
      dc := GetDC(hWin) ;
      w := GetDeviceCaps (DC, HORZRES) ;
      h := GetDeviceCaps (DC, VERTRES) ;
    end;
 
    try
     destBitmap.Width := w;
     destBitmap.Height := h;
     BitBlt(destBitmap.Canvas.Handle,    0,    0,   destBitmap.Width,  destBitmap.Height,   DC,   0,    0,  SRCCOPY) ;

 // Create temp. Icon
   MyCursor := TIcon.Create;
   try
     // Retrieve Cursor info
    CursorInfo := GetCursorInfo2;
     if CursorInfo.hCursor <> 0 then
     begin
       MyCursor.Handle := CursorInfo.hCursor;
       // Get Hotspot information
       GetIconInfo(CursorInfo.hCursor, IconInfo);
       // Draw the Cursor on our bitmap
       destBitmap.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot,
                           CursorInfo.ptScreenPos.Y - IconInfo.yHotspot, MyCursor);
      end;

    finally
       MyCursor.ReleaseHandle;
     MyCursor.Free;
     ReleaseDC(hWin, DC) ;
    end;
    finally
       ReleaseDC(GetDesktopWindow, DC);
  end;
//Result := destBitmap; // bu nedir anlamadım?
end;

Kodun kullanımı

Kod: Tümünü seç

 var
    b:TBitmap;
 begin
   b := TBitmap.Create;
   try
     ScreenShot(false, b) ; // true değeri olursa aktif olan pencereyi çeker
     Image1.Picture.Bitmap.Assign(b) ;
   finally
     b.FreeImage;
     FreeAndNil(b) ;
   end;