Question

我正在制作VCL应用程序-它需要保留在VCL中，因为此应用程序将在另一个程序（基本上是1-大程序和其中的几个较小程序）中进行调整。

因此，我需要从网络摄像头添加实时供稿，并在VCL应用中对其进行拍照，我已经进行了大量搜索以寻求修复，但是我似乎“有点失落”，已经在FMX中工作了。项目，但到目前为止在VCL中没有运气，更可取的是，我希望没有下载等。

FMX应用中的代码：

unit WebC_test;

interface

uses
   System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListBox,
   FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.Media;

type
   TForm2 = class(TForm)
      Image1: TImage;
      StartButton: TButton;
      StopButton: TButton;
      ComboBox1: TComboBox;
      Rectangle1: TRectangle;
      Rectangle2: TRectangle;
      camera_status: TLabel;
      procedure FormCreate(Sender: TObject);
      procedure ComboBox1Change(Sender: TObject);
      procedure StartButtonClick(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure StopButtonClick(Sender: TObject);
      private
         {Private declarations}
      public
         VideoCamera: TVideoCaptureDevice;
         {Public declarations}
         procedure SampleBufferSync;
         procedure SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
   end;

var
   Form2: TForm2;
   CodecParams: TBitmapCodecSaveParams;
   DeviceList: TCaptureDeviceList;

implementation

{$R *.fmx}
{$R *.LgXhdpiTb.fmx ANDROID}
{$R *.Windows.fmx MSWINDOWS}

procedure TForm2.ComboBox1Change(Sender: TObject);
begin
VideoCamera := TVideoCaptureDevice(TCaptureDeviceManager.Current.GetDevicesByName(ComboBox1.Selected.Text));
if (VideoCamera <> nil) then
   begin
   StartButton.Enabled := true;
   end;
end;

procedure TForm2.FormCreate(Sender: TObject);

var

   i: integer;
begin
Form2.Width := 1000;
camera_status.Text := 'Camera standby...';
DeviceList := TCaptureDeviceManager.Current.GetDevicesByMediaType(TMediaType.Video);
for i := 0 to DeviceList.Count - 1 do
   begin
   ComboBox1.Items.Add(DeviceList[i].Name);
   ComboBox1.ItemIndex := 0;
   StartButton.Enabled := true;
   end;
if DeviceList.Count = 0 then
   begin
   camera_status.Text := 'No available cameras found';
   end;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
if VideoCamera <> nil then
   VideoCamera.StopCapture;
end;

procedure TForm2.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
TThread.Synchronize(TThread.CurrentThread, SampleBufferSync);
// Resize the image so the video to be buffered on its original size.
// Image1.Height := 510;
end;

procedure TForm2.SampleBufferSync;
begin
VideoCamera.SampleBufferToBitmap(Image1.Bitmap, true);
end;

procedure TForm2.StartButtonClick(Sender: TObject);
begin
if (VideoCamera <> nil) then
   begin
   VideoCamera.OnSampleBufferReady := SampleBufferReady;
   VideoCamera.StartCapture;
   Image1.Visible := true;
   camera_status.Text := 'Capturing...';
   StartButton.Enabled := false;
   StopButton.Enabled := true;
   end
else
   begin
   camera_status.Text := 'Error: No camera selected!';
   end;

end;

procedure TForm2.StopButtonClick(Sender: TObject);
var
   randint: integer;
begin

randint := Random(100000);
StopButton.Enabled := false;
VideoCamera.StopCapture;
Image1.Bitmap.Assign(Image1.Bitmap);
CodecParams.Quality := 100;
camera_status.Text := 'Saving...';
Image1.Bitmap.SaveToFile('C:\Images\cap_' + IntToStr(randint) + ' .jpg', @CodecParams);
camera_status.Text := 'Saved!';
Sleep(250);
Image1.Visible := false;
camera_status.Text := 'Camera standby...';

if DeviceList.Count <> 0 then
   begin
   StartButton.Enabled := true;
   end;
end;

end.

Delphi VCL网络摄像头-拍照等

0 个答案: