VideoCapture控件
VideoCapture控件
{------------------------------------------------------------------------------
Unit Name : VideoCapture
Author : Liren Zhao
Email : LirenZhao@tom.com
Msn : LirenZhao@tom.com
CreateDate: 2002 06 12
ModifyDate: 2002 07 5
History:
Version:2.01
-------------------------------------------------------------------------------}
unit VideoCapture;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,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('LirenZhao', [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('Syntong 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.