TVideoCapture类的源码(Delphi Xe2), 用于视频捕获

unit VideoCapture;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Imaging.jpeg;

type
  TVideoCapture = class(TCustomPanel)
  private
    hWndC: THandle;
    CapturingAVI: bool;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure OpenVideo(handle: THandle);
    procedure CloseVideo;
    procedure GrabFrame;
    procedure StartVideo;
    procedure StopVideo;
    procedure SaveBitMap(filename: TFileName);
    procedure SaveJpeg(filename: TFileName; compressibility: Integer);
    procedure SavetoJpegStream(var JpegStream: TMemoryStream; compressibility: Integer);
    function StartAvi(filename: TFileName): Boolean;
    procedure StopAvi;
    procedure SetVideoFormat;
    procedure SetSource;
    procedure SetStretch(TrueorFalse: Boolean = true);
    procedure SetCompression;
  published
    property Align;
  end;

procedure Register;

implementation

const
  WM_CAP_START = WM_USER;

  WM_CAP_GET_CAPSTREAMPTR = (WM_CAP_START + 1);
  WM_CAP_SET_CALLBACK_ERROR = (WM_CAP_START + 2);
  WM_CAP_SET_CALLBACK_STATUS = (WM_CAP_START + 3);
  WM_CAP_SET_CALLBACK_YIELD = (WM_CAP_START + 4);
  WM_CAP_SET_CALLBACK_FRAME = (WM_CAP_START + 5);
  WM_CAP_SET_CALLBACK_VIDEOSTREAM = (WM_CAP_START + 6);
  WM_CAP_SET_CALLBACK_WAVESTREAM = (WM_CAP_START + 7);
  WM_CAP_GET_USER_DATA = (WM_CAP_START + 8);
  WM_CAP_SET_USER_DATA = (WM_CAP_START + 9);

  WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10);
  WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11);
  WM_CAP_DRIVER_GET_NAME = (WM_CAP_START + 12);
  WM_CAP_DRIVER_GET_VERSION = (WM_CAP_START + 13);
  WM_CAP_DRIVER_GET_CAPS = (WM_CAP_START + 14);

  WM_CAP_FILE_SET_CAPTURE_FILE = (WM_CAP_START + 20);
  WM_CAP_FILE_GET_CAPTURE_FILE = (WM_CAP_START + 21);
  WM_CAP_FILE_ALLOCATE = (WM_CAP_START + 22);
  WM_CAP_FILE_SAVEAS = (WM_CAP_START + 23);
  WM_CAP_FILE_SET_INFOCHUNK = (WM_CAP_START + 24);
  WM_CAP_FILE_SAVEDIB = (WM_CAP_START + 25);

  WM_CAP_EDIT_COPY = (WM_CAP_START + 30);

  WM_CAP_SET_AUDIOFORMAT = (WM_CAP_START + 35);
  WM_CAP_GET_AUDIOFORMAT = (WM_CAP_START + 36);

  WM_CAP_DLG_VIDEOFORMAT = (WM_CAP_START + 41);
  WM_CAP_DLG_VIDEOSOURCE = (WM_CAP_START + 42);
  WM_CAP_DLG_VIDEODISPLAY = (WM_CAP_START + 43);
  WM_CAP_GET_VIDEOFORMAT = (WM_CAP_START + 44);
  WM_CAP_SET_VIDEOFORMAT = (WM_CAP_START + 45);
  WM_CAP_DLG_VIDEOCOMPRESSION = (WM_CAP_START + 46);

  WM_CAP_SET_PREVIEW = (WM_CAP_START + 50);
  WM_CAP_SET_OVERLAY = (WM_CAP_START + 51);
  WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52);
  WM_CAP_SET_SCALE = (WM_CAP_START + 53);
  WM_CAP_GET_STATUS = (WM_CAP_START + 54);
  WM_CAP_SET_SCROLL = (WM_CAP_START + 55);

  WM_CAP_GRAB_FRAME = (WM_CAP_START + 60);
  WM_CAP_GRAB_FRAME_NOSTOP = (WM_CAP_START + 61);

  WM_CAP_SEQUENCE = (WM_CAP_START + 62);
  WM_CAP_SEQUENCE_NOFILE = (WM_CAP_START + 63);
  WM_CAP_SET_SEQUENCE_SETUP = (WM_CAP_START + 64);
  WM_CAP_GET_SEQUENCE_SETUP = (WM_CAP_START + 65);
  WM_CAP_SET_MCI_DEVICE = (WM_CAP_START + 66);
  WM_CAP_GET_MCI_DEVICE = (WM_CAP_START + 67);
  WM_CAP_STOP = (WM_CAP_START + 68);
  WM_CAP_ABORT = (WM_CAP_START + 69);

  WM_CAP_SINGLE_FRAME_OPEN = (WM_CAP_START + 70);
  WM_CAP_SINGLE_FRAME_CLOSE = (WM_CAP_START + 71);
  WM_CAP_SINGLE_FRAME = (WM_CAP_START + 72);

  WM_CAP_PAL_OPEN = (WM_CAP_START + 80);
  WM_CAP_PAL_SAVE = (WM_CAP_START + 81);
  WM_CAP_PAL_PASTE = (WM_CAP_START + 82);
  WM_CAP_PAL_AUTOCREATE = (WM_CAP_START + 83);
  WM_CAP_PAL_MANUALCREATE = (WM_CAP_START + 84);


function capCreateCaptureWindowA(lpszWindowName: PCHAR;
  dwStyle: longint;
  x: integer;
  y: integer;
  nWidth: integer;
  nHeight: integer;
  ParentWin: HWND;
  nId: integer): HWND; stdcall; external 'avicap32.dll';

procedure Register;
begin
  RegisterComponents('FstiCtl', [TVideoCapture]);
end;

{ TVideoCapture }

constructor TVideoCapture.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  CapturingAVI := false;
  Color := clBlack;
  BevelOuter := bvNone;
  Width := 320;
  Height := 240;
  hWndC := 0;
end;

destructor TVideoCapture.Destroy;
begin
  if CapturingAVI then StopAvi;
  if hWndC <> 0 then CloseVideo;
  hWndC := 0;
  inherited;
end;

procedure TVideoCapture.OpenVideo(handle: THandle);
begin
  hWndC := capCreateCaptureWindowA('Video Capture Window',
    WS_CHILD or WS_VISIBLE,
    Left,
    Top,
    Width,
    Height,
    Handle,
    0);
  if hWndC <> 0 then
    SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
end;

procedure TVideoCapture.CloseVideo;
begin
  if hWndC <> 0 then begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    SendMessage(hWndC, WM_CLOSE, 0, 0);
    hWndC := 0;
  end;
end;

procedure TVideoCapture.GrabFrame;
begin
  if hWndC <> 0 then
    SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0);
end;

procedure TVideoCapture.SaveBitMap(filename: TFileName);
begin
  SendMessage(hWndC, WM_CAP_FILE_SAVEDIB, 0, longint(pchar(FileName)));
end;

function TVideoCapture.StartAvi(filename: TFileName): Boolean;
begin
  if hWndC <> 0 then begin
    CapturingAVI := true;
    SendMessage(hWndC,
      WM_CAP_FILE_SET_CAPTURE_FILE,
      0,
      Longint(pchar(FileName)));
    SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
  end;
end;

procedure TVideoCapture.StopAvi;
begin
  if hWndC <> 0 then begin
    SendMessage(hWndC, WM_CAP_STOP, 0, 0);
    CapturingAVI := false;
  end;
end;

procedure TVideoCapture.SaveJpeg(filename: TFileName;
  compressibility: Integer);
var
  bmp: TBitMap;
  jpg: TJpegimage;
begin
  try
    SaveBitMap('tmp.bmp');
    bmp := TBitmap.Create;
    jpg := TJpegImage.Create;
    bmp.LoadFromFile('tmp.bmp');
    jpg.Assign(bmp);
    jpg.CompressionQuality := compressibility;
    jpg.Compress;
    jpg.SaveToFile(filename);
    DeleteFile('tmp.bmp');
  except
  end;

  bmp.free;
  jpg.free;
end;

procedure TVideoCapture.SetVideoFormat;
begin
  SendMessage(hWndC, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
end;

procedure TVideoCapture.SetSource;
begin
  SendMessage(hWndC, WM_CAP_DLG_VIDEOSOURCE, 0, 0);
end;

procedure TVideoCapture.StartVideo;
begin
  SendMessage(hWndC, WM_CAP_SET_PREVIEW, -1, 0);
  SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 100, 0);
  SendMessage(hWndC, WM_CAP_SET_SCALE, -1, 0);
end;

procedure TVideoCapture.StopVideo;
begin
  SendMessage(hWndC, WM_CAP_SET_PREVIEW, 0, 0);
end;

procedure TVideoCapture.WMSize(var Message: TWMSize);
begin
  SetWindowPos(hWndC, HWND_BOTTOM, 0, 0, Width, Height, SWP_NOMOVE or SWP_NOACTIVATE);
end;

procedure TVideoCapture.SetStretch(TrueorFalse: Boolean);
begin

end;

procedure TVideoCapture.SetCompression;
begin
  SendMessage(hWndC, WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0)
end;

procedure TVideoCapture.SavetoJpegStream(var JpegStream: TMemoryStream; compressibility: Integer);
var
  bmp: TBitMap;
  jpg: TJpegimage;
begin
  try
    SaveBitMap('tmp.bmp');
    bmp := TBitmap.Create;
    jpg := TJpegImage.Create;
    bmp.LoadFromFile('tmp.bmp');
    jpg.Assign(bmp);
    jpg.CompressionQuality := compressibility;
    jpg.Compress;
    jpg.SaveToStream(JpegStream);
    DeleteFile('tmp.bmp');
  except
  end;

  bmp.free;
  jpg.free;
end;

end.