Witam.
Mam problem z obsługą kamery pod vcl-em.
Środowisko Delphi Berlin, kompilacja pod win32.
Zapożyczyłem przykładowy kod ze strony http://docwiki.embarcadero.com/RADStudio/Berlin/en/Video_Capturing
Niestety przeniesienie kodu pod vcl daje access violation w linii kodu:
VideoCamera.SampleBufferToBitmap(FMX.Graphics.TBitmap(Image1.Picture.Bitmap), true);
Czy rzutowanie na FMX.Graphics.TBitmap jest niepoprawne ??
Cały kod:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages,
System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
FMX.Graphics, FMX.Media,
Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Image1: TImage;
Button1: TButton;
ComboBox1: TComboBox;
procedure Button1Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
VideoCamera: TVideoCaptureDevice;
procedure SampleBufferSync;
procedure SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
if (VideoCamera <> nil) then
begin
if (VideoCamera.State = TCaptureDeviceState.Stopped) then
begin
VideoCamera.OnSampleBufferReady := SampleBufferReady;
VideoCamera.StartCapture;
Button1.Caption := 'STOP';
end
else
begin
VideoCamera.StopCapture;
Button1.Caption := 'START';
end;
end
else
begin
Caption := 'Video capture devices not available.';
end;
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
VideoCamera := TVideoCaptureDevice(TCaptureDeviceManager.Current.GetDevicesByName(ComboBox1.Text));
if (VideoCamera <> nil) then
begin
Button1.Enabled := true;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
DeviceList: TCaptureDeviceList;
i: integer;
begin
DeviceList := TCaptureDeviceManager.Current.GetDevicesByMediaType(TMediaType.Video);
for i := 0 to DeviceList.Count - 1 do
begin
ComboBox1.Items.Add(DeviceList[i].Name);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if VideoCamera <> nil then
VideoCamera.StopCapture;
end;
procedure TForm1.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
TThread.Synchronize(TThread.CurrentThread, SampleBufferSync);
//Resize the image so that the video is buffered in its original size
Image1.Width:=Image1.Picture.Width;
Image1.Height:=Image1.Picture.Height;
end;
procedure TForm1.SampleBufferSync;
begin
VideoCamera.SampleBufferToBitmap(FMX.Graphics.TBitmap(Image1.Picture.Bitmap), true);
end;
end.