FMX TCameracomponent geht auf Windows nicht ?

[QuickAndDirty]

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?

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?

[QuickAndDirty]

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

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

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?

[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

[QuickAndDirty]

Zitat:

Zitat von TiGü (Beitrag 1521628)

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...

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;

[TiGü]

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

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;

[QuickAndDirty]

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

[QuickAndDirty]

Geht leider nicht same error
Welches Delphi setzt du ein?

[TiGü]

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

[QuickAndDirty]

Der FehlerCode den ich bekomme ist der

Delphi-Quellcode:

Winapi.DirectShow9.VFW_E_CANNOT_CONNECT

super
warum auch immer.

[TiGü]

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

[QuickAndDirty]

Bei mir ist es Delphi 11.0 Alexandria...aus 2021
No Name HD Cam aber die geht mit dem VCL basierten DX9 programm von Spelt
https://github.com/Spelt/ZXing.Delph....0/demo/webcam

meinst es ist DX9 ???

ICh brauche leider FMX...sonst hätte ich das Das mit der VFrames.pas gemacht.. :(

[TiGü]

Hast du die Möglichkeit eine andere Webcam zu testen?

[QuickAndDirty]

Zitat:

Zitat von TiGü (Beitrag 1521659)

Hast du die Möglichkeit eine andere Webcam zu testen?

Hm evtl... Aber wenn die mit der VFrames.Pas geht.... warum dann nicht auch mit FMX?
Ich gucke mal was wir hier rum liegen haben.

[QuickAndDirty]

Der Spelt fügt andere VideoFilter hinzu als Embarcadero! Cheeky basterd!

Und die Error description ist ja auch
"Error Description: VFW_E_CANNOT_CONNECT. No combination of intermediate filters could be found to make the connection."

Delphi-Quellcode:

    // Add Capture filter to our graph.
    Result := pIGraphBuilder.AddFilter(pIBFVideoSource, Widestring('Video Capture'));
    if (FAILED(Result)) then
      begin
        // Couldn''t add the capture filter to the graph!
        exit;
      end;

    Result := pIGraphBuilder.AddFilter(piBFSampleGrabber, Widestring('Sample Grabber'));
    if (FAILED(Result)) then
      EXIT;

    if not(Visible) then
      begin
        Result := pIGraphBuilder.AddFilter(pIBFNullRenderer, WideString('Null Renderer'));
        if (FAILED(Result)) then
          EXIT;
      end;

    // Render the preview pin on the video capture filter
    // Use this instead of pIGraphBuilder->RenderFile
    New(pCut);
    New(pTyp);
    //pCut^ := PIN_CATEGORY_PREVIEW;
    pCut^ := PIN_CATEGORY_CAPTURE;
    pTyp^ := MEDIATYPE_Video;
    try
      if Visible
        then Result := pICapGraphBuild2.RenderStream (pCut, pTyp,
                                    //Addr(PIN_CATEGORY_PREVIEW), Addr(MEDIATYPE_Video),
                                    pIBFVideoSource, piBFSampleGrabber, nil)

        else Result := pICapGraphBuild2.RenderStream (pCut, pTyp,
                                    //Addr(PIN_CATEGORY_PREVIEW), Addr(MEDIATYPE_Video),
                                    pIBFVideoSource, piBFSampleGrabber, pIBFNullRenderer);
    except
      Result := -1;
    end;

Spelt benutzt als Filter 'Video Capture','Sample Grabber' und 'Null Renderer'(???)
Embarcaderod benutzt nur 'Capture' als Filter...

hm
Und meine Kamera macht wohl einen Jpeg stream....als vermutlich ne folge standbilder...

[QuickAndDirty]

Also ich habe es mit einer Logitch Webcam probiert... und es geht auch nicht. :(
Es könnte an der Delphi 11.0 liegen...

[TurboMagic]

Da ja jetzt die 11.3 CE draußen ist könnte man das entweder mit der oder mit einer Delphi Testversion
mal kostenlos 5 min testen, ob diese Webcam mit dem gleichen testprogramm dann mag.

[QuickAndDirty]

Hört sich nach einem weg an.

[hotrs02]

Der Zugriff auf eine angeschlossen Kamera unterliegt inzwischen auch den Datenschutzeinstellungen von Windows. Hast du in der Richtung schonmal nachgeschaut? Du findest den Abschnitt in den Einstellungen von Windows 10 unter Datenschutz / Kamera. In manchen fällen muss auch noch der Zugriff auf das integrierte Mikrofon erlaubt werden.

Darüber hinaus fängt inzwischen so ziemlich jede Schutzsoftware den Zugriff auf die Kamer ab. Bei mir meldet sich z.B. jedesmal Norton, wenn eine Anwendung die Kamera nutzen will.

hth

[QuickAndDirty]

Ja ich habe die Datenschutz Einstellungen alle geöffnet.
Und wenn ich ein VCL Projekt mit einem anderen Filterbaum benutze funktioniert es ja auch.
Ich habe versucht das VCL projekt(das funktioniert) zu FMXifizieren... aber habe das dann aufgegeben...das ist kein einfaches unterfangen.
Alternative müsste ich versuchen zu verstehen was Filter in DX9 sind und was ein Filterbaum macht und wie ich den selbst benutzen kann....
Wo ich eigentlich echt ein fan von Copy-Pasta, Bibliotheken und Komponenten bin...
Es kann sein dass ich erst in einem Monat vernünftig feedback zu der Neueren Delphi version geben kann. :(