наложения текста на видео с вебкамер

[alman12]

почему выдает ошибку на этом коде , почему не получается наложить текст на видео

unit Unit1;

interface

uses
...directshow9, ActiveX

var
  Form1: TForm1;
  FileName:string;
  RecMode: Boolean = False; 
  DeviceName:OleVariant; 
  PropertyName:IPropertyBag; //
  pDevEnum:ICreateDEvEnum;
  pEnum:IEnumMoniker; 
  pMoniker:IMoniker;

  MArray1,MArray2: array of IMoniker; 
      osb: tbitmap;
  w,h: integer;
      pBitmap      : IVMRMixerBitmap;
  VMRBitmap    : VMRALPHABITMAP;

    FGraphBuilder:        IGraphBuilder;
    FCaptureGraphBuilder: ICaptureGraphBuilder2;
    FMux:                 IBaseFilter;
    FSink:                IFileSinkFilter;
    FMediaControl:        IMediaControl;
    FVideoWindow:         IVideoWindow;

    FVideoCaptureFilter:  IBaseFilter;
    FAudioCaptureFilter:  IBaseFilter;
    FVideoRect:           TRect;

implementation

{$R *.dfm}

 procedure dsmp_logo(s: string; alpha: single);
begin
if Assigned(FVideoWindow)then begin
  osb.Width := length(s)*w;
  osb.Height:= h;
  osb.Canvas.TextOut(0,0,s);

  ZeroMemory(@VMRBitmap, sizeof(VMRBitmap));
  VMRBitmap.dwFlags  := VMRBITMAP_HDC or VMRBITMAP_SRCCOLORKEY;
  VMRBitmap.clrSrcKey:= clBLACK;
  VMRBitmap.hdc      := osb.Canvas.Handle;
  VMRBitmap.rSrc     := osb.Canvas.ClipRect;

  VMRBitmap.rDest.left  := 0.20;
  VMRBitmap.rDest.right := 1.50;
  VMRBitmap.rDest.top   := 0.85;
  VMRBitmap.rDest.bottom:= 0.9;
  VMRBitmap.fAlpha      := alpha;
  pBitmap.SetAlphaBitmap(VMRBitmap);
 end ;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   osb:= tbitmap.Create;
  osb.Canvas.Brush.Color:= $0;
  osb.Canvas.Font.Name:= 'System';
  osb.Canvas.Font.Size:= 70;
  osb.Canvas.Font.Style:= [fsBold];
  osb.Canvas.Font.Color:= 65100;// 65280
  w:= osb.Canvas.TextWidth('w');
  h:= osb.Canvas.TextHeight('w');
CoInitialize(nil);
if FAILED(Initializ) then
    Begin
      ShowMessage('Внимание! Произошла ошибка при инициализации');
      Exit;
    End;
if Listbox1.Count>0 then
    Begin
        if FAILED(CreateGraph) then
            Begin
              ShowMessage('Внимание! Произошла ошибка при построении графа фильтров');
              Exit;
            End;
        Panel2.Caption:='Режим просмотра';
    end else
            Begin
              ShowMessage('Внимание! Камера не обнаружена.');
            End;
end;

function TForm1.Initializ: HResult;
begin
Result:=CoCreateInstance(CLSID_SystemDeviceEnum, NIL, CLSCTX_INPROC_SERVER,
IID_ICreateDevEnum, pDevEnum);
if Result<>S_OK then EXIT;
Result:=pDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, pEnum, 0);
if Result<>S_OK then EXIT;
setlength(MArray1,0);
while (S_OK=pEnum.Next(1,pMoniker,Nil)) do
begin
setlength(MArray1,length(MArray1)+1); 
MArray1[length(MArray1)-1]:=pMoniker; 
Result:=pMoniker.BindToStorage(NIL, NIL, IPropertyBag, PropertyName);
if FAILED(Result) then Continue;
Result:=PropertyName.Read('FriendlyName', DeviceName, NIL); //Получаем имя устройства
if FAILED(Result) then Continue;
Listbox1.Items.Add(DeviceName);
end;
Result:=pDevEnum.CreateClassEnumerator(CLSID_AudioInputDeviceCategory, pEnum, 0);
if Result<>S_OK  then EXIT;
setlength(MArray2,0);

while (S_OK=pEnum.Next(1,pMoniker,Nil)) do
begin
setlength(MArray2,length(MArray2)+1); //Увеличиваем массив на единицу
MArray2[length(MArray2)-1]:=pMoniker; //Запоминаем моникер в масиве
Result:=pMoniker.BindToStorage(NIL, NIL, IPropertyBag, PropertyName);
if FAILED(Result) then Continue;
Result:=PropertyName.Read('FriendlyName', DeviceName, NIL); //Получаем имя устройства
if FAILED(Result) then Continue;
Listbox2.Items.Add(DeviceName);
end;
if ListBox1.Count=0 then
   begin
      ShowMessage('Камера не обнаружена');
      Result:=E_FAIL;;
      Exit;
   end;
Listbox1.ItemIndex:=0;
if ListBox2.Count=0 then
    begin
      ShowMessage('Микрофон не обнаружен');
    end
                    else  Listbox2.ItemIndex:=0;
Result:=S_OK;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 dsmp_logo('syenta )))' +
           ' [ '+
           formatdatetime('hh:nn:ss.zzz',time)+
           ' ]',
           0.5);
end;

[Replicant]

Ошибку Вашу озвучьте.

    if FAILED(CreateGraph) then
    Begin
      ShowMessage('Внимание! Произошла ошибка при построении графа фильтров');
      Exit;
    End;

Мельком пробежался по коду, не вижу откуда берется CreateGraph?

[kutani]

http://www.programmersforum.ru/showt...=298284&page=2

Оригинал https://www.google.com/search?q=+pro...FITIsQGwsb3YCA

[alman12]

Сообщение от Replicant

Ошибку Вашу озвучьте.

    if FAILED(CreateGraph) then
    Begin
      ShowMessage('Внимание! Произошла ошибка при построении графа фильтров');
      Exit;
    End;

Мельком пробежался по коду, не вижу откуда берется CreateGraph?

ошибку выдает таймер при наложения текста а так нет не каких проблем с изображением , видео отображается

[alman12]

ошибку выдает таймер при наложения текста а так нет не каких проблем с изображением , видео отображается

[Pavia]

alman12
Какую ошибку выдаёт?
Приведите код целиком.

[alman12]

вот картинка ошибки ,после открытие приложения видео появляется
но потом таймер выдает такою ошибку

[kutani]

Код взят у raxp-а (автора), полный код ошибок не выдает. Ссылка на тему и более ранние упоминания приведены выше (также этот код есть и на этом форуме несколькими годами ранее и опубликован в издании белорусского журнала в виде ресурсов на сайте издания).

Безымянный.jpg

[alman12]

этот код есть у многих исходниках в интернете

[Вадим Мошев]

ОФФТОП:
alman12, вы уже не первый день на форуме. Оформляйте ваш под по правилам.