program
HotKey;
uses
Windows, Messages;
type
HATOM =
Integer
;
var
Wnd : HWND;
Msg : TMsg;
WndClass : TWndClassEX;
SnapShot : HATOM;
DestWnd : HWND;
aRect : TRect;
function
PrintWindow(Wnd : HWND; toDC : HDC; nFlags : UINT) :
Boolean
; stdcall external
'user32.dll'
;
procedure
SaveToFile(BmpName :
String
; bmp : HBITMAP);
var
bm : Windows
.
TBitmap;
pBitmap :
Pointer
;
BFH : BITMAPFILEHEADER;
BI : BITMAPINFO;
BitCount :
Word
;
DC : HDC;
FileHandle : THandle;
Size, Count : DWORD;
function
BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment:
Longint
):
Longint
;
begin
dec(Alignment);
Result := ((PixelsPerScanline * BitsPerPixel) + Alignment)
and
not
Alignment;
Result := Result
shr
3
;
end
;
begin
GetObject(bmp, Sizeof(bm), @bm);
Size := BytesPerScanLine(bm
.
bmWidth, bm
.
bmBitsPixel,
32
) * bm
.
bmHeight;
GetMem(pBitmap, Size);
try
BitCount := bm
.
bmPlanes * bm
.
bmBitsPixel;
FillChar(BI, SizeOf(BI),
0
);
with
BI
.
bmiHeader
do
begin
biSize := SizeOf(BITMAPINFOHEADER);
biWidth := bm
.
bmWidth;
biHeight := bm
.
bmHeight;
biPlanes :=
1
;
biBitCount := BitCount;
biSizeImage := Size;
if
(BitCount <
16
)
then
biClrUsed := (
1
shl
BitCount);
end
;
FillChar(BFH, SizeOf(BFH),
0
);
BFH
.
bfType :=
$4D42
;
BFH
.
bfOffBits := SizeOf(BFH) + SizeOf(BITMAPINFOHEADER) + BI
.
bmiHeader
.
biClrUsed * SizeOf(RGBQUAD);
BFH
.
bfSize := BFH
.
bfOffBits + Size;
DC := GetDC(
0
);
GetDIBits(DC, bmp,
0
, bm
.
bmHeight, pBitmap, BI, DIB_RGB_COLORS);
ReleaseDC(
0
, DC);
FileHandle := CreateFile(
PChar
(BmpName), GENERIC_WRITE, FILE_SHARE_WRITE,
NIL
, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL,
0
);
WriteFile(FileHandle, BFH, SizeOf(BFH), Count,
NIL
);
WriteFile(FileHandle, BI, SizeOf(BITMAPINFOHEADER) + BI
.
bmiHeader
.
biClrUsed * SizeOf(RGBQUAD), Count,
NIL
);
WriteFile(FileHandle, pBitmap^, Size, Count,
NIL
);
CloseHandle(FileHandle);
finally
FreeMem(pBitmap);
end
;
end
;
procedure
Method1;
var
DC,
DestDC,
bmpDC : HDC;
bmp,
oldbmp : HBITMAP;
begin
DC := GetDC(
0
);
try
bmpDC := CreateCompatibleDC(DC);
bmp := CreateCompatibleBitmap(DC, aRect
.
Right - aRect
.
Left, aRect
.
Bottom - aRect
.
Top);
oldbmp := SelectObject(bmpDC, bmp);
try
DestDC := GetWindowDC(DestWND);
try
BitBlt(bmpDC,
0
,
0
, aRect
.
Right - aRect
.
Left, aRect
.
Bottom - aRect
.
Top, DestDC,
0
,
0
, SRCCOPY);
SaveToFile(
'1.bmp'
, bmp);
finally
ReleaseDC(DestWND, DestDC);
end
;
finally
DeleteObject(SelectObject(bmpDC, oldbmp));
end
;
finally
ReleaseDC(
0
, DC);
end
;
end
;
procedure
Method2;
var
DC,
bmpDC : HDC;
bmp,
oldbmp : HBITMAP;
begin
DC := GetDC(
0
);
try
bmpDC := CreateCompatibleDC(DC);
bmp := CreateCompatibleBitmap(DC, aRect
.
Right - aRect
.
Left, aRect
.
Bottom - aRect
.
Top);
oldbmp := SelectObject(bmpDC, bmp);
try
PrintWindow(DestWnd, bmpDC,
0
);
SaveToFile(
'11.bmp'
, bmp);
finally
DeleteObject(SelectObject(bmpDC, oldbmp));
end
;
finally
ReleaseDC(
0
, DC);
end
;
end
;
procedure
CreateSnapShot;
var
Pt : TPoint;
begin
GetCursorPos(Pt);
DestWND := WindowFromPoint(Pt);
GetWindowRect(DestWnd, aRect);
Method1;
Method2;
end
;
function
MainProc(Wnd : HWND; Msg :
Integer
; wParam, lParam :
Longint
):
Integer
; stdcall;
begin
Result :=
0
;
case
Msg
of
WM_CREATE :
begin
SnapShot := GlobalAddAtom(
'HotKey1'
);
RegisterHotKey(Wnd, SnapShot, MOD_CONTROL
or
MOD_ALT, VK_SNAPSHOT);
end
;
WM_HOTKEY :
if
wParam = SnapShot
then
CreateSnapShot;
WM_DESTROY :
begin
UnRegisterHotKey(Wnd, SnapShot);
GlobalDeleteAtom(SnapShot);
PostQuitMessage(
0
);
Exit;
end
;
end
;
Result := DefWindowProc(Wnd, Msg, wParam, lParam);
end
;
begin
FillChar(WndClass, SizeOf(TWndClassEx),
0
);
WndClass
.
cbSize := SizeOf(TWndClassEx);
WndClass
.
style := CS_HREDRAW
or
CS_VREDRAW;
WndClass
.
lpfnWndProc := @MainProc;
WndClass
.
cbClsExtra :=
0
;
WndClass
.
cbWndExtra :=
0
;
WndClass
.
hInstance := hInstance;
WndClass
.
hCursor := LoadCursor(
0
, IDC_ARROW);
WndClass
.
hbrBackGround := GetSysColorBrush(COLOR_BTNFACE);
WndClass
.
lpszClassName :=
'HotKey'
;
if
RegisterClassEx(WndClass) =
0
then
Halt(
255
);
Wnd := CreateWindowEx(
0
,
'HotKey'
,
'HotKey'
, WS_DLGFRAME
or
WS_SYSMENU
or
WS_MINIMIZE,
0
,
0
,
320
,
200
,
0
,
0
, hInstance,
NIL
);
ShowWindow(Wnd, SW_SHOWMINIMIZED);
while
(GetMessage(msg,
0
,
0
,
0
))
do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end
;
Halt(msg
.
wParam);
end
.