AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia FMX TCameracomponent geht auf Windows nicht ?
Thema durchsuchen
Ansicht
Themen-Optionen

FMX TCameracomponent geht auf Windows nicht ?

Ein Thema von QuickAndDirty · begonnen am 27. Apr 2023 · letzter Beitrag vom 2. Mai 2023
 
QuickAndDirty

Registriert seit: 13. Jan 2004
Ort: Hamm(Westf)
1.996 Beiträge
 
Delphi 12 Athens
 
#2

AW: FMX TCameracomponent geht auf Windows nicht ?

  Alt 27. Apr 2023, 09:06
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?
Andreas
Monads? Wtf are Monads?

Geändert von QuickAndDirty (27. Apr 2023 um 10:10 Uhr)
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:36 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz