Source code of screenshots with mouse Images

Http://www.codesky.net/article/doc/200308/2003081880503855.htm

Try this, but there may be several pixel deviations in the mouse position.

UnitMygraph;

Interface
Uses
Windows, messages, sysutils, classes, graphics, controls,
Forms, dialogs, JPEG, registry;

Type
Tcapmode = (cmcapfullscr, cmcapwindow, cmcapwindowclient, cmcapobject );
Tsavetype = (stbitmap, stjpeg );
Tpic =Class
Private
Picinfostr:String;
Public
FunctionLoadpic (pathname:String): Tbitmap;
ProcedureSavepic (pathname:String; PIC: tbitmap;
Savetype: tsavetype; picquality: Word );
FunctionGetlastloadpicinfostr:String;
End;



//////////////////////////////////////// ////////////////////////////
// The screen reading function captures the entire screen, the current window,
// The client area of the current window, the object at the current mouse
ProcedureCapfullscr (VaRDeST: tbitmap; includecursor: Boolean );
ProcedureCapwindow (winhandle: hwnd;VaRDeST: tbitmap; includecursor: Boolean );
ProcedureCapclient (winhandle: hwnd;VaRDeST: tbitmap; includecursor: Boolean );
ProcedureCapobject (VaRDeST: tbitmap; includecursor: Boolean );
ProcedureDrawcursor (VaRDeST: tbitmap; objectleft, objecttop: integer );// Call the above functions
FunctionCapandsavetofile (pathname: ansistring; capmode: tcapmode; savetype: tsavetype; capcursor: Boolean;
Picquality: word; savebit: tpixelformat; stretchmode: integer;
Stretchper: integer; picbreadth: integer; picheight: integer): Boolean;
//////////////////////////////////////// //////////////////////////////

ProcedureBMP tojpeg (bmp pic: tbitmap;VaRRequired PIC: tsf-image; picquality: integer );
ProcedureUsing tobmp (using PIC: tsf-image;VaRBMP: tbitmap );
ProcedureExport filetobmp (export pathname, BMP pathname:String);

//////////////////////////////////////// ///////////////////////////////////
Implementation

ProcedureCapfullscr (VaRDeST: tbitmap; includecursor: Boolean );

VaR
DC: HDC;

Begin
DeST. Width: = screen. width;
DeST. Height: = screen. height;
DC: = getdc (0 );
Bitblt (DEST. Canvas. Handle, 0, 0, screen. Width, screen. Height, DC, 0, srccopy );
IfIncludecursorThenDrawcursor (DEST, 0, 0 );
Releasedc (0, DC );
End;

ProcedureCapwindow (winhandle: hwnd;VaRDeST: tbitmap; includecursor: Boolean );
VaR
DC: HDC;
R: trect;

Begin
Getwindowrect (winhandle, R );
DeST. Width: = R. Right-r.Left;
DeST. Height: = R. Bottom-r.Top;
DC: = getwindowdc (winhandle );
Bitblt (DEST. Canvas. Handle, dest. Width, dest. Height, DC, srccopy );
IfIncludecursorThenDrawcursor (DEST, R. Left, R. Top );
Releasedc (winhandle, DC );
End;

ProcedureCapclient (winhandle: hwnd;VaRDeST: tbitmap; includecursor: Boolean );
VaR
DC: HDC;
_ R, R: trect;

Begin
Getwindowrect (winhandle, _ R );
Getclientrect (winhandle, R );
DeST. Width: = R. Right-r.Left;
DeST. Height: = R. Bottom-r.Top;
DC: = getdc (winhandle );
Bitblt (DEST. Canvas. Handle, dest. Width, dest. Height, DC, srccopy );
IfIncludecursorThenDrawcursor (DEST, _ R. Right-r.right, _ R. bottom-r.bottom );
Releasedc (winhandle, DC );
End;

ProcedureCapobject (VaRDeST: tbitmap; includecursor: Boolean );
VaR
DC: HDC;
R: trect;
POs: tpoint;
Winhandle: hwnd;
Begin
Getcursorpos (POS );
Winhandle: = windowfrompoint (POS );
Getwindowrect (winhandle, R );
DeST. Width: = R. Right-r.Left;
DeST. Height: = R. Bottom-r.Top;
DC: = getwindowdc (winhandle );
Bitblt (DEST. Canvas. Handle, dest. Width, dest. Height, DC, srccopy );
POs. X: = pos. x-r.Left-10;
POs. Y: = pos. y-r.Top-10;
IfIncludecursorThenDrawcursor (DEST, R. Left, R. Top );
Releasedc (winhandle, DC );
End;

ProcedureDrawcursor (VaRDeST: tbitmap; objectleft, objecttop: integer );
VaRGlobalcur: ticon;
Windowhld: hwnd;
Threadld: DWORD;
POs: tpoint;
Begin
Getcursorpos (POS );
Optional whld: = getforegroundwindow;
Threadld: = getwindowthreadprocessid (windowhld,Nil);
Attachthreadinput (getcurrentthreadid, threadld, true );
Globalcur: = ticon. Create;
Globalcur. Handle: = getcursor;
Attachthreadinput (getcurrentthreadid, threadld, false );
DeST. Canvas. Brush. Style: = bsclear;
DeST. Canvas. Draw (Pos. x-ObjectLeft-10,
POs. y-ObjectTop-10, globalcur );
End;

//////////////////////////////////////// ////////////////////////////

ProcedureBMP tojpeg (bmp pic: tbitmap;VaRRequired PIC: tsf-image; picquality: integer );
Begin
Invalid pic. Assign (BMP pic );
Required pic. compressionquality: = picquality;
Using PIC. Compress;
End;

ProcedureUsing tobmp (using PIC: tsf-image;VaRBMP: tbitmap );
Begin
BMP. Assign (invalid pic );
End;

ProcedureExport filetobmp (export pathname, BMP pathname:String);
VaR
Required PIC: tsf-image;
BMP: tbitmap;
Begin
Required PIC: = tsf-image. Create;
Bmp pic: = tbitmap. Create;
Try
Using PIC. loadfromfile (using pathname );
BMP pic. Assign (invalid pic );
BMP pic. savetofile (BMP pathname );
Except
OnE: exceptionDo
MessageBox (0, pchar (E.Message), 'Error', mb_ OK );
End;
Invalid pic. free;
BMP. Free;
End;



//////////////////////////////////////// ///////////////////////////////

FunctionCapandsavetofile (pathname: ansistring; capmode: tcapmode; savetype: tsavetype;
Capcursor: Boolean; picquality: word; savebit: tpixelformat;
Stretchmode: integer; stretchper: integer; picbreadth: integer;
Picheight: integer): Boolean;
VaR
BMP: tbitmap;
Tmpbmp: tbitmap;
Rect1, rect2: trect;
Begin
BMP: = tbitmap. Create;
Try
CaseCapmodeOf
Cmcapfullscr: capfullscr (BMP, capcursor );
Cmcapwindow: capwindow (getforegroundwindow, BMP, capcursor );
Cmcapwindowclient: capclient (getforegroundwindow, BMP, capcursor );
Cmcapobject: capobject (BMP, capcursor );
End;
If NotDirectoryexists (extractfilepath (pathname ))Then
Begin
Result: = false;
Exit;
End;
BMP. pixelformat: = savebit;
// Scaling
IfStretchmode = 0Then
Begin
IfStretchper & lt; & gt; 100Then
Begin
Tmpbmp: = tbitmap. Create;
Tmpbmp. Assign (BMP );
Rect1: = rect (0, 0, round (BMP. Width * stretchper/100), round (BMP. Height * stretchper/100 ));
Rect2: = rect (0, 0, BMP. Width, BMP. Height );
BMP. Canvas. copymode: = cmsrccopy;
BMP. Width: = rect1.right;
BMP. Height: = rect1.bottom;
BMP. Canvas. copyrect (rect1, tmpbmp. Canvas, rect2 );
Tmpbmp. Free;
End;
End
Else
Begin
Tmpbmp: = tbitmap. Create;
Tmpbmp. Assign (BMP );
Rect1: = rect (0, 0, picbreadth, picheight );
Rect2: = rect (0, 0, BMP. Width, BMP. Height );
BMP. Canvas. copymode: = cmsrccopy;
BMP. Width: = rect1.right;
BMP. Height: = rect1.bottom;
BMP. Canvas. copyrect (rect1, tmpbmp. Canvas, rect2 );
Tmpbmp. Free;
End;
Tpic. Create. savepic (pathname, BMP, savetype, picquality );
BMP. Free;
Result: = true;
Except
BMP. Free;
Result: = false;
End;
End;





{Tpic}

FunctionTpic. getlastloadpicinfostr:String;
Begin
Result: = picinfostr;
End;

FunctionTpic. loadpic (pathname:String): Tbitmap;
VaR
JPEG: tsf-image;
Ext:String;
Pictypeinfostr:String;
Begin
Result: = tbitmap. Create;
Ext: = extractfileext (pathname );
Try
IfComparetext(ext,'.bmp ') = 0Then
Result. loadfromfile (pathname );
Pictypeinfostr: = 'bmp bitmap ';
//////////////////////////////////////// ////////////////////
If((Comparetext(ext,'.jpg ') = 0)Or(Comparetext(ext,'.jpeg ') = 0 ))Then
Begin
JPEG: = tsf-image. Create;
Try
JPEG. loadfromfile (pathname );
Result. Assign (JPEG );
Pictypeinfostr: = 'jpeg image ';
Except
JPEG. Free;
Raise;
End;
End;
//////////////////////////////////////// /////////////////////
Picinfostr: = inttostr (result. width) + 'X' + inttostr (result. Height );
CaseResult. pixelformatOf
Pf1bit: picinfostr: = picinfostr + 'x1 bit ';
Pf4bit: picinfostr: = picinfostr + 'x4 bit ';
Pf8bit: picinfostr: = picinfostr + 'x8bit ';
Pf15bit: picinfostr: = picinfostr + 'x15bit ';
Pf16bit: picinfostr: = picinfostr + 'x16bit ';
Pf24bit: picinfostr: = picinfostr + 'x24bit ';
Pf32bit: picinfostr: = picinfostr + 'x32bit ';
End;
Picinfostr: = picinfostr + ''+ pictypeinfostr;
Except
Result. Free;
Raise;
End;
End;

ProcedureTpic. savepic (pathname:String; PIC: tbitmap; savetype: tsavetype;
Picquality: Word );
VaR
JPEG: tsf-image;
Begin
CaseSavetypeOf
Stbitmap:
PIC. savetofile (pathname );
//////////////////////////////////////// ///////////////////////
Stjpeg:
Begin
JPEG: = tsf-image. Create;
Try
JPEG. Assign (PIC );
JPEG. compressionquality: = picquality;
JPEG. Compress;
JPEG. savetofile (pathname );
Except
JPEG. Free;
Raise;
End;
End;
//////////////////////////////////////// ///////////
End;
End;

End.