Firemonkey - ungültige Zeigeroperation

[blawen]

Ich habe kürzlich von Delphi XE auf XE5 upgedatet und bin momentan ein wenig am "spielen" mit Firemonkey.
Eine der Spielereien betrifft "Video Capturing". Kurzerhand habe ich das Beispiel vom Emba DocWiki umgesetzt.
Grundsätzlich funktioniert das Programm, nach ein paar wenigen Minuten stürzt es jedoch mit der Fehlermeldung "Ungültige Zeigeroperation" ab - Bestenfalls verabschiedet es sich ohne irgendeine Meldung...

Hat mir ev. jemand einen Tipp, was ich falsch mache?

Delphi-Quellcode:

unit Unit2;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Ani, FMX.Layouts, FMX.Gestures,
  FMX.StdCtrls, FMX.ListBox, FMX.Media, FMX.Objects;

type
  TForm2 = class(TForm)
    StyleBook1: TStyleBook;
    ToolbarHolder: TLayout;
    ToolbarPopup: TPopup;
    ToolbarPopupAnimation: TFloatAnimation;
    ToolBar1: TToolBar;
    ToolbarApplyButton: TButton;
    ToolbarCloseButton: TButton;
    ToolbarAddButton: TButton;
    Layout1: TLayout;
    StartButton: TButton;
    ComboBox1: TComboBox;
    Image1: TImage;
    procedure ToolbarCloseButtonClick(Sender: TObject);
    procedure FormGesture(Sender: TObject;
              const EventInfo: TGestureEventInfo; var Handled: Boolean);
    procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
                          Shift: TShiftState);
    procedure StartButtonClick(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FGestureOrigin: TPointF;
    FGestureInProgress: Boolean;
    { Private-Deklarationen }
    procedure ShowToolbar(AShow: Boolean);
  public
    { Public-Deklarationen }
    VideoCamera: TVideoCaptureDevice;
    procedure SampleBufferSync;
    procedure SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word;
  var KeyChar: Char; Shift: TShiftState);
begin
  if Key = vkEscape then
    ShowToolbar(not ToolbarPopup.IsOpen);
end;

procedure TForm2.ToolbarCloseButtonClick(Sender: TObject);
begin
  Application.Terminate;
end;

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
   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 TForm2.FormGesture(Sender: TObject;
const
  EventInfo: TGestureEventInfo; var Handled: Boolean);
var
  DX, DY : Single;

begin
  if EventInfo.GestureID = igiPan then
  begin
    if (TInteractiveGestureFlag.gfBegin in EventInfo.Flags)
      and ((Sender = ToolbarPopup)
        or (EventInfo.Location.Y > (ClientHeight - 70))) then
    begin
      FGestureOrigin := EventInfo.Location;
      FGestureInProgress := True;
    end;

    if FGestureInProgress and (TInteractiveGestureFlag.gfEnd in EventInfo.Flags) then
    begin
      FGestureInProgress := False;
      DX := EventInfo.Location.X - FGestureOrigin.X;
      DY := EventInfo.Location.Y - FGestureOrigin.Y;
      if (Abs(DY) > Abs(DX)) then
        ShowToolbar(DY < 0);
    end;
  end
end;

procedure TForm2.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.Bitmap.Width;
  Image1.Height:=Image1.Bitmap.Height;
end;

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

procedure TForm2.ShowToolbar(AShow: Boolean);
begin
  ToolbarPopup.Width := ClientWidth;
  ToolbarPopup.PlacementRectangle.Rect := TRectF.Create(0, ClientHeight-ToolbarPopup.Height, ClientWidth-1, ClientHeight-1);
  ToolbarPopupAnimation.StartValue := ToolbarPopup.Height;
  ToolbarPopupAnimation.StopValue := 0;

  ToolbarPopup.IsOpen := AShow;
end;

procedure TForm2.StartButtonClick(Sender: TObject);
begin
  if (VideoCamera <> nil) then
   begin
     if (VideoCamera.State = TCaptureDeviceState.Stopped) then
     begin
       VideoCamera.OnSampleBufferReady := SampleBufferReady;
       VideoCamera.StartCapture;
       StartButton.Text := 'Stop';
     end
     else
     begin
       VideoCamera.StopCapture;
       StartButton.Text := 'Start';
     end;
   end
   else
   begin
     Caption := 'Video capture devices not available.';
   end;
end;

end.

[Harry Stahl]

Ja, kann das Problem bestätigen. Habe bei Quality Central eine Meldung gemacht:

http://qc.embarcadero.com/wc/qcmain.aspx?d=122608

Falls die Behebung dieses Problem für Dich wichtig sein sollte, kannst Du ein Vote auf diese Meldung abgeben, dann beschleunigt sich die Bearbeitung des Falles evtl. ein wenig.

Falls ich eine Nachricht bezüglich eines Workarounds erhalten sollte, poste ich das hier.

[blawen]

Zitat:

Zitat von Harry Stahl (Beitrag 1248640)

Ja, kann das Problem bestätigen. Habe bei Quality Central eine Meldung gemacht:

http://qc.embarcadero.com/wc/qcmain.aspx?d=122608

Falls die Behebung dieses Problem für Dich wichtig sein sollte, kannst Du ein Vote auf diese Meldung abgeben, dann beschleunigt sich die Bearbeitung des Falles evtl. ein wenig.

Falls ich eine Nachricht bezüglich eines Workarounds erhalten sollte, poste ich das hier.

Lieben Dank für Deine Mithilfe :-) Ich habe soeben mein Votum abgegeben.
Für eine technische Demo bei einer Berufsmesse hätte ich gerne Firemonkey als "Plattform" eingesetzt, im "worst case" werde ich zwangsweise darauf verzichten (müssen).

(Die Kamera ist ein wichtiger Bestandteil einer Modelleisenbahnanlage, welche zentral von einem Computer und von uns eigens dafür entwickelten und programmierten Steuerplatinen angegesteuert wird (ähnlich wie bei Miniatur-Wunderland - nur massiv kleiner)

So gesehen ist es nicht "Überlebenswichtig", aber es wäre doch schön gewesen.

[Harry Stahl]

Alles klar. Evtl. hat ja noch jemand Lust, der diesen Thread liest, für diesen Punkt zu Voten.

Aus meiner Sicht wäre auch wichtig, diesen Bug schnell beseitigen zu lassen:

http://qc.embarcadero.com/wc/qcmain.aspx?d=122609

Wenn man in FMX einen Style in dem Style-Designer editieren möchte (also Rechtsklick auf ein Control und dann Befehl "Benutzerdefinierten Stil bearbeiten" wählen) ist seit XE3 in der Strukturliste das entsprechende Objekt nicht ausgewählt. Das nervt schon sehr, wenn man es dann aus einer u.U. ziemlich langen Liste selber raus suchen muss. Und gerade für Anfänger in Firemonkey ist es sehr schwer zu verstehen, was man da überhaupt machen muss.

[blawen]

Zitat:

Zitat von Harry Stahl (Beitrag 1248655)

Alles klar. Evtl. hat ja noch jemand Lust, der diesen Thread liest, für diesen Punkt zu Voten.

Aus meiner Sicht wäre auch wichtig, diesen Bug schnell beseitigen zu lassen:

http://qc.embarcadero.com/wc/qcmain.aspx?d=122609

Dies ist mir auch negativ aufgefallen, darum hast Du mein Voting.

[Sir Rufo]

Also mich machen diese Zeilen ja stutzig

Delphi-Quellcode:

procedure TForm2.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin

  // Synchronisieren - ok, wenn man in einem anderen Thread-Kontext ist, macht das manchmal Sinn

  TThread.Synchronize(TThread.CurrentThread, SampleBufferSync);

  // äh, wenn wir in einem anderen Thread-Kontext sind, 
  // dann doch bitte keinen direkten Zugriff auf die Controls

  //Resize the image so that the video is buffered in its original size
  Image1.Width:=Image1.Bitmap.Width;
  Image1.Height:=Image1.Bitmap.Height;
end;

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

Des Weiteren können wir hier lesen

Zitat:

Warnung: Rufen Sie Synchronize nicht aus dem Haupt-Thread auf. Dies kann zu einer Endlosschleife führen.

Somit kann dieser Code niemals richtig sein!

1. Die Methode wird im Haupt-Thread aufgerufen, dann ist
   Delphi-Quellcode:

   TThread.Synchronize

   falsch
2. Die Methode wird nicht im Haupt-Thread aufgerufen, dann darf aber auch nicht auf
   Delphi-Quellcode:

   Image1

   zugegriffen werden

Ich würde diese Zeilen mal abändern auf

Delphi-Quellcode:

procedure TForm2.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  if MainThreadID = TThread.CurrentThread.ThreadID then
    SampleBufferSync
  else
    TThread.Synchronize(TThread.CurrentThread, SampleBufferSync);
end;

procedure TForm2.SampleBufferSync;
begin

  // Hier sollten wir uns auf jeden Fall im MainThread befinden

  VideoCamera.SampleBufferToBitmap(Image1.Bitmap, true);

  //Resize the image so that the video is buffered in its original size
  Image1.Width:=Image1.Bitmap.Width;
  Image1.Height:=Image1.Bitmap.Height;
end;

und dann sehen was passiert ...

PS: Auf meinem Mac ist die noch nicht einmal abgestürzt

[Harry Stahl]

Leider bewirkt die von Sir Rufo vorgeschlagene Änderung keine Besserung. Nach einigen Sekunden oder in 1-2 Minuten stürzt das Programm ab.

So ganz verstanden habe ich die von EMBA vorgeschlagene Lösung sowieso nicht. SampleBufferReady ist ja eine Ereignisroutine des Hauptthread.

In der Hilfe steht dazu: "Mit einer Ereignisbehandlungsroutine für OnSampleBufferReady können Sie die Aktionen angeben, die ausgeführt werden, wenn der Ausschnittspuffer bereit ist."

Warum muss ich jetzt den Zugriff über einen Thread auf den Buffer machen? Überlaufgefahr? Eigentlich doch nicht, denn ich rufe den Buffer doch ab, wenn ich ihn brauche. In der Beschreibung zu "DoSampleBufferToBitmap" bzw. "SampleBufferToBitmap" steht auch nichts davon, dass ich das threadden müsste.

Wie auch immer, hier nun einer Variante, die bei mir seit ca. einer halben Stunde ohne Probleme läuft:

Delphi-Quellcode:

procedure TForm2.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  //TThread.Synchronize(TThread.CurrentThread, SampleBufferSync);
  
   VideoCamera.SampleBufferToBitmap(Image1.Bitmap, True);

   sleep (100);

  //Resize the image so that the video is buffered in its original size  
  if (Image1.Width <> Image1.Bitmap.Width) or (Image1.Height <> Image1.Bitmap.height) then begin
    Image1.Width:=Image1.Bitmap.Width;
    Image1.Height:=Image1.Bitmap.Height;
  end;
end;

Sleep (100) wird aber benötigt, sonst kracht das Programm dann irgendwann doch mal ab.

Immerhin reduziert sich die Prozessorlast mit dieser Variante auf ca. 3-6% (vorher 12%), die Darstellung ist allerdings etwas verzögert.

[Harry Stahl]

Nachtrag:

Wobei die von mir vorgeschlagene Lösung auf dem MAC viel zu langsam ist.

Auf dem MAC läuft allerdings sowohl die von EMBA, als auch die von Sir Rufo vorgeschlagene Lösung(beide aber eben nicht unter Windows).

Also könnte man die Sache erst mal mit {$IFDEF MAC} usw. lösen. Unter Windows zur Not ["erst mal", bis wir es richtig wissen] die von mir vorgeschlagene Lösung, unter MAC die von Sir Rufo.

[Sir Rufo]

Zitat:

Zitat von Harry Stahl (Beitrag 1248857)

Nachtrag:

Wobei die von mir vorgeschlagene Lösung auf dem MAC viel zu langsam ist.

Auf dem MAC läuft allerdings sowohl die von EMBA, als auch die von Sir Rufo vorgeschlagene Lösung(beide aber eben nicht unter Windows).

Also könnte man die Sache erst mal mit {$IFDEF MAC} usw. lösen. Unter Windows zur Not ["erst mal", bis wir es richtig wissen] die von mir vorgeschlagene Lösung, unter MAC die von Sir Rufo.

Deine Lösung unterscheidet sich von meiner Lösung durch das Aufrufen von Sleep.

BTW Die Abfrage ist überflüssig denn der Setter prüft schon, ob sich der Wert ändert und löst nur dann ein Repaint aus:

Delphi-Quellcode:

  if (Image1.Width <> Image1.Bitmap.Width) or (Image1.Height <> Image1.Bitmap.height) then begin
    Image1.Width:=Image1.Bitmap.Width;
    Image1.Height:=Image1.Bitmap.Height;
  end;

[Harry Stahl]

Zitat:

Zitat von Sir Rufo (Beitrag 1248861)

Deine Lösung unterscheidet sich von meiner Lösung durch das Aufrufen von Sleep.

Nein, Du hast noch einen zusätzlichen Prozedur-Aufruf und im Else-zweig einen möglichen Thread-Aufruf.

Zitat:

Zitat von Sir Rufo (Beitrag 1248861)

BTW Die Abfrage ist überflüssig denn der Setter prüft schon, ob sich der Wert ändert und löst nur dann ein Repaint aus:

Delphi-Quellcode:

  if (Image1.Width <> Image1.Bitmap.Width) or (Image1.Height <> Image1.Bitmap.height) then begin
    Image1.Width:=Image1.Bitmap.Width;
    Image1.Height:=Image1.Bitmap.Height;
  end;

Das stimmt zwar, dass beim Setter Repaint nur ausgelöst wird, wenn die Bitmap sich im Ausmaß geändert hat, aber es werden davon unabhängig IMMER beim Setter noch andere Aktionen für das TImage ausgeführt, die letztlich überflüssig sind.

Ich habe das hier gerade mal getestet, auf 1 Mio Durchläufe macht das ca. 200 MS Unterschied aus. Nun gut, ist nicht die Welt hier. Aber es gibt andere Beispiele wo sich der (überflüssige) Aufruf von Settern deutlich mehr auf die Performance auswirkt. Deswegen habe ich es mir angewöhnt, Setter nur aufzurufen, wenn es wirklich notwendig ist.

[Sir Rufo]

Es wird im

Delphi-Quellcode:

else

-Zweig kein Thread aufgerufen, sondern aus dem aktuellen Thread-Kontext heraus wird synchronisiert die andere Methode aufgerufen.

Dieses geschieht aber auch nur dann, wenn der Aufruf nicht im Kontext des MainThreads erfolgt.

Der Aufruf erfolgt aber eben immer im MainThread-Kontext (darauf habe ich schon hingewiesen und auf die Dokumentation, die sagt, dass Synchronize im MainThread-Kontext böse ist).

Ich wollte damit nur verdeutlichen, wie man so einen synchronisierten Aufruf implementieren sollte, damit es eben nicht da zu Problemen führen kann.

Im Setter wird ein Vergleich gemacht und wenn das nicht passt, dann wird der Rest ausgeführt.
Aber du hast insofern Recht, weil dort der Setter und darin eine weitere Funktion aufgerufen wird. Und jeder call kostet durchaus Zeit.

Darum gibt es ja auch für performance-relevante Funktionen den Tipp, diese als

Delphi-Quellcode:

inline

zu deklarieren. Das macht die EXE zwar grösser aber auch schneller.

[Harry Stahl]

Zitat:

Zitat von Sir Rufo (Beitrag 1248889)

Aber du hast insofern Recht, weil dort der Setter und darin eine weitere Funktion aufgerufen wird. Und jeder call kostet durchaus Zeit.

Darum gibt es ja auch für performance-relevante Funktionen den Tipp, diese als

Delphi-Quellcode:

inline

zu deklarieren. Das macht die EXE zwar grösser aber auch schneller.

Da stimme ich Dir zu. Bei meinem Bildverarbeitungsprogramm, wo ich z.B. in der Ebenendarstellung ein unteres mit dem oberen Bild verrechnen muss, z.B. bezogen auf unterschiedliche Transparenzwerte im jeweiligen Bild, Deckungskraft der Ebenen, Masken und Filter ("Strahlendes Licht", etc). kommen ganz schnell mehrere 100 Mio. Berechnungsvorgänge beisammen. Ohne Inline geht das an bestimmten Stellen gar nicht mehr. Im normalen Programmablauf macht ein Call nichts aus, musst Du aber einen Call mehrere 100 Mio. mal aufrufen, evtl. sogar Parameter übergeben, dann merkt man es ganz heftig.

[blawen]

Beim ausführen des Programms bekomme ich nun keine Fehlermeldung mehr (beim beenden des Programms hingegen schon).

Ein grundlegendes Problem bleibt bei mir trotzdem (bei beiden Varianten):
Das Bild wird nach kurzer Zeit kurz eingefroren und geht dann wieder weiter. Das nächste Einfrieren findet anschliessend etwas früher statt, dafür dauert es aber etwas länger. Nach einer Minute oder so findet ein Bildwechsel nur noch alle x-Sekunden statt.

[Sir Rufo]

Ich denke wir haben hier primär ein Timing-Problem. Das hat Harry ja schon versucht mit dem

Delphi-Quellcode:

Sleep

in den Griff zu bekommen.

Das könnte sich aber auch wiederum negativ auf die Kommunikation mit der Kamera selber auswirken.

Um dem System jetzt wirklich Luft zu verschaffen, sollte es nicht für 100ms schlafen geschickt werden, sondern nur alle 100ms ein Bild von der Kamera auslesen.

Delphi-Quellcode:

type
  TForm2 = class( TForm )
    ...
  private
    FLastRead : TDateTime;
    ...
  end;

procedure TForm2.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  if MilliSecondsBetween( FLastRead, Now ) < 100 then
    Exit;

   VideoCamera.SampleBufferToBitmap(Image1.Bitmap, True);

  //Resize the image so that the video is buffered in its original size 
  if (Image1.Width <> Image1.Bitmap.Width) or (Image1.Height <> Image1.Bitmap.height) then begin
    Image1.Width:=Image1.Bitmap.Width;
    Image1.Height:=Image1.Bitmap.Height;
  end;

  FLastRead := Now;
end;

Ungetestet aber einen Blick wert.

Auch wäre es einen Versuch wert den SampleBuffer nicht direkt in die Image-Komponente zu blasen, sondern in eine unabhängige

Delphi-Quellcode:

TBitmap

-Instanz zu laden und dann erst der Image-Komponente zuzuweisen. Macht aber nur Sinn, wenn diese Instanz von der Form vorgehalten wird und somit nicht ständig erzeugt und zerstört wird.

Ich habe jetzt nicht im Source nachgeschaut wie der SampleBuffer in das Bitmap geschoben wird, aber es ist denkbar, dass dabei ein mehrfaches Neuzeichnen der Image-Komponente provoziert wird.

Mit der Bitmap-Instanz dazwischen müsste man das zuverlässig auf ein Neuzeichnen reduzieren können.

Eine weitere Option wäre es das VideoCaptureDevice in einem eigenen Thread zu starten und auch dort den SampleBuffer auszulesen. Hier ist jetzt noch eine geschickte Logik gefragt, wie die Image-Komponente an das Bild kommt ohne den Capture-Thread auszubremsen.