Ich habe das Test programm erstellt.
Warum geht TCampercompanent auf Windows nicht?
Es Liefert keine fehler... es zeigt einfach nur kein bild an.
Liegt es an Delphi 11.0?

zusammenfalten · markieren

Delphi-Quellcode:

unit WebcamMain;

interface

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

type
  TForm1 = class(TForm)
    imgCamera: TImage;
    cam: TCameraComponent;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure camSampleBufferReady(Sender: TObject; const ATime: TMediaTime);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Cam.Kind := TCameraKind.Default;
  Cam.OnSampleBufferReady := camSampleBufferReady;
  Cam.Active := true;
end;

procedure TForm1.camSampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  TThread.synchronize(TThread.CurrentThread,
    Procedure
    Begin
      cam.SampleBufferToBitmap(imgCamera.Bitmap, true);
    End
  );
end;

end.

EDIT:
OK es sieht so aus als ob er erstmal daran sheitert das die WEBCam die über USB angeschlossen ist als Position "unspecified" hat und TCameraComponent nur Video capture devices anzeigt die als Position entweder "FrontCamera" oder "backCamera" haben....
Was zum F#ck?
Wo kann ich die Position meiner Webcam configurieren?

OK Habe es leicht modifiziert
Jetzt findet er schonmal DIE Webcam.

zusammenfalten · markieren

Delphi-Quellcode:

unit WebcamMain;

interface

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

type
  TForm1 = class(TForm)
    imgCamera: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);

  private
    { Private-Deklarationen }
    fVideoCamera: TVideoCaptureDevice;
  public
    { Public-Deklarationen }
    procedure GetCamNameList(CamNames:TStrings);
    function VideoCamera: TVideoCaptureDevice;
    procedure SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

//Test funktion
procedure TForm1.GetCamNameList(CamNames:TStrings); // Listet genau eine Camera auf!! "USB CAMERA"
var
  I: Integer;
  D: TCaptureDevice;
begin
  CamNames.Clear;
  for I := 0 to TCaptureDeviceManager.Current.Count - 1 do
  begin
    D := TCaptureDeviceManager.Current.Devices[I];
    if (D.MediaType = TMediaType.Video) and (D is TVideoCaptureDevice) then
    begin
      CamNames.addObject(d.Name, d);
    end;
  end;
End;

function TForm1.VideoCamera: TVideoCaptureDevice;
var
  I: Integer;
  D: TCaptureDevice;
begin
  Result := FVideoCamera;
  if (Result = nil) and (TCaptureDeviceManager.Current <> nil) then
  begin
    for I := 0 to TCaptureDeviceManager.Current.Count - 1 do
    begin
      D := TCaptureDeviceManager.Current.Devices[I];
      if (D.MediaType = TMediaType.Video) and
         (D is TVideoCaptureDevice) and
         D.IsDefault then
      begin
        Result := TVideoCaptureDevice(D);
        FVideoCamera := Result; //hab das korrigiert...
        Break;
      end;
    end;
    {if Result = nil then
    Begin
      FVideoCamera := Result;
      Result := TCaptureDeviceManager.Current.DefaultVideoCaptureDevice;
    End;}
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if VideoCamera <> nil then
  begin
    VideoCamera.OnSampleBufferReady := SampleBufferReady;
    VideoCamera.StartCapture;
  end
end;

procedure TForm1.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  TThread.synchronize(TThread.CurrentThread,
    Procedure
    Begin
      VideoCamera.SampleBufferToBitmap(imgCamera.Bitmap, true);
    End
  );
end;

end.

Jedoch wenn ich StartCapture aufrufe scheitert das Programm in der Unit FMX.Media.Win anfolgender stelle

zusammenfalten · markieren

Delphi-Quellcode:

procedure TWindowsVideoCaptureDevice.DoStartCapture;
var
  HR: HResult;
begin
  // Create GraphBuilder
  HR := CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC_SERVER,
    IID_ICaptureGraphBuilder2, FCaptureGraphBuilder);
  if Succeeded(HR) then
  begin
    HR := CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER, IID_IFilterGraph2, FGraphBuilder);
    if Succeeded(HR) then
    begin
      FCaptureGraphBuilder.SetFiltergraph(FGraphBuilder);
      // Get IMediaControl
      FGraphBuilder.QueryInterface(IID_IMediaControl, FMediaControl);
      if FBaseFilter <> nil then
      begin
        // Set Capture
        HR := FGraphBuilder.AddFilter(FBaseFilter, 'Capture');
        if Succeeded(HR) then
        begin
          // Create VMR
          FVMRRenderer := TVMRRenderer.Create;
          FVMRRenderer.FSampleBufferReady := VMRRendererSampleReady;
          FVMRRenderer.AddToGraph(FGraphBuilder);
          // Start
          HR := FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, FBaseFilter, nil, FVMRRenderer.FBaseFilter);
          if Succeeded(HR) then //<<<<<<<<<<<<<<<<<<<<HIER SUCCEEDED(HR) Ist anscheinenend False....WARUM????
          begin
            if FMediaControl <> nil then
            begin
              FMediaControl.Run;
              Exit; // Success
            end;
          end;
        end;
      end;
    end;
  end;
  FMediaControl := nil;
  FCaptureGraphBuilder := nil;
  FGraphBuilder := nil;
  FreeAndNil(FVMRRenderer);
end;

Weiß jemand rat? Sollte ich mal auf Verdacht(ActiveX war im Stack irgendwo zu lesen) einfach CoInitialize aufrufen?

Welchen Wert hat denn HR?

VFW_S_NOPREVIEWPIN - 0x0004027E
VFW_E_NOT_IN_GRAPH - 0x8004025F

E_FAIL Unspecified failure - 0x80004005
E_INVALIDARG - One or more arguments are not valid - 0x80070057
E_POINTER - Pointer that is not valid - 0x80004003

https://learn.microsoft.com/en-us/wi...2-renderstream

Zitat von TiGü:

Welchen Wert hat denn HR?

VFW_S_NOPREVIEWPIN - 0x0004027E
VFW_E_NOT_IN_GRAPH - 0x8004025F

E_FAIL Unspecified failure - 0x80004005
E_INVALIDARG - One or more arguments are not valid - 0x80070057
E_POINTER - Pointer that is not valid - 0x80004003

https://learn.microsoft.com/en-us/wi...2-renderstream

HM
Nichts dergleichen....

Cardinal(HR) = 2147746327
Oder 0x80040217

Habe die Unit ins projekt kopiert und bearbeitet um infos zu bekommen....zugriff auf dieKamera ist in den Datenschutzeinstellungen gewährt.. mit Microsoft Windows kamerApp geht es...

zusammenfalten · markieren

Delphi-Quellcode:

          // Start
          HR := FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, FBaseFilter, nil, FVMRRenderer.FBaseFilter);
          if Succeeded(HR) then
          begin
            if FMediaControl <> nil then
            begin
              FMediaControl.Run;
              Exit; // Success
            end;
          end
          else
          Begin
            Showmessage('HR:'+InttoHex(HR) );
          End;

Ich habe keine vernünftigte Erklärung, aber wenn du so machst dann geht es:

zusammenfalten · markieren

Delphi-Quellcode:

procedure TForm3.Button1Click(Sender: TObject);
var
    CaptureDev: TVideoCaptureDevice;
    Settings: TArray<TVideoCaptureSetting>;
begin
  CaptureDev := VideoCamera;
  if CaptureDev <> nil then
  begin
    Settings := CaptureDev.AvailableCaptureSettings;
    CaptureDev.OnSampleBufferReady := SampleBufferReady;
    CaptureDev.StartCapture;
  end
end;

Hm Ich versuche es.
Wir brauchen keine Erklärungen. Wir brauchen nur jemand den wir beschuldigen können
Ok Lösungen sind aber auch gut

Geht leider nicht same error
Welches Delphi setzt du ein?

Delphi 11.3 mit Patch 1.
Logitech Webcam mit HD 1080p.

Der FehlerCode den ich bekomme ist der
Winapi.DirectShow9.VFW_E_CANNOT_CONNECT super
warum auch immer.

Check mal Grafikkartentreiber etc.
Ist am Ende ja eine DirectShow/Direct3D9 Anbindung.