Unit1.pas 5.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259
  1. unit Unit1;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5. Dialogs, StdCtrls, OleCtrls, CamCaptureCtlLib_TLB;
  6. type
  7. TForm1 = class(TForm)
  8. CamCaptureCtl1: TCamCaptureCtl;
  9. Label1: TLabel;
  10. Label2: TLabel;
  11. ComboBox1: TComboBox;
  12. ComboBox2: TComboBox;
  13. Button1: TButton;
  14. Button2: TButton;
  15. Label3: TLabel;
  16. ComboBox3: TComboBox;
  17. Button3: TButton;
  18. GroupBox1: TGroupBox;
  19. RadioButton1: TRadioButton;
  20. RadioButton2: TRadioButton;
  21. RadioButton3: TRadioButton;
  22. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  23. procedure FormShow(Sender: TObject);
  24. procedure Button1Click(Sender: TObject);
  25. procedure Button2Click(Sender: TObject);
  26. procedure ComboBox1Change(Sender: TObject);
  27. procedure ComboBox2Change(Sender: TObject);
  28. procedure ComboBox3Change(Sender: TObject);
  29. procedure Button3Click(Sender: TObject);
  30. procedure RadioButton1Click(Sender: TObject);
  31. procedure RadioButton2Click(Sender: TObject);
  32. procedure RadioButton3Click(Sender: TObject);
  33. private
  34. { Private declarations }
  35. public
  36. { Public declarations }
  37. end;
  38. var
  39. Form1: TForm1;
  40. implementation
  41. {$R *.dfm}
  42. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  43. begin
  44. CamCaptureCtl1.CloseDevice();
  45. end;
  46. procedure TForm1.FormShow(Sender: TObject);
  47. var
  48. i,j,pos,tmpVal:integer;
  49. devCount,resCount:integer;
  50. devName,resStr :string;
  51. strs :TStrings;
  52. begin
  53. devCount:= CamCaptureCtl1.GetDeviceCount();
  54. if devCount<=0 then
  55. Exit;
  56. if devCount>0 then
  57. begin
  58. for i:=0 to devCount-1 do
  59. begin
  60. devName:=CamCaptureCtl1.GetDeviceName(i);
  61. //showmessage( devName);
  62. ComboBox1.Items.Add(devName);
  63. end;
  64. if devCount>1 then
  65. begin
  66. ComboBox1.ItemIndex:=1; //默认打开副摄像头
  67. end
  68. else
  69. begin
  70. ComboBox1.ItemIndex:=0;
  71. end;
  72. end;
  73. resCount:= CamCaptureCtl1.GetResolutionCount(ComboBox1.ItemIndex);
  74. if resCount<=0 then
  75. begin
  76. showmessage('获取分辨率信息异常!');
  77. Exit;
  78. end;
  79. pos:=0;
  80. tmpVal:=0;
  81. for i:=0 to resCount-1 do
  82. begin
  83. resStr:=CamCaptureCtl1.GetResolution(i);
  84. ComboBox2.Items.Add(resStr);
  85. strs:= TStringList.Create;
  86. strs.Delimiter:='*';
  87. strs.DelimitedText:=resStr;
  88. if StrToInt(strs[0])> tmpVal then //选出最大分辨率
  89. begin
  90. tmpVal:= StrToInt(strs[0]);
  91. pos:=i;
  92. end;
  93. end;
  94. ComboBox2.ItemIndex:= pos;
  95. end;
  96. //打开设备
  97. procedure TForm1.Button1Click(Sender: TObject);
  98. var
  99. iRest :integer;
  100. width,height: integer;
  101. strs :TStrings;
  102. begin
  103. if ComboBox2.Items.Count>0 then
  104. begin
  105. strs:= TStringList.Create;
  106. strs.Delimiter:='*';
  107. strs.DelimitedText:=ComboBox2.Text;
  108. if strs.Count>0 then
  109. begin
  110. width:=StrToInt(strs[0]);
  111. height:= StrToInt(strs[1]);
  112. iRest:=CamCaptureCtl1.OpenDevice(ComboBox1.ItemIndex,width,height);
  113. if iRest<>0 then
  114. showmessage('打开设备失败!');
  115. end;
  116. end;
  117. end;
  118. //关闭设备
  119. procedure TForm1.Button2Click(Sender: TObject);
  120. begin
  121. CamCaptureCtl1.CloseDevice();
  122. end;
  123. //切换摄像头
  124. procedure TForm1.ComboBox1Change(Sender: TObject);
  125. var
  126. i,j,pos,tmpVal:integer;
  127. iRest :integer;
  128. resCount:integer;
  129. resStr :string;
  130. strs :TStrings;
  131. begin
  132. resCount:= CamCaptureCtl1.GetResolutionCount(ComboBox1.ItemIndex);
  133. if resCount<=0 then
  134. begin
  135. showmessage('获取分辨率信息异常!');
  136. Exit;
  137. end;
  138. pos:=0;
  139. tmpVal:=0;
  140. for i:=0 to resCount-1 do
  141. begin
  142. resStr:=CamCaptureCtl1.GetResolution(i);
  143. ComboBox2.Items.Add(resStr);
  144. strs:= TStringList.Create;
  145. strs.Delimiter:='*';
  146. strs.DelimitedText:=resStr;
  147. if StrToInt(strs[0])> tmpVal then //选出最大分辨率
  148. begin
  149. tmpVal:= StrToInt(strs[0]);
  150. pos:=i;
  151. end;
  152. end;
  153. ComboBox2.ItemIndex:= pos;
  154. if ComboBox2.Items.Count>0 then
  155. begin
  156. strs:= TStringList.Create;
  157. strs.Delimiter:='*';
  158. strs.DelimitedText:=ComboBox2.Text;
  159. if strs.Count>0 then
  160. begin
  161. width:=StrToInt(strs[0]);
  162. height:= StrToInt(strs[1]);
  163. iRest:=CamCaptureCtl1.OpenDevice(ComboBox1.ItemIndex,width,height);
  164. if iRest<>0 then
  165. showmessage('打开设备失败!');
  166. end;
  167. end;
  168. end;
  169. //切换分辨率
  170. procedure TForm1.ComboBox2Change(Sender: TObject);
  171. var
  172. i,j,pos,tmpVal:integer;
  173. iRest :integer;
  174. strs :TStrings;
  175. begin
  176. if ComboBox2.Items.Count>0 then
  177. begin
  178. strs:= TStringList.Create;
  179. strs.Delimiter:='*';
  180. strs.DelimitedText:=ComboBox2.Text;
  181. if strs.Count>0 then
  182. begin
  183. width:=StrToInt(strs[0]);
  184. height:= StrToInt(strs[1]);
  185. iRest:=CamCaptureCtl1.OpenDevice(ComboBox1.ItemIndex,width,height);
  186. if iRest<>0 then
  187. showmessage('切换分辨率失败!');
  188. end;
  189. //Form1.Width := 730;
  190. //Form1.Height := 563;
  191. end;
  192. end;
  193. //设置DPI
  194. procedure TForm1.ComboBox3Change(Sender: TObject);
  195. var
  196. val:integer;
  197. begin
  198. val:= StrToInt(ComboBox3.Text);
  199. //CamCaptureCtl1.SetDPI(val,val);
  200. end;
  201. //拍照
  202. procedure TForm1.Button3Click(Sender: TObject);
  203. begin
  204. CamCaptureCtl1.CaptureImage('D:/test.jpg');
  205. end;
  206. procedure TForm1.RadioButton1Click(Sender: TObject);
  207. begin
  208. if RadioButton1.Checked then
  209. begin
  210. CamCaptureCtl1.SetCutType(0);
  211. end;
  212. end;
  213. procedure TForm1.RadioButton2Click(Sender: TObject);
  214. begin
  215. if RadioButton2.Checked then
  216. begin
  217. CamCaptureCtl1.SetCutType(1);
  218. end;
  219. end;
  220. procedure TForm1.RadioButton3Click(Sender: TObject);
  221. begin
  222. if RadioButton3.Checked then
  223. begin
  224. CamCaptureCtl1.SetCutType(2);
  225. end;
  226. end;
  227. end.