[AlexSku]

продолжение

Код:

procedure TForm1.btnPauseClick(Sender: TObject);
var
  hr: HResult;
  cbBuffer: Integer;
  evCode: Integer;
  pBuffer: Pointer; // PByteArray
  pVih: PVIDEOINFOHEADER;
  mt: TAMMediaType;
begin
  pControl.Pause();
  btnRun.Enabled:= true;
  btnPause.Enabled:= false;

  { ISampleGrabber.GetCurrentBuffer копирует данные (вызываем 2 раза, первый
  раз, чтобы узнать размер кадра) в наш буфер }
  // Find the required buffer size.
  cbBuffer:= 0;
  hr:= pGrabber.GetCurrentBuffer(cbBuffer, nil);

  GetMem(pBuffer, cbBuffer);
  if not Assigned(pBuffer) then
  begin
    // Out of memory. Return an error code.
    Exit;
  end;
  hr:= pGrabber.GetCurrentBuffer(cbBuffer, pBuffer);

  // The ISampleGrabber::GetConnectedMediaType method returns the format of the buffer:
  hr:= pGrabber.GetConnectedMediaType(mt);
  if FAILED(hr) then
  begin
    // Return error code.
    Exit;
  end;

  // Examine the format block.
  if IsEqualGUID(mt.formattype, FORMAT_VideoInfo)
    and (mt.cbFormat >= sizeof(VIDEOINFOHEADER))
    and Assigned(mt.pbFormat) then
    pVih:= mt.pbFormat
  else
  begin
    // Wrong format. Free the format block and return an error.
    FreeMediaType(@mt);
    Exit; //return VFW_E_INVALIDMEDIATYPE;
  end;

  // You can use the media type to access the BITMAPINFOHEADRE information.
  // For example, the following code draws the bitmap using GDI:
  SetDIBitsToDevice(
    GetDC(PanelVideo.Handle), 0, 0,
    pVih.bmiHeader.biWidth,
    pVih.bmiHeader.biHeight,
    0, 0,
    0,
    pVih.bmiHeader.biHeight,
    pBuffer,
    PBITMAPINFO(@pVih.bmiHeader)^,
    DIB_RGB_COLORS
  );
  // Free the format block when you are done:
  FreeMediaType(@mt);

  FreeMem(pBuffer, cbBuffer);
end;

procedure TForm1.btnRunClick(Sender: TObject);
begin
  pControl.Run;
  btnPause.Enabled:= true;
  btnRun.Enabled:= false;
end;

end.

форма:

Код:

object Form1: TForm1
  Left = 277
  Top = 160
  Width = 768
  Height = 576
  Caption = 'Видеозахват'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  Position = poDefaultPosOnly
  ScreenSnap = True
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object btnExit: TButton
    Left = 8
    Top = 472
    Width = 75
    Height = 25
    Cancel = True
    Caption = 'Exit'
    TabOrder = 0
    OnClick = btnExitClick
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 511
    Width = 760
    Height = 19
    Panels = <>
  end
  object PanelVideo: TPanel
    Left = 100
    Top = 16
    Width = 640
    Height = 480
    TabOrder = 2
    object Label1: TLabel
      Left = 36
      Top = 36
      Width = 32
      Height = 13
      Caption = 'Label1'
    end
  end
  object chbMirror: TCheckBox
    Left = 8
    Top = 16
    Width = 69
    Height = 17
    Caption = 'Зеркало'
    Checked = True
    State = cbChecked
    TabOrder = 3
    OnClick = chbMirrorClick
  end
  object btnPause: TButton
    Left = 8
    Top = 148
    Width = 75
    Height = 25
    Caption = 'Pause'
    Enabled = False
    TabOrder = 4
    OnClick = btnPauseClick
  end
  object btnRun: TButton
    Left = 8
    Top = 188
    Width = 75
    Height = 25
    Caption = 'Run'
    Enabled = False
    TabOrder = 5
    OnClick = btnRunClick
  end
  object MainMenu1: TMainMenu
    Left = 28
    Top = 64
    object Devices: TMenuItem
      Caption = 'Видеовход'
    end
  end
end