Web камера и Delphi

[SASFM]

Здравствуйте дорогие коллеги. На этот раз у меня такой вопрос: Как программно можно включать Web камеру из Delphi, и сделать снимок. Знаю что вы обязательно ответите, за это и я вам скажу СПАСИБО!!!

[VIK_aka_TOR]

ставите драйвера к вебке. ищите к ним описание API. Реализуете программу с необходимым функционалом

[SASFM]

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

ставите драйвера к вебке. ищите к ним описание API. Реализуете программу с необходимым функционалом

Ничего не соображал

[Пепел Феникса]

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

ставите драйвера к вебке. ищите к ним описание API. Реализуете программу с необходимым функционалом

API то зачем?
есть общевиндовое АПИ.
DirectDraw например.
а можно еще поискать по словам webcam delphi и найти примеры.

[саша40]

Где-то однажды была функция для получения изображения с камеры, но это было так давно. Задай в поисковик, яндекс должен дать ответ. Скажу только: Функция- чисто от WinApi.

[BLACK_RAIN]

uses windows, graphics;

function MakeScreenshot(var bmp: TBitmap):Boolean;
var
  BufferSize : Integer;
  vih : TVideoInfoHeader;
  mt : TAMMediaType;
  BMPInfo : TBitmapInfo;
  Buffer : Pointer;
  tmp : array of Byte;
  hr : HRESULT;
  hbmp : hbitmap;
Begin
  Result := False;
  hr := pGrabber.GetCurrentBuffer(BufferSize,nil);
  ZeroMemory(@mt,SizeOf(tammediatype));
  hr := pGrabber.GetConnectedMediaType(mt);
  vih := tvideoinfoheader(mt.pbFormat^);
  ZeroMemory(@bmpinfo,SizeOf(tbitmapinfo));
  CopyMemory(@bmpinfo.bmiheader,@vih.bmiheader,SizeOf(tbitmapinfoheader));
  Buffer := nil;
  hbmp := CreateDIBSection(0,BMPInfo,DIB_PAL_COLORS,Buffer,0,0);
  case hbmp of
    0:
    begin
      MessageBox(form1,PChar('HBMP = 0'),'',0);
      Exit;
    end;
    ERROR_INVALID_PARAMETER:
    begin
      MessageBox(form1,PChar('ERROR_INVALID_PARAMETER'),'',0);
      Exit;
    end;
  end;
  bmp.Handle := hbmp;
  SetLength(tmp,BufferSize);
  pGrabber.GetCurrentBuffer(BufferSize,@tmp[0]);
  CopyMemory(Buffer,@tmp[0],mt.lSampleSize);
  SetLength(tmp,0);
  MoFreeMediaType(@mt);
  Result := True;
end;

procedure grabImage(const t: string);
// процедура снятия
begin
        bmp := TBitmap.Create;
        if MakeScreenshot(bmp) then
        begin
            bmp.SaveToFile(t);
        end;
        bmp.Free;
end;

SampleGrabber настраиваем так:

  CoCreateInstance(CLSID_SampleGrabber,nil,CLSCTX_INPROC,
                    IID_IBaseFilter,fGrabber);
  Result := pGraphBuilder.AddFilter(fGrabber,'Sample Grabber');
  if Result = s_ok then
  begin
    fGrabber.QueryInterface(IID_ISampleGrabber,pGrabber);
    ZeroMemory(@DesiredMT,SizeOf(DesiredMT));
    DesiredMT.majortype := MEDIATYPE_Video;
    DesiredMT.subtype := MEDIASUBTYPE_RGB24;
    DesiredMT.formattype := FORMAT_VideoInfo;
    Result := pGrabber.SetMediaType(DesiredMT);
    if Result = s_ok then
    begin
      pGrabber.SetOneShot(False);
      pGrabber.SetBufferSamples(True);
    end;
    MoFreeMediaType(@DesiredMT);

не забываем добавить граббер в функцию интеллектуального построения:

  Result:=FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_PREVIEW,
                                   @MEDIATYPE_Video, FVideoCaptureFilter, fGrabber, NIL);

Перед снятием скриншота, ставьте граф на паузу.