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.
请发表评论