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.
08.04.2012, 01:29
Древовидный вид