Delphi控制摄像头

Delphi对摄像头的控制很简单，在System，windows和messages三个单元内已定义了所有的底层消息函数，我们只需要合理的调用它们就行了。我把摄像头的有关操作做成一个控件，这样就可以拖动窗体上直接使用了。

 

 

2. {************************************
3.  *    Camera Control for Delphi7    *
4.  *          Made by Rarnu           *
5.  *        Credit 2006.08.27         *
6.  *       http://rarnu.ik8.com       *
7.  ************************************}
9. unit RaCameraEye;
11. interface
13. uses
14.   SysUtils, Classes, Controls, Windows, Messages;
16. {事件声明}
17. type
18.   {开始摄像事件}
19.   TOnStart = procedure(Sender: TObject) of object;
20.   {停止摄像事件}
21.   TOnStop = procedure(Sender: TObject) of object;
22.   {开始录像事件}
23.   TOnStartRecord = procedure(Sender: TObject) of object;
24.   {停止录像事件}
25.   TOnStopRecord = procedure(Sender: TObject) of object;
27. type
28.   TRaCameraEye = class(TComponent)
29.   private
30.     {图像显示容器}
31.     fDisplay: TWinControl;
32.     {事件关联变量}
33.     fOnStart: TOnStart;
34.     fOnStartRecord: TOnStartRecord;
35.     fOnStop: TOnStop;
36.     fOnStopRecord: TOnStopRecord;
37.   protected
38.   public
39.     {构造&析构，由TComponent类覆盖而来}
40.     constructor Create(AOwner: TComponent); override;
41.     destructor Destroy; override;
42.     {开始摄像}
43.     procedure Start;
44.     {停止摄像}
45.     procedure Stop;
46.     {截图并保存到bmp}
47.     procedure SaveToBmp(FileName: string);
48.     {录制AVI}
49.     procedure RecordToAVI(FileName: string);
50.     {停止录制}
51.     procedure StopRecord;
52.   published
53.     property Display: TWinControl read fDisplay write fDisplay;
54.     property OnStart: TOnStart read fOnStart write fOnStart;
55.     property OnStop: TOnStop read fOnStop write fOnStop;
56.     property OnStartRecord: TOnStartRecord read fOnStartRecord write fOnStartRecord;
57.     property OnStopRecord: TOnStopRecord read fOnStopRecord write fOnStopRecord;
58.   end;
60. {消息常量声明}
61. const
62.   WM_CAP_START = WM_USER;
63.   WM_CAP_STOP = WM_CAP_START + 68;
64.   WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
65.   WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
66.   WM_CAP_SAVEDIB = WM_CAP_START + 25;
67.   WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
68.   WM_CAP_SEQUENCE = WM_CAP_START + 62;
69.   WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
70.   WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63;
71.   WM_CAP_SET_OVERLAY = WM_CAP_START + 51;
72.   WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
73.   WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6;
74.   WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2;
75.   WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3;
76.   WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5;
77.   WM_CAP_SET_SCALE = WM_CAP_START + 53;
78.   WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
80. {声明动态函数，此函数从DLL中调入，动态判断是否可用}
81. type
82.   TFunCap = function(
83.     lpszWindowName: PCHAR;
84.     dwStyle: longint;
85.     x: integer;
86.     y: integer;
87.     nWidth: integer;
88.     nHeight: integer;
89.     ParentWin: HWND;
90.     nId: integer): HWND; stdcall;
92. {全局变量声明}
93. var
94.   hWndC: THandle;
95.   FunCap: TFunCap;
96.   DllHandle: THandle;
98. procedure Register;
100. implementation
102. procedure Register;
103. begin
104.   RegisterComponents('Rarnu Components', [TRaCameraEye]);
105. end;
107. { TRaCameraEye }
109. constructor TRaCameraEye.Create(AOwner: TComponent);
110. var
111.   FPointer: Pointer;{函数指针}
112. begin
113.   inherited Create(AOwner);
114.   fDisplay := nil;
115.   {通过DLL调入，如果DLL不存在，表示没有驱动}
116.   DllHandle := LoadLibrary('AVICAP32.DLL');
117.   if DllHandle <= 0 then
118.   begin
119.     MessageBox(TWinControl(Owner).Handle, '未安装摄像头驱动或驱动程序无效，不能使用此控件！', '出错', MB_OK or MB_ICONERROR);
120.     Destroy;{释放控件}
121.     Exit;
122.   end;
123.   {函数指针指向指定API}
124.   FPointer := GetProcAddress(DllHandle, 'capCreateCaptureWindowA');
125.   {恢复函数指针到实体函数}
126.   FunCap := TFunCap(FPointer);
127. end;
129. destructor TRaCameraEye.Destroy;
130. begin
131.   StopRecord;
132.   Stop;
133.   fDisplay := nil;
134.   {如果已加载DLL，则释放掉}
135.   if DllHandle > 0 then
136.     FreeLibrary(DllHandle);
137.   inherited Destroy;
138. end;
140. procedure TRaCameraEye.RecordToAVI(FileName: string);
141. begin
142.   if hWndC <> 0 then
143.   begin
144.     SendMessage(hWndC, WM_CAP_FILE_SET_CAPTURE_FILEA, 0, longint(PCHAR(FileName)));
145.     SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
146.     if Assigned(OnStartRecord) then
147.       OnStartRecord(Self);
148.   end;
149. end;
151. procedure TRaCameraEye.SaveToBmp(FileName: string);
152. begin
153.   if hWndC <> 0 then
154.     SendMessage(hWndC, WM_CAP_SAVEDIB, 0, longint(PCHAR(FileName)));
155. end;
157. procedure TRaCameraEye.Start;
158. var
159.   OHandle: THandle;
160. begin
161.   if fDisplay = nil then Exit;
162.   OHandle := TWinControl(Owner).Handle;
163.   {动态函数控制摄像头}
164.   hWndC := FunCap(
165.     'My Own Capture Window',
166.     WS_CHILD or WS_VISIBLE,
167.     {规定显示范围}
168.     fDisplay.Left, fDisplay.Top, fDisplay.Width, fDisplay.Height,
169.     OHandle, 0);
170.   if hWndC <> 0 then
171.   begin
172.     {发送指令}
173.     SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
174.     SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
175.     SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
176.     SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
177.     SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
178.     SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
179.     SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
180.     SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
181.   end;
182.   if Assigned(OnStart) then
183.     OnStart(Self);
184. end;
186. procedure TRaCameraEye.Stop;
187. begin
188.   if hWndC <> 0 then
189.   begin
190.     SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
191.     hWndC := 0;
192.     if Assigned(OnStop) then
193.       OnStop(Self);
194.   end;
195. end;
197. procedure TRaCameraEye.StopRecord;
198. begin
199.   if hWndC <> 0 then
200.   begin
201.     SendMessage(hWndC, WM_CAP_STOP, 0, 0);
202.     if Assigned(OnStopRecord) then
203.       OnStopRecord(Self);
204.   end;
205. end;
207. end.