TVideoCapture类的源码(Delphi Xe2), 用于视频捕获
unit VideoCapture;interfaceuses 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;implementationconst 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);beginend;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.