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;

用delphi在屏幕截图中显示鼠标光标

2 个答案: