|
#1
|
||||
|
||||
Снимок окна
Добрый день. Стыдно, что обращаюсь, но до не могу понять, в чем загвоздка.
Суть в следующем: необходимо сделать снимок окна под курсором. Зарегал глобарьную горячую клавишу. По событию на неё получаю Хендл окна под курсором и делаю с него снимок. Код:
procedure TfMain.WMHotKey(var Msg: TWMHotKey); var lpPoint: TPoint; DestDC: HDC; r: TRect; b: TBitmap; begin if Msg.HotKey = id_Search then begin GetCursorPos(lpPoint); DestWND := WindowFromPoint(lpPoint); GetWindowRect(DestWnd, r); b := TBitmap.Create; b.Width := r.Right - r.Left; b.Height := r.Bottom - r.Top; DestDC := GetWindowDC(DestWND); try BitBlt(b.Canvas.Handle, 0, 0, r.Right - r.Left, r.Bottom - r.Top, DestDC, 0, 0, SRCCOPY); b.SaveToFile('c:\1.bmp'); b.Free; finally ReleaseDC(DestWND, DestDC); end; end; end; Грамотно поставленный вопрос содержит не менее 50% ответа. Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть. |
#2
|
|||
|
|||
PrintWindow должен уметь это
|
#3
|
||||
|
||||
Код:
var rcSrc:Trect; hSrcWnd:HWND; hDC1:HDC; hSrcDC:HDC; hBmp:HBITMAP ; Bmp:TBitmap; lpPoint: TPoint; begin GetCursorPos(lpPoint); hSrcWnd := WindowFromPoint(lpPoint); bmp:=TBitmap.Create; GetWindowRect(hSrcWnd, rcSrc); if (rcSrc.Right - rcSrc.Left < 170) and (rcSrc.Bottom - rcSrc.Top < 40) then begin ShowWindow(hSrcWnd, SW_SHOWNORMAL); sleep(100); GetWindowRect(hSrcWnd, rcSrc); end; hDC1:= GetDC(hSrcWnd); hSrcDC:=CreateCompatibleDC(hDC1); hBmp := CreateCompatibleBitmap(hDC1, rcSrc.right - rcSrc.left, rcSrc.bottom - rcSrc.top); SelectObject(hSrcDC, hBmp); PrintWindow(hSrcWnd, hSrcDC, 0); BitBlt( hDC1, 0, 0, rcSrc.right - rcSrc.left, rcSrc.bottom - rcSrc.top, hSrcDC, 0, 0, SRCCOPY); bmp.Handle:=hbmp; bmp.SaveToFile('c:\screen_shot.bmp'); DeleteObject(hBmp); DeleteDC(hSrcDC); ReleaseDC(hSrcWnd, hDC1); bmp.Free; Image1.Picture.LoadFromFile('c:\screen_shot.bmp'); При этом: Код:
function PrintWindow(hwnd: HWND; hdcBlt: HDC; nFlags: UINT): BOOL; stdcall; ... function PrintWindow; external user32 name 'PrintWindow'; Помогаю за Спасибо Последний раз редактировалось v1s2222, 07.04.2012 в 13:02. |
#4
|
||||
|
||||
Цитата:
Код:
BitBlt(b.Canvas.Handle, 0, 0, r.Right - r.Left, r.Bottom - r.Top, DestDC, 0, 0, SRCCOPY); Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#5
|
||||
|
||||
Что то я тормознул с нулями. Вот небольшой пример, но на API.
Код:
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. Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. Последний раз редактировалось angvelem, 08.04.2012 в 03:46. |