• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

Android实例-操作摄像头(XE8+小米2) - 疯狂delphi

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

Android实例-操作摄像头(XE8+小米2)

 

结果:

1.同样是照相,自己的程序设置为高质量时刷新慢,而小米手机的相机那真心反映快呀。

2.就算我设置为最高质量,可相片也没有小米手机的相片大。我最大是2000*1000,而小米可以做到3000*2000,如果有人问我为什么都是整数,我会K你的。

 

实例代码:

  1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  7   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  8   FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.Media,
  9   FMX.Platform,//需要引入
 10   system.IOUtils,//需要引入
 11   FMX.Layouts;
 12 
 13 type
 14   TForm1 = class(TForm)
 15     Label1: TLabel;
 16     Image1: TImage;
 17     GroupBox1: TGroupBox;
 18     RadioButton1: TRadioButton;
 19     RadioButton2: TRadioButton;
 20     GroupBox2: TGroupBox;
 21     RadioButton3: TRadioButton;
 22     RadioButton4: TRadioButton;
 23     RadioButton5: TRadioButton;
 24     GroupBox3: TGroupBox;
 25     Button1: TButton;
 26     Button2: TButton;
 27     Button3: TButton;
 28     CameraComponent1: TCameraComponent;
 29     Timer1: TTimer;
 30     Layout1: TLayout;
 31     RadioButton6: TRadioButton;
 32     RadioButton7: TRadioButton;
 33     RadioButton8: TRadioButton;
 34     RadioButton9: TRadioButton;
 35     GroupBox4: TGroupBox;
 36     RadioButton10: TRadioButton;
 37     procedure FormCreate(Sender: TObject);
 38     procedure FormResize(Sender: TObject);
 39     procedure Timer1Timer(Sender: TObject);
 40     procedure RadioButton5Change(Sender: TObject);
 41     procedure RadioButton1Change(Sender: TObject);
 42     procedure RadioButton2Change(Sender: TObject);
 43     procedure RadioButton4Change(Sender: TObject);
 44     procedure RadioButton3Change(Sender: TObject);
 45     procedure Button1Click(Sender: TObject);
 46     procedure Button2Click(Sender: TObject);
 47     procedure Button3Click(Sender: TObject);
 48     procedure CameraComponent1SampleBufferReady(Sender: TObject;
 49       const ATime: TMediaTime);
 50     procedure RadioButton6Change(Sender: TObject);
 51     procedure RadioButton7Change(Sender: TObject);
 52     procedure RadioButton9Change(Sender: TObject);
 53     procedure RadioButton8Change(Sender: TObject);
 54     procedure RadioButton10Change(Sender: TObject);
 55   private
 56     //需要定义
 57     function AppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean;
 58     procedure GetImage;
 59     { Private declarations }
 60   public
 61     { Public declarations }
 62   end;
 63 
 64 var
 65   Form1: TForm1;
 66 
 67 implementation
 68 
 69 {$R *.fmx}
 70 {$R *.NmXhdpiPh.fmx ANDROID}
 71 
 72 //程序事件处理
 73 function TForm1.AppEvent(AAppEvent: TApplicationEvent;
 74   AContext: TObject): Boolean;
 75 begin
 76   case AAppEvent of
 77     TApplicationEvent.aeWillBecomeInactive: // 当程序将要变为不活动时
 78       CameraComponent1.Active := False;
 79     TApplicationEvent.aeEnteredBackground: // 当程序进入后台时
 80       CameraComponent1.Active := False;
 81     TApplicationEvent.aeWillTerminate: // 当程序将要关闭时
 82       CameraComponent1.Active := False;
 83   end;
 84 end;
 85 
 86 //打开摄像头
 87 procedure TForm1.Button1Click(Sender: TObject);
 88 begin
 89   CameraComponent1.Active := True;
 90 end;
 91 
 92 //关闭摄像头
 93 procedure TForm1.Button2Click(Sender: TObject);
 94 begin
 95   CameraComponent1.Active := False;
 96 end;
 97 
 98 //保存照片
 99 procedure TForm1.Button3Click(Sender: TObject);
100 begin
101   Image1.Bitmap.SaveToFile(TPath.GetSharedCameraPath+\'/temp.jpg\');
102   showmessage(\'保存成功!\');
103 end;
104 
105 //从摄像头那里取相片
106 procedure TForm1.CameraComponent1SampleBufferReady(Sender: TObject;
107   const ATime: TMediaTime);
108 begin
109   GetImage;
110 end;
111 
112 procedure TForm1.FormCreate(Sender: TObject);
113 var
114   AppEventSvc: IFMXApplicationEventService;
115 begin
116   //启动一个服务,用来监控摄像头的状态
117   if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(AppEventSvc)) then
118     AppEventSvc.SetApplicationEventHandler(AppEvent); //AppEvent 为具做事的一个函数
119   CameraComponent1.Quality := TVideoCaptureQuality.vcPhotoQuality;//设置图像质量
120   //设置对焦方式
121   CameraComponent1.FocusMode := TFocusMode.fmContinuousAutoFocus;
122 end;
123 
124 procedure TForm1.FormResize(Sender: TObject);
125 begin
126   if Height < Width then //如果是横屏
127     Image1.RotationAngle := 0;
128   if Height > Width then //如果是竖屏
129   if CameraComponent1.Kind = FMX.Media.TCameraKind.ckFrontCamera then//如果是前置摄像头
130     Image1.RotationAngle := -90
131   else
132     Image1.RotationAngle := 90;
133 end;
134 
135 //取相片
136 procedure TForm1.GetImage;
137 begin
138   CameraComponent1.SampleBufferToBitmap(Image1.Bitmap, true);
139 end;
140 
141 //选择摄像头
142 procedure TForm1.RadioButton1Change(Sender: TObject);
143 begin
144   //选择后置摄像头
145   CameraComponent1.Active := False;
146   CameraComponent1.Kind := FMX.Media.TCameraKind.ckBackCamera;
147   CameraComponent1.Active := True;
148   // 后置时,图像要旋转 90 度,如果是竖屏的话
149   if Height > Width then
150   Image1.RotationAngle := 90;
151 end;
152 
153 procedure TForm1.RadioButton2Change(Sender: TObject);
154 begin
155   //选择前置摄像头
156   CameraComponent1.Active := False;
157   CameraComponent1.Kind := FMX.Media.TCameraKind.ckFrontCamera;
158   CameraComponent1.Active := True;
159   //前置时,图像要旋转-90 度,如果是竖屏的话
160   if Height > Width then
161   Image1.RotationAngle := -90;
162 end;
163 
164 //如果有闪光灯,打开, ,但在程序运行过程中,看不出什么效果
165 procedure TForm1.RadioButton3Change(Sender: TObject);
166 begin
167   if CameraComponent1.HasFlash then
168     CameraComponent1.FlashMode := FMX.Media.TFlashMode.fmFlashOn;
169 end;
170 
171 //如果有闪光灯,关闭,但在程序运行过程中,看不出什么效果
172 procedure TForm1.RadioButton4Change(Sender: TObject);
173 begin
174   if CameraComponent1.HasFlash then
175     CameraComponent1.FlashMode := FMX.Media.TFlashMode.fmFlashOff;
176 end;
177 
178 //将闪光灯设置为自动模式
179 procedure TForm1.RadioButton5Change(Sender: TObject);
180 begin
181   if CameraComponent1.HasFlash then
182     CameraComponent1.FlashMode := FMX.Media.TFlashMode.fmAutoFlash;
183 end;
184 
185 //相片质量
186 procedure TForm1.RadioButton6Change(Sender: TObject);
187 begin
188   CameraComponent1.Quality := TVideoCaptureQuality.PhotoQuality;
189 end;
190 
191 //高质量
192 procedure TForm1.RadioButton7Change(Sender: TObject);
193 begin
194   CameraComponent1.Quality := TVideoCaptureQuality.HighQuality;
195 end;
196 
197 //中等质量
198 procedure TForm1.RadioButton10Change(Sender: TObject);
199 begin
200   CameraComponent1.Quality := TVideoCaptureQuality.CaptureSettings;
201 end;
202 
203 //低质量
204 procedure TForm1.RadioButton8Change(Sender: TObject);
205 begin
206   CameraComponent1.Quality := TVideoCaptureQuality.MediumQuality;
207 end;
208 
209 //捕捉设置
210 procedure TForm1.RadioButton9Change(Sender: TObject);
211 begin
212   CameraComponent1.Quality := TVideoCaptureQuality.LowQuality;
213 end;
214 
215 //刷新得到的摄像头的照片的显示
216 procedure TForm1.Timer1Timer(Sender: TObject);
217 begin
218   Image1.Repaint;
219 end;
220 
221 end.

 


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
window10下matlab7.0怎么卸载发布时间:2022-07-18
下一篇:
在MATLAB里面安装k-Wave发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap