Einzelnen Beitrag anzeigen

Benutzerbild von blawen
blawen

Registriert seit: 30. Nov 2003
Ort: Luterbach (CH)
654 Beiträge
 
Delphi 12 Athens
 
#1

Firemonkey - ungültige Zeigeroperation

  Alt 16. Feb 2014, 20:35
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.
Miniaturansicht angehängter Grafiken
bild-1.png  
Angehängte Dateien
Dateityp: zip TechDemo - Kamera 2 - UI.zip (190,1 KB, 22x aufgerufen)
Roland
  Mit Zitat antworten Zitat