CODEWITHSUNDEEP
delphi
user3015248
user3015248

Reputation: 89

Show mouse cursor in screenshot with delphi

Hi I am making a delphi xe function, the function is to take a screenshot, all goes well but the problem is I do not see the mouse cursor on any of the images taken.

The code is as follows:

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;

Someone could explain me as I make the mouse cursor appear in the screenshot?

Upvotes: 4

Views: 2237

Answers (2)

Denis Anisimov
Denis Anisimov

Reputation: 3317

Another variant of 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;

Upvotes: 2

Ken White
Ken White

Reputation: 125689

Here's a much cleaner implementation of what you're attempting to do, along with a console application that demonstrates how to use it. (Because of the time the screen is captured, it grabs the "application busy" cursor, because the call is made while the app is still loading.) You can figure out how to call it when you need to in order to get the proper cursor.

Credits for the mouse cursor capture to Zarko (Tony's link). The screen capture code I found here on SO a while back (and have the credits to give the author, but it's on a different machine) - I'll update this post tomorrow when I'm back at that system.

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.

Upvotes: 9

Related Questions