Jak zrobić screenshota tyle żeby był na nim aktualny kursor. Jedyne co mi się udało to zrobić screenshot i umieścić na nim strzałkę z pliku mojego BMP pobierając pozycję kursora GetCursorPos, ale zazwyczaj jest inny kursor niż strzałka. Proszę o pomoc !
0
0
dzięki za szybką i treściwą odpowiedź.
dzięki i pozdrawiam
0
a moze taki koponent?
unit FTScreenshot;
(******************************************************************************
Unit to make a screenshot with or without the mouse cursor.
Author: Finn Tolderlund
Denmark
Date: 01.07.2003
homepage:
http://home20.inet.tele.dk/tolderlund/
http://finn.mobilixnet.dk/
e-mail:
[email protected]
[email protected]
Tested with Delphi 5, 6 and 7.
This unit can freely be used and distributed.
Disclaimer:
Use of this unit is on your own responsibility.
I will not under any circumstance be hold responsible for anything
which may or may not happen as a result of using this unit.
First version 01.07.2003
Changed 02.07.2003
Added a new overloaded Screenshot function to make screenshot
of only an area of the screen including the cursor.
******************************************************************************)
interface
uses
Windows, SysUtils, Classes, Graphics;
function Screenshot(IncludeCursor: Boolean): TBitmap; overload;
{ Take a screenshot of whole screen, including the cursor.
The cursour will not be included on Windows 95 which lacks the GetCursorInfo API.
Example:
var
bm: TBitmap;
begin
bm := Screenshot(True);
try
bm.SaveToFile('c:\test.bmp');
finally
bm.Free;
end;
end;
}
function Screenshot(IncludeCursor: Boolean; const ScreenArea: TRect): TBitmap; overload;
{ Take a screenshot of an area of the screen, including the cursor.
The cursour will not be included on Windows 95 which lacks the GetCursorInfo API.
Example:
var
bm: TBitmap;
begin
bm := Screenshot(True, Form1.BoundsRect); // whole form (visible part)
try
bm.SaveToFile('c:\test.bmp');
finally
bm.Free;
end;
end;
}
procedure Screenshot(const Bitmap: TBitmap; const ScreenArea: TRect); overload;
{ take a screenshot of the ScreeanArea Rect, excluding the bottom and right edges.
Example:
var
bm: TBitmap;
begin
bm := TBitmap.Create;
try
Screenshot(bm, Rect(0, 0, Screen.Width, Screen.Height)); // whole screen
or
Screenshot(bm, Form1.BoundsRect); // whole form (visible part)
bm.SaveToFile('c:\test.bmp');
finally
bm.Free;
end;
end;
}
implementation
procedure Screenshot(const Bitmap: TBitmap; const ScreenArea: TRect);
var
BitmapRect, ScreenRect: TRect;
DesktopDC: HDC;
DesktopCanvas: TCanvas;
begin
BitmapRect := Rect(0, 0, ScreenArea.Right - ScreenArea.Left, ScreenArea.Bottom - ScreenArea.Top);
ScreenRect := Rect(ScreenArea.Left, ScreenArea.Top, ScreenArea.Right, ScreenArea.Bottom);
Bitmap.PixelFormat := pf24bit; // optional
Bitmap.Width := ScreenArea.Right - ScreenArea.Left;
Bitmap.Height := ScreenArea.Bottom - ScreenArea.Top;
DesktopDC := GetWindowDC(GetDeskTopWindow);
try
DesktopCanvas := TCanvas.Create;
try
DesktopCanvas.Handle := DesktopDC;
Bitmap.Canvas.CopyMode := cmSrcCopy;
Bitmap.Canvas.CopyRect(BitmapRect, DesktopCanvas, ScreenRect);
finally
DesktopCanvas.Free;
end;
finally
ReleaseDC(GetDeskTopWindow, DesktopDC);
end;
end;
function GetCursorInfo(var pci: TCursorInfo): Boolean;
// GetCursorInfo is in Windows.pas, but I implement the GetCursorInfo API here
// so it doesn't crash on Windows 95 which lacks this API.
// GetCursorInfo, Minimum operating systems: Windows 98, Windows NT 4.0 SP6
// Windows NT/2000: Requires Windows NT 4.0 SP6 or later.
// Windows 95/98: Requires Windows 98 or later.
type
TGetCursorInfo = function(var pci: TCursorInfo): BOOL; stdcall;
const
cUser32 = 'User32.dll';
var
hMod: HMODULE;
_GetCursorInfo: TGetCursorInfo;
begin
Result := False;
hMod := GetModuleHandle(cUser32);
if hMod <> 0 then
begin
@_GetCursorInfo := GetProcAddress(hMod, 'GetCursorInfo');
if Assigned(_GetCursorInfo) then
Result := _GetCursorInfo(pci);
end;
end;
function Screenshot(IncludeCursor: Boolean): TBitmap;
var
r: TRect;
CI: TCursorInfo;
Icon: TIcon;
II: TIconInfo;
begin
Result := TBitmap.Create;
r := Rect(0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN));
Screenshot(Result, r);
if IncludeCursor then
begin
Icon := TIcon.Create;
try
CI.cbSize := SizeOf(CI);
if GetCursorInfo(CI) then
if CI.flags = CURSOR_SHOWING then
begin
Icon.Handle := CopyIcon(CI.hCursor);
if GetIconInfo(Icon.Handle, II) then
begin
Result.Canvas.Draw(ci.ptScreenPos.x - Integer(II.xHotspot), ci.ptScreenPos.y - Integer(II.yHotspot), Icon);
end;
end;
finally
Icon.Free;
end;
end;
end;
function Screenshot(IncludeCursor: Boolean; const ScreenArea: TRect): TBitmap;
var
r: TRect;
CI: TCursorInfo;
Icon: TIcon;
II: TIconInfo;
begin
Result := TBitmap.Create;
r := ScreenArea;
Screenshot(Result, r);
if IncludeCursor then
begin
Icon := TIcon.Create;
try
CI.cbSize := SizeOf(CI);
if GetCursorInfo(CI) then
if CI.flags = CURSOR_SHOWING then
begin
Icon.Handle := CopyIcon(CI.hCursor);
if GetIconInfo(Icon.Handle, II) then
begin
Result.Canvas.Draw(ci.ptScreenPos.x - Integer(II.xHotspot) - r.Left, ci.ptScreenPos.y - Integer(II.yHotspot) - r.Top, Icon);
end;
end;
finally
Icon.Free;
end;
end;
end;
end.