из интернетов
137 / 34 / 7
Регистрация: 16.01.2008
Сообщений: 392
|
|
1 | |
Снимок окна31.01.2008, 15:51. Показов 7564. Ответов 3
Метки нет (Все метки)
Возникла необходимость сделать снимок активного окна. Есть код как принтскринить
рабочий стол, пытался переделать, не прёт что то (рисунок белый). Например окно с названием "Autorun" активно, вот код Код
var bmp: TBitmap; DC: HDC; h:hwnd; begin bmp:=TBitmap.Create; bmp.Height:=Screen.Height;//задаю размер bmp.Width:=Screen.Width; //GetForegroundWindow; //типа получить активное окно, наверно не нужно здесь DC:=GetDC(h); //подставляю хэндл bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, ////////////// DC, 0, 0, SRCCOPY); bmp.SaveToFile('Screen.bmp'); ReleaseDC(0, DC); end;
0
|
31.01.2008, 15:51 | |
Ответы с готовыми решениями:
3
Сделать снимок с вебкамеры Дочерние окна сворачивать в пределах главного окна (Delphi 7) Снимок с камеры Снимок экрана |
Администратор
83905 / 52491 / 244
Регистрация: 10.04.2006
Сообщений: 13,459
|
|
31.01.2008, 16:02 | 2 |
Сообщение было отмечено mik-a-el как решение
РешениеКод
{ Функции копирования экрана в < Delphi > } unit ScrnCap; interface uses WinTypes, WinProcs, Forms, Classes, Graphics, Controls; function CaptureScreenRect( ARect: TRect ): TBitmap; function CaptureScreen: TBitmap; function CaptureClientImage( Control: TControl ) : TBitmap; function CaptureControlImage( Control: TControl ) : TBitmap; implementation { Копирование прямоугольной области экрана... } function CaptureScreenRect( ARect: TRect ) : TBitmap; var ScreenDC: HDC; begin Result := TBitmap.Create; with Result, ARect do begin Width := Right - Left; Height := Bottom - Top; ScreenDC := GetDC( 0 ); try < BitBlt >( Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY ); finally ReleaseDC( 0, ScreenDC ); end; end; end; { Копирование всего экрана... } function CaptureScreen: TBitmap; begin with Screen do Result := CaptureScreenRect( Rect( 0, 0, Width, Height )); end; { Копирование клиентской области формы или элемента... } function CaptureClientImage( Control: TControl ) : TBitmap; begin with Control, Control.ClientOrigin do Result := CaptureScreenRect( Bounds( X, Y, ClientWidth, ClientHeight )); end; { Копирование всей формы или элемента... } function CaptureControlImage( Control: TControl ) : TBitmap; begin with Control do if Parent = nil then Result := CaptureScreenRect( Bounds( Left, Top, Width, Height )) else with Parent.ClientToScreen( Point( Left, Top )) do Result := CaptureScreenRect( Bounds( X, Y, Width, Height )); end; end.
0
|
из интернетов
137 / 34 / 7
Регистрация: 16.01.2008
Сообщений: 392
|
|
01.02.2008, 13:38 [ТС] | 3 |
А как сохранить это в файл?
Код
{ Копирование прямоугольной области экрана... } function CaptureScreenRect( ARect: TRect ) : TBitmap; var ScreenDC: HDC; begin Result := TBitmap.Create; with Result, ARect do begin Width := Right - Left; Height := Bottom - Top; ScreenDC := GetDC( 0 ); try < BitBlt >( Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY ); finally ReleaseDC( 0, ScreenDC ); end; end; end;
0
|
212 / 10 / 4
Регистрация: 25.04.2007
Сообщений: 67
|
|
01.02.2008, 16:19 | 4 |
TBitmap.SaveToFile, например
или TBitmap.SaveToStream, через дополнительный файловый поток (TFileStream)
0
|
01.02.2008, 16:19 | |
01.02.2008, 16:19 | |
Помогаю со студенческими работами здесь
4
StringGrid И снимок экрана Снимок элемента формы Снимок части экрана Снимок с камеры ноутбука Искать еще темы с ответами Или воспользуйтесь поиском по форуму: |