whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

22 Visitors Online


 
...include the mouse-cursor in a screen shot?
Autor: Thomas Stutz
[ Print tip ]  

Tip Rating (31):  
     


// 1. Get the handle to the current mouse-cursor and its position
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;

// Example: Capture the screen and include the cursor.
// Show the Screenshot in Image1

procedure TForm1.Button1Click(Sender: TObject);
begin
  
Image1.Picture.Assign(CaptureScreen);
end;

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners