| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Print Screen видео [D7, WinXP]
Eraser © (2005-04-11 21:26:00)Добрый вечер! Вопрос такой: как сделать Print Screen окна, в котором отображается видео?
Копирование с HDC окна даёт чёрный прямоугольник...
Спасибо.
Eraser (2005-04-22 15:42:00) [1]Grief ©
Так мне общий случай нужен... а не частный.
Кстати в Win медиапелеере некоторые типы файлов снимаются принт скрином, некотрые нет... наверное декодеры разные.
Grief (2005-04-20 18:34:00) [2]винамп снимается и принтскрином и через DC, юзай его!
Анонимщик1 (2005-04-18 11:07:00) [3]Это все. С зябликами разбирайтесь сами. Если будут вопросы по коду, объяснить смогу только на протяжении сегодняшнего дня.
Анонимщик1 (2005-04-18 11:05:00) [4]Конец окончания:
RxMemoryData1.First;
while not RxMemoryData1.Eof do
begin
currFileName := DirectoryEdit1.Text + '\' + RxMemoryData1StopCadr.AsString + '.bmp';
rt := RxMemoryData1StopCadr.AsLargeInt * 10000;
if rt
Анонимщик1 (2005-04-18 11:03:00) [5]Середина окончания:
try
hr := CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC, IID_IGraphBuilder, pGraphBuilder);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ ñîçäàòü GraphBuilder');
hr := CoCreateInstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC, IID_ISampleGrabber, pSampleGrabber);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ ñîçäàòü SampleGrabber');
pGrabCB := TGrabCB.Create(nil);
if not Assigned(pGrabCB) then raise Exception.Create('Íå óäàåòñÿ ñîçäàòü SampleGrabberCB');
hr := pSampleGrabber.SetCallback(pGrabCB, 1);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ óñòàíîâèòü callback - ôóíêöèþ');
pSampleGrabber.SetOneShot(TRUE);
hr := CoCreateInstance(CLSID_NullRenderer, nil, CLSCTX_INPROC, IID_IBaseFilter, pNullRenderer);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ ñîçäàòü NullRenderer');
hr := pGraphBuilder.QueryInterface(IID_IMediaControl, pMediaControl);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ ïîëó÷èòü èíòåðôåéñ MediaControl');
hr := pGraphBuilder.QueryInterface(IID_IMediaEvent, pMediaEvent);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ ïîëó÷èòü èíòåðôåéñ MediaEvent');
hr := pGraphBuilder.AddSourceFilter(StringToOleStr(Label1.Caption), '', pSourceFile);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ äîáàâèòü ôèëüòð èñòî÷íèêà');
hr := pGraphBuilder.AddFilter(pSampleGrabber as IBaseFilter, 'Sample Grabber');
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ äîáàâèòü SampleGrabber');
hr := pGraphBuilder.AddFilter(pNullRenderer, 'Null Renderer');
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ äîáàâèòü NullRenderer');
pSourceOutPin := GetPin(pSourceFile, PINDIR_OUTPUT);
if not Assigned(pSourceOutPin) then raise Exception.Create('Íå óäàåòñÿ ïîëó÷èòü èñõîäÿùèé êîíòàêò ôèëüòðà èñòî÷íèêà');
pSampleGrabberInPin := GetPin(pSampleGrabber as IBaseFilter, PINDIR_INPUT);
if not Assigned(pSampleGrabberInPin) then raise Exception.Create('Íå óäàåòñÿ ïîëó÷èòü âõîäÿùèé êîíòàêò çàãðàáàñòîðà');
hr := pGraphBuilder.Connect(pSourceOutPin, pSampleGrabberInPin);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ ñîåäèíèòü ôèëüòð èñòî÷íèêà è SampleGraber');
pSampleGrabberOutPin := GetPin(pSampleGrabber as IBaseFilter, PINDIR_OUTPUT);
if not Assigned(pSampleGrabberOutPin) then raise Exception.Create('Íå óäàåòñÿ ïîëó÷èòü èñõîäÿùèé êîíòàêò çàãðàáàñòîðà');
pNullRenderInPin := GetPin(pNullRenderer, PINDIR_INPUT);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ ïîëó÷èòü âõîäÿùèé êîíòàêò NullRenderer''à');
hr := pGraphBuilder.Connect(pSampleGrabberOutPin, pNullRenderInPin);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ ñîåäèíèòü SampleGraber è NullRenderer');
hr := pGraphBuilder.QueryInterface(IID_IMediaSeeking, pMediaSeeking);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ ïîëó÷èòü èíòåðôåéñ MediaSeeking');
hr := pMediaSeeking.SetTimeFormat(TIME_FORMAT_MEDIA_TIME);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ óñòàíîâèòü çàáèòûé ìíîþ ôîðìàò âðåìåíè');
hr := pMediaSeeking.GetDuration(length);
if FAILED(hr) then raise Exception.Create('Íå óäàåòñÿ ïîëó÷èòü äëèòåëüíîñòü');
Анонимщик1 (2005-04-18 10:59:00) [6]Начало окончания:
procedure TForm1.FullProcessing;
var
hr: HRESULT;
rt: REFERENCE_TIME;
evCode: Integer;
pGraphBuilder : IGraphBuilder;
pSourceFile : IBaseFilter;
pMediaControl : IMediaControl;
pMediaEvent : IMediaEvent;
pMediaSeeking : IMediaSeeking;
pNullRenderer : IBaseFilter;
pSourceOutPin : IPin;
pSampleGrabberInPin : IPin;
pSampleGrabberOutPin : IPin;
pNullRenderInPin : IPin;
pGrabCB : TGrabCB;
length : LongLong;
begin
Enabled := false;
pGraphBuilder := nil;
pSourceFile := nil;
pMediaControl := nil;
pMediaEvent := nil;
pMediaSeeking := nil;
pNullRenderer := nil;
pSourceOutPin := nil;
pSampleGrabberInPin := nil;
pSampleGrabberOutPin := nil;
pNullRenderInPin := nil;
pGrabCB := nil;
Анонимщик1 (2005-04-18 10:56:00) [7]Продолжение:
function TGrabCB.BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: Longint): HRESULT; stdcall;
function GetDIBLineSize(BitCount, Width: Integer): Integer;
begin
if BitCount = 15 then BitCount := 16;
Result := ((BitCount * Width + 31) div 32) * 4;
end;
var
Bmp : TBitmap;
BitmapHandle: HBitmap;
MediaType : TAMMediaType;
BiHeaderPtr : PBitmapInfoHeader;
DIBPtr : Pointer;
DIBSize : LongInt;
errorCode: Integer;
newMediaType: TAMMediaType;
BMPInfo: TBitmapInfo;
begin
Result := pSampleGrabber.GetConnectedMediaType(MediaType);
if Result S_OK then exit;
try
Bmp := TBitmap.Create;
if not IsEqualGUID(MediaType.majortype, MEDIATYPE_VIDEO) then exit;
BiHeaderPtr := nil;
if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then begin
if MediaType.cbFormat = SizeOf(TVideoInfoHeader) then
BIHeaderPtr := @(PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader);
end else if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo2) then begin
if MediaType.cbFormat = SizeOf(TVideoInfoHeader2) then
BIHeaderPtr := @(PVideoInfoHeader2(MediaType.pbFormat)^.bmiHeader);
end;
if not Assigned(BiHeaderPtr) then begin
New(BiHeaderPtr);
BiHeaderPtr.biSize := SizeOf(TVideoInfoHeader);
BiHeaderPtr.biWidth := PVideoInfoHeader(MediaType.pbFormat).bmiHeader.biWidth;
BiHeaderPtr.biHeight := PVideoInfoHeader(MediaType.pbFormat).bmiHeader.biHeight;
BiHeaderPtr.biPlanes := PVideoInfoHeader(MediaType.pbFormat).bmiHeader.biPlanes;
BiHeaderPtr.biBitCount := PVideoInfoHeader(MediaType.pbFormat).bmiHeader.biBitCount;
end;
BitmapHandle := CreateDIBSection(0, PBitmapInfo(BIHeaderPtr)^, DIB_RGB_COLORS, DIBPtr, 0, 0);
if BitmapHandle 0 then begin
try
if DIBPtr = nil then exit;
DIBSize := BIHeaderPtr.biSizeImage;
if DIBSize = 0 then DIBSize := GetDIBLineSize(BIHeaderPtr.biBitCount, BIHeaderPtr.biWidth) *
BIHeaderPtr.biHeight * BIHeaderPtr.biPlanes;
if not Assigned(pBuffer) then begin
BufferLen := 0;
if (pSampleGrabber.GetCurrentBuffer(BufferLen, 0) S_OK) or (BufferLen DIBSize then BufferLen := DIBSize;
if pSampleGrabber.GetCurrentBuffer(BufferLen, DIBPtr) S_OK then exit;
end else begin
if BufferLen > DIBSize then BufferLen := DIBSize;
Move(pBuffer^, DIBPtr^, BufferLen);
end;
Bmp.Handle := BitmapHandle;
finally
if Bmp.Handle BitmapHandle
then DeleteObject(BitmapHandle)
else Bmp.SaveToFile(currFileName);
end;
end;
finally
if MediaType.cbFormat 0 then begin
CoTaskMemFree(MediaType.pbFormat);
MediaType.cbFormat := 0;
MediaType.pbFormat := 0;
end;
if MediaType.pUnk nil then MediaType.pUnk := nil;
Bmp.Free;
end;
Result := S_OK;
end;
function GetPin(pFilter: IBaseFilter; pinDir: PIN_DIRECTION): IPin;
var
bFound: boolean;
pEnum : IEnumPins;
pPin : IPin;
PinDirThis: PIN_DIRECTION;
begin
bFound := false;
pFilter.EnumPins(pEnum);
while (pEnum.Next(1, pPin, 0) = S_OK ) do
begin
pPin.QueryDirection(PinDirThis);
if (pinDir = PinDirThis) then begin
bFound := true;
break;
end;
end;
pEnum.Reset;
if bFound
then Result := pPin
else result := nil;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CoInitialize(nil);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CoUninitialize;
end;
procedure TForm1.Load1Click(Sender: TObject);
begin
if not OpenDialog1.Execute then exit;
Label1.Caption := OpenDialog1.FileName;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
fName: String;
begin
if Label1.Caption = '' then raise Exception.Create('Íå çàäàíî èìÿ âèäåîôàéëà');
if not FileExists(Label1.Caption) then raise Exception.Create('Âèäåîôàéë íå íàéäåí');
if DirectoryEdit1.Text = '' then raise Exception.Create('Íå çàäàíî èìÿ äèðåêòîðèè íàçíà÷åíèÿ');
if not DirectoryExists(DirectoryEdit1.Text) then raise Exception.Create('Äèðåêòîðèÿ íàçíà÷åíèÿ íå íàéäåíà');
if RxMemoryData1.IsEmpty then raise Exception.Create('Íå çàäàíî âðåìÿ ñòîï-êàäðîâ');
RxMemoryData1.First;
while not RxMemoryData1.Eof do
begin
fName := DirectoryEdit1.Text + '\' + RxMemoryData1StopCadr.AsString + '.bmp';
if FileExists(fName) then raise Exception.Create('Ôàéë ' + fName + ' óæå ñóùåñòâóåò. Îòìåíà îïåðàöèè.');
RxMemoryData1.Next;
end;
FullProcessing;
end;
Анонимщик1 (2005-04-18 10:55:00) [8]main.pas:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, DB, Grids, DBGridEh, RxMemDS, Mask, ToolEdit,
Buttons;
type
TForm1 = class(TForm)
Label1: TLabel;
MainMenu1: TMainMenu;
File1: TMenuItem;
Load1: TMenuItem;
OpenDialog1: TOpenDialog;
RxMemoryData1: TRxMemoryData;
DBGridEh1: TDBGridEh;
DataSource1: TDataSource;
DirectoryEdit1: TDirectoryEdit;
Label2: TLabel;
BitBtn1: TBitBtn;
RxMemoryData1StopCadr: TLargeintField;
procedure Load1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
procedure FullProcessing;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ActiveX, DirectShow9;
var
currFileName: String = '';
pSampleGrabber: ISampleGrabber;
type
TGrabCB = class(TComponent, ISampleGrabberCB)
private
function SampleCB(SampleTime: Double; pSample: IMediaSample): HRESULT; stdcall;
function BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: Longint): HRESULT; stdcall;
function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
end;
function TGrabCB.QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
begin
Result := inherited QueryInterface(IID, Obj);
end;
function TGrabCB._AddRef: Integer; stdcall;
begin
Result := 2;
end;
function TGrabCB._Release: Integer; stdcall;
begin
Result := 1;
end;
function TGrabCB.SampleCB(SampleTime: Double; pSample: IMediaSample): HRESULT;
begin
ShowMessage('Êó-êó!');
end;
Анонимщик1 (2005-04-18 10:51:00) [9]Код я написал под ваш заказ и в боевых условиях не тестировал.
Поэтому вылавливайте глюки сами. Понимание кода - тоже ваша проблема, когда поймете, попробуйте переделать с использованием DSPack'а - выйдет проще.
Проект состоит из dpr-файла:
program SetMediaPos_Sample;
uses
Forms,
main in 'main.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
И одного pas-модуля c dfm-ом. Я использовал библиотеку RX, так что, если у вас ее нет - не взыщите. Да, забыл сказать, что делает программа: она позволяет выбирать avi-файл (другие форматы тоже, в принципе, не исключаются, но, как я уже говорил на два поста выше, с ними могут быть проблемы), задавать, в миллисекундах время стоп-кадров, и задавать директорию, в которую эти самые стоп-кадры будут складироваться.
Итак, main.dfm:
object Form1: TForm1
Left = 192
Top = 107
Width = 755
Height = 480
Caption = 'Set Media Position And Get Cadrs'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 0
Top = 0
Width = 747
Height = 13
Align = alTop
end
object Label2: TLabel
Left = 323
Top = 22
Width = 85
Height = 13
Caption = 'Destination Folfer:'
end
object DBGridEh1: TDBGridEh
Left = 0
Top = 13
Width = 320
Height = 421
Align = alLeft
DataSource = DataSource1
Flat = True
FooterColor = clWindow
FooterFont.Charset = DEFAULT_CHARSET
FooterFont.Color = clWindowText
FooterFont.Height = -11
FooterFont.Name = 'MS Sans Serif'
FooterFont.Style = []
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
Columns = <
item
EditButtons =
FieldName = 'StopCadr'
Footers =
Title.Alignment = taCenter
Title.Caption = 'Ñòîï-êàäðû, ìèëëèñåêóíäû'
Width = 264
end>
end
object DirectoryEdit1: TDirectoryEdit
Left = 412
Top = 18
Width = 327
Height = 21
NumGlyphs = 1
TabOrder = 1
end
object BitBtn1: TBitBtn
Left = 323
Top = 64
Width = 75
Height = 25
Caption = '&Run'
TabOrder = 2
OnClick = BitBtn1Click
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333000000
033333FFFF77777773F330000077777770333777773FFFFFF733077777000000
03337F3F3F777777733F0797A770003333007F737337773F3377077777778803
30807F333333337FF73707888887880007707F3FFFF333777F37070000878807
07807F777733337F7F3707888887880808807F333333337F7F37077777778800
08807F333FFF337773F7088800088803308073FF777FFF733737300008000033
33003777737777333377333080333333333333F7373333333333300803333333
33333773733333333333088033333333333373F7F33333333333308033333333
3333373733333333333333033333333333333373333333333333}
NumGlyphs = 2
end
object MainMenu1: TMainMenu
Left = 14
Top = 32
object File1: TMenuItem
Caption = '&File'
object Load1: TMenuItem
Caption = '&Load ...'
OnClick = Load1Click
end
end
end
object OpenDialog1: TOpenDialog
Filter = 'AVI-files|*.avi|All files|*.*'
Left = 46
Top = 32
end
object RxMemoryData1: TRxMemoryData
Active = True
FieldDefs = <
item
Name = 'StopCadr'
DataType = ftLargeint
end>
Left = 14
Top = 66
object RxMemoryData1StopCadr: TLargeintField
FieldName = 'StopCadr'
end
end
object DataSource1: TDataSource
DataSet = RxMemoryData1
Left = 46
Top = 66
end
end
Анонимщик1 (2005-04-17 22:39:00) [10]Есть, кончено. У меня.
Eraser (2005-04-17 00:26:00) [11]LA
Поддерживаю!
LA (2005-04-16 20:57:00) [12]это все, конечно, хорошо... только вот слова оверлей, DirectShow, SampleGrabber ничего мне не говорят (разве лишь говорят то, что где-то я их уже слышал) :(... может быть имеется уже готовый код, который это все делает?
Анонимщик1 (2005-04-15 14:29:00) [13]Зато в ней оверлея нет. Во всяком случае для простых avi сделать токое несложно все с помощью того же DirectShow. Хотя для более сложных случаев тоже можно, главное, чтобы декодеры были соответсвующие и давали возможность выстроить цепочку фильтров с SampleGrabber'ом. Сложность может быть в случае, когда декодер заточен под выдачу видео именно на оверлей (есть такие, сам сталкивался, хотя для них есть возможность отключать такую опцию). Еще одна проблема - непосредственная попытка соединения фильтра файла-источника и SampleGrabber'а. Дело в том, что IntelligentConnect не всегда правильно понимает, что о него требуется, и подсовывает соединение с граббером через аудиоконтакт, например. Ну, в таком случае можно либо вручную строить весь граф, либо, если есть желание помучиться, сделать файлу Render, потом убрать аудиоветвь, найти VideoRenderer, и вместо него подставить соединение с SampleGrabber'ом, а затем все сливать на NullRenderer. Сам же файл проигрывать не нужно, достаточно только позиционироваться с помощью интерфейса IMediaSeeking, а, чтобы при проигрывании не было лишних кадров, вызвать метод ISampleGrabber'а - SetOneShot(TRUE).
Eraser (2005-04-15 14:14:00) [14]LA
Ну это уже немного другая задача... тут внутрь avi файла лезть надо.
Анонимщик1 (2005-04-15 11:34:00) [15]>> LA
Вот интересно, с чего эта тема стала такой популярной последнее время?
LA (2005-04-14 23:53:00) [16]а конкретный код у кого-нибудь имеется? поделитесь, плз...
причем, мне нужно сделать скриншоты с фильмов, например, на 10-ой, 30-ой и 60-ой минутах фильма... желательно, чтобы сам этот фильм не отображался... т.е. проге подсовывается файл и она в заданную папку генерит скрины...
Eraser (2005-04-14 22:00:00) [17]Sapersky
Но вроде как просил "именно для оверлея", вот я и изощряюсь... :)
Вообще я любому совету по этой теме рад! ))
Задача "проста"- перехватить картинку в Media плеере, например...
Sapersky (2005-04-14 21:30:00) [18]Есть способ проще - отключить оверлей, чтобы видео выводилось на обычную поверхность. Делается в настройках фильтра "Video Renderer", причём эти настройки глобальны для DirectShow, так что, наверное, их можно поменять в своей программе.
Но вроде как просил "именно для оверлея", вот я и изощряюсь... :)
Eraser (2005-04-14 15:52:00) [19]Sapersky
ИМХО есть способ проще... существует ряд программ, которые умеют делать принт скрин медиаплееров... может надо DC брать (getwindowDC) конкретно у окна отображения, а не всего десктопа...?
Sapersky (2005-04-14 12:24:00) [20]Попробовал ради интереса сделать по методу [4]. С оверлеем для DX7 работает, а с медиаплеером не хочет. Ну, правильно - даже если используется DirectDraw, зачем MS обращаться к нему через интерфейсы? Они же непосредственно объекты могут использовать.
Так что если делать перехватом функций - нужно влезать в DirectShow. Здесь я не специалист... Но если в DirectShow-программе в принципе можно получить кадр видео, независимо от метода вывода (что-то было недавно про SampleGrabber - или это только для видеозахвата?) - тогда можно заставить это сделать и посторонний медиаплеер.
Что касается драйвера... Ну, получим доступ к памяти - а как оверлей в ней искать?
| |
Страницы: 