Unit unit1;
Interface
Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, stdctrls;
Type
Tform1 = Class (tform)
Procedure formcreate (Sender: tobject );
Procedure formdestroy (Sender: tobject );
Private
Procedure wmhotkey (var msg: twmhotkey); message wm_hotkey;
Public
End;
VaR
Form1: tform1;
Implementation
{$ R *. DFM}
Uses pngimage; // PNG support
VaR
Hotkeyid: array [0 .. 1] of integer; // hotkey list
// Capture the current window and save it as BMP or PNG
Procedure getpicture (PNG: Boolean = false );
VaR
R: trect;
BMP: tbitmap;
Begin
Getwindowrect (getforegroundwindow, R );
BMP: = tbitmap. Create;
BMP. setsize (R. Right-R. Left, R. Bottom-R. Top );
Bitblt (BMP. Canvas. Handle, 0, 0, BMP. Width, BMP. Height, getdc (0), R. Left, R. Top, srccopy );
If PNG then
Tpngimage (BMP). savetofile ('C: \ temp \ 001.png ')
Else
BMP. savetofile ('C: \ temp \ 001.bmp ');
BMP. Free;
End;
// Register system hotkeys F8 and F9
Procedure tform1.formcreate (Sender: tobject );
VaR
I: integer;
Begin
For I: = low (hotkeyid) to high (hotkeyid) Do
Hotkeyid [I]: = globaladdatom (pchar (inttostr (I )));
Registerhotkey (handle, hotkeyid [0], 0, vk_f8); // F8
Registerhotkey (handle, hotkeyid [1], 0, vk_f9); // F9
End;
// Process System hotkeys
Procedure tform1.wmhotkey (var msg: twmhotkey );
Begin
If msg. hotkey = hotkeyid [0] Then getpicture; // save BMP
If msg. hotkey = hotkeyid [1] Then getpicture (true); // save PNG
End;
// Destroy system hotkeys
Procedure tform1.formdestroy (Sender: tobject );
VaR
I: integer;
Begin
For I: = low (hotkeyid) to high (hotkeyid) Do
Begin
Unregisterhotkey (handle, hotkeyid [I]);
Globaldeleteatom (hotkeyid [I]);
End;
End;
End.