用delphi截圖顯示鼠標光標

Question

嗨，我正在製作一個delphi xe函數，該函數用於截取屏幕截圖，一切順利，但問題是我沒有在所拍攝的任何圖像上看到鼠標光標。

的代碼如下：

procedure capturar_pantalla(nombre: string); 

// Credits : 
// Based on : http://www.delphibasics.info/home/delphibasicssnippets/screencapturewithpurewindowsapi 
// Thanks to www.delphibasics.info and n0v4 

var 

    uno: integer; 
    dos: integer; 
    cre: hDC; 
    cre2: hDC; 
    im: hBitmap; 
    archivo: file of byte; 
    parriba: TBITMAPFILEHEADER; 
    cantidad: pointer; 
    data: TBITMAPINFO; 

begin 


    // Start 

    cre := getDC(getDeskTopWindow); 
    cre2 := createCompatibleDC(cre); 
    uno := getDeviceCaps(cre, HORZRES); 
    dos := getDeviceCaps(cre, VERTRES); 
    zeromemory(@data, sizeOf(data)); 


    // Config 

    with data.bmiHeader do 
    begin 
    biSize := sizeOf(TBITMAPINFOHEADER); 
    biWidth := uno; 
    biheight := dos; 
    biplanes := 1; 
    biBitCount := 24; 

    end; 

    with parriba do 
    begin 
    bfType := ord('B') + (ord('M') shl 8); 
    bfSize := sizeOf(TBITMAPFILEHEADER) + sizeOf(TBITMAPINFOHEADER) 
     + uno * dos * 3; 
    bfOffBits := sizeOf(TBITMAPINFOHEADER); 
    end; 

    // 

    im := createDIBSection(cre2, data, DIB_RGB_COLORS, cantidad, 0, 0); 
    selectObject(cre2, im); 

    bitblt(cre2, 0, 0, uno, dos, cre, 0, 0, SRCCOPY); 

    releaseDC(getDeskTopWindow, cre); 

    // Make Photo 

    AssignFile(archivo, nombre); 
    Rewrite(archivo); 

    blockWrite(archivo, parriba, sizeOf(TBITMAPFILEHEADER)); 
    blockWrite(archivo, data.bmiHeader, sizeOf(TBITMAPINFOHEADER)); 
    blockWrite(archivo, cantidad^, uno * dos * 3); 

end; 

有人能解釋我，我讓鼠標光標出現在畫面？

Answer 1

下面是您嘗試執行的更簡潔的實現，以及演示如何使用它的控制檯應用程序。 （由於屏幕被捕獲的時間，它抓住了「應用程序忙」的光標，因爲在應用程序仍在加載時進行調用。）您可以在需要的時候找出如何調用它以獲得適當的光標。

鼠標光標捕獲到Zarko的信用（Tony的鏈接）。我在這裏找到的屏幕截圖代碼（雖然有作者授權，但它在不同的機器上） - 明天當我回到這個系統時，我會更新這篇文章。

program Project2; 

{$APPTYPE CONSOLE} 

uses 
    SysUtils, Windows, Graphics; 

procedure DrawCursor (ACanvas:TCanvas; Position:TPoint) ; 
var 
    HCursor : THandle; 
begin 
    HCursor := GetCursor; 
    DrawIconEx(ACanvas.Handle, Position.X, Position.Y, 
       HCursor, 32, 32, 0, 0, DI_NORMAL) ; 
end; 

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

// Sample usage starts here 
var 
    Bmp: TBitmap; 

begin 
    Bmp := CaptureWindow(GetDesktopWindow); 
    Bmp.SaveToFile('D:\TempFiles\FullScreenCap.bmp'); 
    Bmp.Free; 
    WriteLn('Screen captured.'); 
    ReadLn; 
end. 

Answer 2

DrawCursor的另一變型：

function GetCursorInfo2: TCursorInfo; 
var 
    hWindow: HWND; 
    pt: TPoint; 
    dwThreadID, dwCurrentThreadID: DWORD; 
begin 
    ZeroMemory(@Result, SizeOf(Result)); 
    if GetCursorPos(pt) then 
    begin 
     Result.ptScreenPos := pt; 
     hWindow := WindowFromPoint(pt); 
     if IsWindow(hWindow) then 
     begin 
      dwThreadID := GetWindowThreadProcessId(hWindow, nil); 
      dwCurrentThreadID := GetCurrentThreadId; 
      if (dwCurrentThreadID <> dwThreadID) then 
      begin 
       if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then 
       begin 
        Result.hCursor := GetCursor; 
        AttachThreadInput(dwCurrentThreadID, dwThreadID, False); 
       end; 
      end 
      else 
      Result.hCursor := GetCursor; 
     end; 
    end; 
end; 

function GetCursorOffset(ACursor: HCURSOR): TPoint; 
var 
    IconInfo: TIconInfo; 
begin 
    GetIconInfo(ACursor, IconInfo); 
    Result.X := IconInfo.xHotspot; 
    Result.Y := IconInfo.yHotspot; 
    if IconInfo.hbmMask <> 0 then DeleteObject(IconInfo.hbmMask); 
    if IconInfo.hbmColor <> 0 then DeleteObject(IconInfo.hbmColor); 
end; 

procedure DrawCursor(ADC: HDC); 
var 
    CursorInfo: TCursorInfo; 
    Offset: TPoint; 
begin 
    CursorInfo := GetCursorInfo2; 
    Offset := GetCursorOffset(CursorInfo.hCursor); 
    DrawIconEx(ADC, CursorInfo.ptScreenPos.X - Offset.X, CursorInfo.ptScreenPos.Y - Offset.Y, CursorInfo.hCursor, 0, 0, 0, 0, DI_NORMAL); 
end;