AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Mediaplayer Firemonkey

Ein Thema von holgerderchsler · begonnen am 26. Sep 2015 · letzter Beitrag vom 30. Sep 2015
 
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#11

AW: Mediaplayer Firemonkey

  Alt 28. Sep 2015, 15:29
Nur der Vollständigkeit halber, wie man das plattformübergreifend aufbauen sollte:
  • Ziel:
    Delphi-Quellcode:
    unit dp_186753.Forms.MainForm;

    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.Controls.Presentation, FMX.StdCtrls;

    type
      TMainForm = class( TForm )
        MediaPlayer1: TMediaPlayer;
        MediaPlayerControl1: TMediaPlayerControl;
        Button1: TButton;
        procedure Button1Click( Sender: TObject );
      private
        { Private-Deklarationen }
      public
        { Public-Deklarationen }
      end;

    var
      MainForm: TMainForm;

    implementation

    {$R *.fmx}

    uses
      FMX.Media.Helpers; // 1 unit einbinden

    procedure TMainForm.Button1Click( Sender: TObject );
    begin
      MediaPlayerControl1.Stretch; // stretch aufrufen
    end;

    end.
  • Umsetzung
    Delphi-Quellcode:
    unit FMX.Media.Helpers;

    // Hier wird das Routing für die unterschiedlichen Plattformen erledigt

    interface

    uses
      FMX.Media;

    type
      TMediaPlayerControlHelper = class helper for TMediaPlayerControl
      public
        procedure Stretch;
      end;

      TMediaPlayerHelper = class helper for TMediaPlayer
      public
        procedure Stretch;
      end;

      TMediaHelper = class helper for TMedia
      public
        procedure Stretch;
      end;

    implementation

    uses
      FMX.Consts
    {$IFDEF MSWINDOWS}
        , FMX.Media.Win, FMX.Media.Win.Helpers
    {$ENDIF}
    {$IFDEF MACOS}
        , FMX.Media.AVFoundation
    {$IFDEF IOS}
        , FMX.Media.iOS // , FMX.Media.iOS.Helpers { TODO }
    {$ELSE}
        , FMX.Media.Mac // , FMX.Media.Mac.Helpers { TODO }
    {$ENDIF}
    {$ENDIF}
    {$IFDEF ANDROID}
        , FMX.Media.Android // , FMX.Media.Android.Helpers { TODO }
    {$ENDIF ANDROID}
        ;

    { TMediaHelper }

    procedure TMediaHelper.Stretch;
    begin
    {$IFDEF MSWINDOWS}
      // Windows
      if Self is TWindowsMedia
      then
        TWindowsMedia( Self ).Stretch;
    {$ENDIF}
    {$IFDEF MACOS}
    {$IFDEF IOS}
      // iOS
    {$ELSE}
      // OSX
    {$ENDIF}
    {$ENDIF}
    {$IFDEF ANDROID}
      // Android
    {$ENDIF ANDROID}
    end;

    { TMediaPlayerHelper }

    procedure TMediaPlayerHelper.Stretch;
    begin
      if Assigned( Media ) and ( State = TMediaState.Playing )
      then
        Media.Stretch;
    end;

    { TMediaPlayerControlHelper }

    procedure TMediaPlayerControlHelper.Stretch;
    begin
      if Assigned( MediaPlayer )
      then
        MediaPlayer.Stretch;
    end;

    end.
    Delphi-Quellcode:
    unit FMX.Media.Win.Helpers;

    interface

    uses
      FMX.Media,
      FMX.Media.Win;

    type
      TWindowsMediaHelper = class helper for TWindowsMedia
        procedure Stretch;
      end;

    implementation

    uses
      FMX.Controls,
      FMX.Forms,
      FMX.Platform.Win,
      FMX.Types,
      System.Classes,
      System.Types,
      Winapi.DirectShow9,
      Winapi.Windows;

    { TWindowsMediaHelper }

    procedure TWindowsMediaHelper.Stretch;
    var

      P : TPointF;
      R : TRect;
      Bounds: TRectF;
      Form : TCommonCustomForm;
      // this is just an updated version of TRecF.Fit to support scaling up
      function MyRectFit( var R: TRectF; const BoundsRect: TRectF ): Single;
      var
        ratio: Single;
      begin
        Result := 1;
        if BoundsRect.Width * BoundsRect.Height = 0
        then
          Exit;
        if ( R.Width / BoundsRect.Width ) > ( R.Height / BoundsRect.Height )
        then
          ratio := R.Width / BoundsRect.Width
        else
          ratio := R.Height / BoundsRect.Height;
        // UPDATED
        R := RectF( 0, 0, R.Width / ratio, R.Height / ratio );
        Result := ratio;
        RectCenter( R, BoundsRect );
      end;

    var
      leFWnd : HWND;
      leControl : TControl;
      leFVMRWindowlessControl: IVMRWindowlessControl9;
    begin
      leFWnd := Self.FWnd;
      leControl := TControl( FControl );
      leFVMRWindowlessControl := Self.FVMRWindowlessControl;

      if leFWnd <> 0
      then
        begin
          if ( leControl <> nil ) and not( csDesigning in Control.ComponentState ) and ( Control.ParentedVisible ) and ( Control.Root <> nil ) and
            ( Control.Root.GetObject is TCommonCustomForm )
          then
            begin
              Form := TCommonCustomForm( Control.Root.GetObject );
              P := Self.GetVideoSize;
              Bounds := TRectF.Create( 0, 0, P.X, P.Y );
              // UPDATED: Bounds.Fit(RectF(0, 0, Control.AbsoluteWidth, Control.AbsoluteHeight));
              MyRectFit( Bounds, RectF( 0, 0, Control.AbsoluteWidth, Control.AbsoluteHeight ) );
              Bounds.Offset( Control.AbsoluteRect.Left, Control.AbsoluteRect.Top );
              SetParent( leFWnd, FmxHandleToHWND( Form.Handle ) );
              SetWindowPos( leFWnd, 0, Bounds.Round.Left, Bounds.Round.Top, Bounds.Round.Width,
                Bounds.Round.Height, 0 );
              R.Create( 0, 0, Bounds.Round.Width, Bounds.Round.Height );
              if leFVMRWindowlessControl <> nil
              then
                leFVMRWindowlessControl.SetVideoPosition( nil, @R );
              ShowWindow( leFWnd, SW_SHOW )
            end
          else
            ShowWindow( leFWnd, SW_HIDE )
        end;
    end;

    end.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  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 07:33 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