Show mouse cursor in screenshot with delphi

Question

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?

sorry do not understand how use used because the function's use in a console program and the example code says "form". as I add this to my function? — user3015248
– user3015248, Commented Feb 23, 2014 at 17:32

Ken White · Accepted Answer · 2014-02-23 18:34:52Z

9

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.

edited Feb 23, 2014 at 18:34

answered Feb 23, 2014 at 18:11

Ken White

126k15 gold badges237 silver badges476 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

Jerry Dodge Over a year ago

"I'll update this post tomorrow when I'm back at that system." I sure hope you got back to your system, because it looks like it hasn't been updated since 23 minutes after original post. Anyway, the other answer here seems to account for the actual current mouse cursor, instead of only a pointer.

Ken White Over a year ago

@JerryDodge: It does in fact include code to capture and draw the cursor. I just didn't update the post with a link to the original author, as I didn't have it (and forgot to try again to dig it up). That text has nothing to do with the capabilities of the code itself.

Jerry Dodge Over a year ago

@Ken My point was that it only draws the pointer, but if, for example, it's a size grip, this code still draws just the pointer. The other answer below does the extra step of drawing the current cursor, not just the arrow.

Denis Anisimov · Accepted Answer · 2014-02-23 18:58:32Z

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;

Collectives™ on Stack Overflow

Show mouse cursor in screenshot with delphi

2 Answers 2

3 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

3 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related