CHackbart

I now get some error messages on certain accounts with "invalid sequence number". I never saw this before.

Nevermind I found the problem.

Wow, this was quick. Thanks  Pop.UseTLS := utUseImplicitTLS; works 🙂

Christian

Hi,

this might sound stupid, but it has been a while since I touched this particular code. Somehow connect fails gracefully. The old code was working since ages, but the provider (ionos) switched to TLS 1.2. So I changed my code into:

  POP := TIdPOP3.Create(nil);
  SSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  SSL.SSLOptions.Method := sslvTLSv1_2;
  POP.IOHandler := SSL; //SSL
  Pop.Port := 995;

I use openssl-1.0.2u-i386-win32 for OpenSSL. 

Does somebody have an idea? 

Christian

Thanks, for the hint. I managed to do this and the Transporter App does not complain it anymore. Besides this under TestFlight I get a "Not Available for Testing". 

Christian

Hi,

i have a problem when i try to publish an application. I upload it via Transporter, but it complains the following:

"Cannot be used with TestFlight because the bundle at “Appname.app” is missing a provisioning profile. Main bundles are expected to have provisioning profiles in order to be eligible for TestFlight." (90889)

I have no idea what I do wrong, I set it up correctly, and also tried to sign It by hand via:

codesign -f -v -s "3rd Party Mac Developer Application" Appname.app

productbuild --component "Appname.app" /Applications --sign "3rd Party Mac Developer Installer:" --product "Appname.app/Contents/info.plist" Appname.pkg

Does someone have an idea what I missed?

Christian

Hi,

does somebody know if there is an example how to use the System.Net.Socket in combination with UDP? 

In the past I used synapse for this, but prefer in order to simplify my code use something which is officially supported on all platforms. 

What I did till now is the following: 

1. I collect the available network devices via:

procedure GetLocalIPs(iplist: TStrings; ipfamily: Integer);
var
  TcpSock: TTCPBlockSocket;
begin
    TcpSock := TTCPBlockSocket.create;
    case ipfamily of
      1 : TcpSock.family:=SF_IP4;
      2 : TcpSock.family:=SF_IP6;
    end;
    try
      TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
    finally
      TcpSock.Free;
    end;
end;

2. I create a TUDPBlockSocket using: 

 Result := TUDPBlockSocket.Create();
 Result.bind(aIP, '0');
 Result.Connect('239.255.255.250', '1900');

resp.

Result := TUDPBlockSocket.Create();
  Result.EnableReuse(True);
  Result.bind(aIP, '1900');
  Result.MulticastTTL := 5;
  Result.AddMulticast('239.255.255.250');

3. These sockets where hosted in a TSocketList which I used to check if data is available using:

if FSocketList[0].GroupCanRead(fSockets, ftimeout, fActive) then

This worked well, but I would like to replace the whole code using the official Socket implementation instead. Anyhow I do not find a proper explanation how to use TSocket.Create(TSocketType.UDP, TEncoding.UTF8).

So if there is somebody who could point my nose to some code snippets, this would be great. I neither know how to get a list of the available network devices, nor how to bind the sockets or to send a request to socket I created first at step 2 

Cheers

Christian

I think you are right, I read a bit about the TControlType. In theory I could put a TPanel as parent of my OSD on top of the browser/video player. This works on Windows, for Mac I move the browser/video view in the context video and not the form nsview.

Anyhow this works at the moment here, but I have to figure out how to hook WM_ERASEBKGND for the panel in order to make it transparent, 

Cheers

Christian 

Hi, thanks I voted for your issue - even if I am not sure if it helps. I would love to test that, but I assume it probably won't work in my case.

The project I am working is an iptv application which heavily uses DRM, so I was forced to use the AVFoundation classes under MacOS and since Microsoft somehow did not support Playready properly for Win32/Win64 I was forced to use Widevine in combination with Edge as player under windows.

Both are working fine but suck when you try to use FMX controls on top as overlay. Since I use a browser under windows, I thought it might be cool to add HbbTV (some sort of interactive content for tv) to the streams and after I got this working I thought it would be nice to have this also running on a Mac.

Hi,

i was trying to handle the following issue: I want to render FMX components over native components like the Webbrowser. To do so I wrote a TLayout class which has a transparent form. This form will be drawn over the original position. This works reasonably well under windows, but fails under MacOS. 

Technically I put the NSView of the new form in the context of the old form, but on top. This works fine, but all the elements are not clickable. Has somebody an idea how to solve this? For FMX.Media.Mac you can easily put the video in the context before the LFormView, like:

    LFormView := WindowHandleToPlatform(LForm.Handle).View;
    LContext := TNSView.Wrap(WindowHandleToPlatform(LForm.Handle).Wnd.contentView);
    LContext.addSubview(FVideoView);
    LContext.addSubview(LFormView);

unit FMX.LayoutForm;

interface

uses System.Classes, FMX.Types, FMX.Layouts, FMX.Forms
{$IFDEF MSWINDOWS}, Winapi.Windows, Winapi.Messages{$ENDIF};

type
  TVirtualLayout = class(TLayout)
  protected
    FView: TForm;
{$IFDEF MSWINDOWS}
    FObjectInstance: Pointer;
    FDefWindowProc: Pointer;
    FWndHandle: HWND;
    procedure MainWndProc(var Message: TMessage);
    procedure UpdateBounds;
{$ENDIF}
    procedure DoResized; override;
    procedure SetParent(const Value: TFmxObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
  end;

implementation

uses System.Types
{$IFDEF MSWINDOWS}, FMX.Platform.Win {$ENDIF}
{$IFDEF MACOS}, Macapi.AppKit, FMX.Platform.Mac {$ENDIF};

constructor TVirtualLayout.Create(AOwner: TComponent);
begin
  inherited;
  FView := TForm.CreateNew(nil);
  FView.BorderStyle := TFmxFormBorderStyle.None;
  FView.Transparency := true;
  FView.Name := 'TOSDWindow';
end;

destructor TVirtualLayout.Destroy();
begin
{$IFDEF MSWINDOWS}
  if FDefWindowProc <> nil then
  begin
    SetWindowLong(FWndHandle, GWL_WNDPROC, IntPtr(FDefWindowProc));
    FDefWindowProc := nil;
  end;
  if FObjectInstance <> nil then
  begin
    FreeObjectInstance(FObjectInstance);
    FObjectInstance := nil;
  end;
{$ENDIF}
  inherited;
end;

{$IFDEF MSWINDOWS}

procedure TVirtualLayout.UpdateBounds;
var
  LForm: TCommonCustomForm;
  R: TRectF;
begin
  if FView.Parent is TCommonCustomForm then
  begin
    LForm := TCommonCustomForm(FView.Parent);
    R := LForm.ClientRect;
    R.Offset(LForm.ClientToScreen(PointF(0, 0)));
    FView.SetBoundsF(R);
  end;
end;

procedure TVirtualLayout.MainWndProc(var Message: TMessage);
begin
  if Root.GetObject is TCommonCustomForm then
  begin
    if Message.Msg = WM_MOVE then
    begin
      UpdateBounds;
    end;
    if (Message.Result = 0) then
      TCommonCustomForm(Root.GetObject).Dispatch(Message);

    with Message do
    begin
      if Result = 0 then
        Result := CallWindowProc(FDefWindowProc, FWndHandle, Msg,
          WParam, LParam);
    end;
  end;
end;
{$ENDIF}

procedure TVirtualLayout.SetParent(const Value: TFmxObject);
begin
  inherited;

{$IFDEF MSWINDOWS}
  FreeObjectInstance(FObjectInstance);
  FObjectInstance := nil;
  DoResized;
{$ENDIF}
end;

procedure TVirtualLayout.DoResized;
var
  LForm: TCommonCustomForm;
{$IFDEF MACOS}
  LVideoView: NSView;
  LFormView: NSView;
  LContext: NSView;
{$ENDIF}
  i: integer;
begin
  inherited;

  if not(csDesigning in ComponentState) and (ParentedVisible) and (Root <> nil)
    and (Root.GetObject is TCommonCustomForm) then
  begin
    for i := ChildrenCount - 1 downto 0 do
      if (Children[i].Name <> '') then
        Children[i].Parent := FView;

    LForm := TCommonCustomForm(Root.GetObject);

    FView.Visible := true;
    FView.StyleBook := LForm.StyleBook;
    FView.OnKeyUp := LForm.OnKeyUp;
    FView.OnKeyDown := LForm.OnKeyDown;
    FView.OnMouseDown := LForm.OnMouseDown;
    FView.OnMouseMove := LForm.OnMouseMove;
    FView.OnMouseUp := LForm.OnMouseUp;
    FView.OnMouseWheel := LForm.OnMouseWheel;

{$IFDEF MACOS}
    LFormView := WindowHandleToPlatform(LForm.Handle).View;
    LVideoView := WindowHandleToPlatform(FView.Handle).View;
    LContext := TNSView.Wrap(WindowHandleToPlatform(LForm.Handle)
      .Wnd.contentView);
    LContext.addSubview(LFormView);
    LContext.addSubview(LVideoView);
{$ENDIF}
{$IFDEF MSWINDOWS}
    if FObjectInstance = nil then
    begin
      FObjectInstance := MakeObjectInstance(MainWndProc);
      if FObjectInstance <> nil then
      begin
        FWndHandle := WindowHandleToPlatform(LForm.Handle).Wnd;
        FDefWindowProc := Pointer(GetWindowLong(FWndHandle, GWL_WNDPROC));
        SetWindowLong(FWndHandle, GWL_WNDPROC, IntPtr(FObjectInstance));
      end;
    end;
{$ENDIF}
  end
  else
  begin
    for i := FView.ChildrenCount - 1 downto 0 do
      if (FView.Children[i].Name <> '') then
        FView.Children[i].Parent := self;

    FView.Parent := nil;

    FView.Visible := false;
  end;
end;

end.

Hi,

I started create a simple media player based on the Windows Media Foundation. I have to deal with DRM encrypted channels so there is unluckily no way around. Did somebody have some experience with the Windows Media Foundation and DRM?

The attached demo is a player using WMF and Firemonkey. The header files used in this project can be found here:

https://github.com/FactoryXCode/MfPack

You should be able to play streams (based on dash and HLS) as well as media files located on the local file system.

It partially crashes here on my vm inside the the d3d11.dll. I did not tested it on a native windows system yet.

The player also uses some "technique" to render firemonkey elements on top of the video.  To do so you just have to put them as child object to the player.

Christian

fmxwmf.zip

I will create a small GitHub repo with those helpers. Especially the Z-Order handling is something I barely miss under MacOS. By removing the contentView and adding it after the other views have been added to the MainView you can easily put the FMX layer to the top.  

Yes, and it works surprisingly well. You just have to execute AppendToForm with your Formular and if you do not want to have a border - since FireMonkey still is unable to render the toolbar with a style under osx - you can set this also to borderless. 

function AppendToForm(const AForm: TForm;const AOpacity: single=1.0;const ABorderLess: Boolean=False): Boolean;
var
  LNSWin: NSWindow;
  LBlurView: NSVisualEffectView;
  LView: NSView;
  LContext: NSView;
begin
  if not TOSVersion.Check(10,10) then
  begin
    result := false;
    exit;
  end;

  AForm.Fill.Kind := TBrushKind.Solid;
  AForm.Fill.Color := 0;

  LNSWin := WindowHandleToPlatform(AForm.Handle).Wnd;
  LContext := WindowHandleToPlatform(AForm.Handle).View;

  LNSWin.setOpaque(false);
  LNSWin.setAlphaValue(AOpacity);

  LBlurView := TNSVisualEffectView.Wrap(
   TNSVisualEffectView.Alloc.initWithFrame(
    MakeNSRect(0,0, AForm.Width, AForm.Height)));
  LBlurView.setWantsLayer(true);
  LBlurView.setBlendingMode(NSVisualEffectBlendingModeBehindWindow);
  LBlurView.setMaterial(NSVisualEffectViewMaterialFullScreenUI);
  LBlurView.setState(NSVisualEffectStateActive);
  LBlurView.setAutoresizingMask(NSViewWidthSizable or NSViewHeightSizable);

  LView := TNSView.Wrap(LNSWin.contentView);

  if ABorderLess then
  begin
   LNSWin.setStyleMask(NSBorderlessWindowMask or NSResizableWindowMask);
   LNSWin.setBackgroundColor(TNSColor.Wrap(TNSColor.OCClass.clearColor));

   LView.setWantsLayer(true);
   LView.layer.setMasksToBounds(true);
   LView.layer.SetCornerRadius(10.0);
  end;

  LContext.removeFromSuperview;
  LView.addSubview(LBlurView);
  LView.addSubview(LContext);

  if GlobalUseMetal then
   WindowHandleToPlatform(AForm.Handle).MTView.layer.setOpaque(false);

  result := true;
end;

I managed to get it working. To do so I had to move the main view to the front and set the background color of the layer to transparent. This works also when UseGlobalMetal is enabled.

Hi,

I currently try to write a fft visualizer (without any third party), but the last time I heard from dft/fft is about 20 years ago. This is what I did from scratch, but the implementation does not seem to be correct. Maybe you have an idea?

unit umain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  bgrabitmap, BGRABitmapTypes, uacinerella;

type
  TSpectrum = (tspWaveform, tspFFT, tspLogarithmic, tsp3d);

  TComplex = record
    re, im: double;
  end;
  TComplexArray = array of TComplex;
  TDoubleArray = array of double;

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FInstance: PAc_instance;
    FInput: TFileStream;
    FAudiodecoder: PAc_decoder;
    FBitmap: TBGRABitmap;
    FSpectrumPalette: array [0 .. 255] of TBGRAPixel;
    FSpectrum: TSpectrum;
    FSpectrumPos: integer;
    FHanningWindow: TComplexArray;
    function ReadProc(Buf: PByte; Size: integer): integer;
    procedure ProcessAudio(Buf: PByte; Size: integer);
    procedure ProcessData();

    procedure CreatePalette;
  public
  end;

var
  Form1: TForm1;

implementation

uses Math;

{$R *.lfm}

function read_proc(Sender: Pointer; buf: PByte; size: integer): integer; cdecl;
begin
  Result := TForm1(Sender).ReadProc(buf, size);
end;

function cInit(const re, im: double): TComplex;
begin
  Result.re := re;
  Result.im := im;
end;

function cadd(const a, b: TComplex): TComplex;
begin
  Result.re := a.re + b.re;
  Result.im := a.im + b.im;
end;

function csub(const a, b: TComplex): TComplex;
begin
  Result.re := a.re - b.re;
  Result.im := a.im - b.im;
end;

function cmul(const a, b: TComplex): TComplex;
begin
  Result.re := a.re * b.re - a.im * b.im;
  Result.im := b.re * a.im + a.re * b.im;
end;

function cabs(const a: TComplex): double;
begin
  Result := sqrt(a.re * a.re + a.im * a.im);
end;

function getBit(const Val: DWord; const BitVal: byte): boolean;
begin
  Result := (Val and (1 shl BitVal)) <> 0;
end;

function enableBit(const Val: DWord; const BitVal: byte; const SetOn: boolean): DWord;
begin
  Result := (Val or Int64(1 shl BitVal)) xor (integer(not SetOn) shl BitVal);
end;

function mirrorTransform(n, m: integer): integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to m - 1 do
    Result := enableBit(Result, m - 1 - i, getBit(n, i));
end;

function doPermutation(Source: TComplexArray; m: integer): TComplexArray;
var
  i, n: integer;
begin
  n := length(Source);
  SetLength(Result, n);

  for i := 0 to n - 1 do
  begin
    Result[i] := Source[mirrorTransform(i, m)];
  end;
end;

function doStep(k, M: longint; prev: TComplexArray): TComplexArray;
var
  expTerm, substractTerm: TComplex;
  q, j, offset: longint;
begin
  offset := system.round(intpower(2, M - k));

  SetLength(Result, length(prev));

  for q := 0 to system.round(intpower(2, k - 1) - 1) do
  begin // For each block of the matrix
    for j := 0 to (offset - 1) do
    begin // Fo each line of this block
      // First half
      Result[q * 2 * offset + j] :=
        cadd(prev[q * 2 * offset + j], prev[q * 2 * offset + j + offset]);
      // Second half
      expTerm.re := cos((j * PI) / offset);
      expTerm.im := sin((j * PI) / offset);
      substractTerm := csub(prev[q * 2 * offset + j], prev[q * 2 * offset + j + offset]);
      Result[q * 2 * offset + j + offset] := cmul(expTerm, substractTerm);
    end;
  end;
end;

function doFFT(g: TComplexArray; order: integer): TComplexArray;
var
  previousRank, nextRank: TComplexArray;
  i: integer;
begin

  previousRank := g;
  for i := 1 to order do
  begin
    nextRank := doStep(i, order, previousRank);
    previousRank := nextRank;
  end;
  Result := doPermutation(nextRank, order);
end;

function WindowHann(const ACount: integer): TComplexArray;
var
  i: integer;
begin
  SetLength(Result, ACount);
  for i := 0 to ACount - 1 do
    Result[i] := cInit(0.5 * (1.0 - cos((2.0 * PI * i) / ACount)), 0);
end;

function CalculateSpectrum(const ASignalWindow, AData: TComplexArray): TDoubleArray;
var
  dftResult, tempData: TComplexArray;
  len: integer;
  i: integer;
begin
  len := length(ASignalWindow);
  SetLength(tempData, len);
  for i := 0 to Len - 1 do
  begin
    if i < len then
      tempData[i] := cmul(AData[i], ASignalWindow[i])
    else
      tempData[i] := cInit(0, 0);
  end;
  dftResult := doFFT(tempData, 10);
  Setlength(result, Length(dftResult));
  for i := 0 to length(result) - 1 do
    result[i] := cabs(dftResult[i]);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
  info: TAc_stream_info;
begin
  FAudiodecoder := nil;
  FInput := TFileStream.Create('Tones_100_20000_incrementing.ac4.trp', fmOpenRead);
  FInstance := ac_init();
  ac_open(FInstance, self, nil, @read_proc, nil, nil, nil);
  for i := 0 to FInstance^.stream_count - 1 do
  begin
    ac_get_stream_info(FInstance, i, @info);
    if info.stream_type = AC_STREAM_TYPE_AUDIO then
    begin
      FAudiodecoder := ac_create_decoder(FInstance, i);
      break;
    end;
  end;
  FBitmap := TBGRABitmap.Create;
  FBitmap.SetSize(640, 480);
  CreatePalette;
  FSpectrum := TSpectrum.tspLogarithmic;
  FHanningWindow := WindowHann(1024);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  while not application.terminated do
  begin
    ProcessData();
    application.ProcessMessages;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ac_free_decoder(FAudiodecoder);
  ac_close(FInstance);
  FInput.Free;
  FBitmap.Free;
end;


procedure TForm1.CreatePalette;
var
  i: integer;
begin
  for i := 1 to 127 do
    with FSpectrumPalette[i] do
    begin
      Alpha := 255;
      Blue := 0;
      Green := 256 - 2 * i;
      Red := 2 * i;
    end;

  for i := 0 to 31 do
  begin
    with FSpectrumPalette[128 + i] do
    begin
      Alpha := 255;
      Red := 0;
      Green := 0;
      Blue := 8 * i;
    end;
    with FSpectrumPalette[128 + 32 + i] do
    begin
      Alpha := 255;
      Red := 8 * i;
      Green := 0;
      Blue := 0;
    end;
    with FSpectrumPalette[128 + 64 + i] do
    begin
      Alpha := 255;
      Red := 255;
      Green := 8 * i;
      Blue := 8 * (31 - i);
    end;
    with FSpectrumPalette[128 + 96 + i] do
    begin
      Alpha := 255;
      Red := 255;
      Green := 255;
      Blue := 8 * i;
    end;
  end;
end;

function TForm1.ReadProc(Buf: PByte; Size: integer): integer;
begin
  Result := FInput.Read(Buf^, Size);
end;

procedure TForm1.ProcessData;
var
  pack: PAc_package;
begin
  if not assigned(FAudioDecoder) then
    exit;
  pack := ac_read_package(FInstance);
  try
    if (pack = nil) or (pack^.stream_index <> FAudiodecoder^.stream_index) then
      exit;
    if (ac_decode_package(pack, FAudiodecoder) > 0) then
      ProcessAudio(FAudiodecoder^.buffer, FAudiodecoder^.buffer_size);
  finally
    ac_free_package(pack);
  end;
end;

procedure TForm1.ProcessAudio(Buf: PByte; Size: integer);

const
  BANDS = 28;

var
  X, Y, Y1, V, B0, B1, SC: integer;
  Sum: single;
  i, z, w: integer;
  Step: integer;
  ptr: PSmallInt;
  signal: TComplexArray;
  fft: array of double;

  function FixRange(const Y: integer): integer;
  begin
    Result := Y * 127 div FBitmap.Height;
  end;

begin
  if Size = 0 then
    exit;

  if FSpectrum <> tsp3d then
   FBitmap.FillTransparent;

  Y := 0;
  X := 0;


  if FSpectrum <> tspWaveForm then
  begin
    ptr := PSmallInt(Buf);
    Step := (Size div 4) div Length(FHanningWindow);
    if Step < 1 then Step := 1;

    SetLength(signal, length(FHanningWindow));
    for i := 0 to high(signal) do
    begin
      signal[i].re := (32768-ptr^)/65536;
      signal[i].im := 0;

      Inc(ptr, step);
    end;
    fft := CalculateSpectrum(FHanningWindow, signal);
  end;

  Step := (Size div 4) div FBitmap.Width;
  if Step < 1 then
    Step := 1;
  ptr := PSmallInt(Buf);

  case FSpectrum of
    tspWaveform:
    begin
      for x := 0 to FBitmap.Width - 1 do
      begin
        V := (32767 - ptr^) * FBitmap.Height div 65536;
        Inc(ptr, step);
        if X = 0 then
          Y := V;
        repeat
          if Y < V then
            Inc(Y)
          else if Y > V then
            Dec(Y);
          FBitmap.SetPixel(X, Y,
            FSpectrumPalette[FixRange(abs(Y - FBitmap.Height div 2) * 2 + 1)]);
        until Y = V;
      end;
    end;
    TSpectrum.tspFFT: // "normal" FFT
    begin
      Y1 := 0;
      for X := 0 to (FBitmap.Width div 2) - 1 do
      begin
        Y := Trunc(sqrt(fft[X + 1]) * 3 * FBitmap.Height - 4);
        if Y > FBitmap.Height then
          Y := FBitmap.Height; // cap it

        Y1 := (Y + Y1) div 2;
        if (X > 0) and (Y1 > 0) then
          // interpolate from previous to make the display smoother
          while (Y1 >= 0) do
          begin
            FBitmap.SetPixel(X * 2 - 1, FBitmap.Height - Y1 - 1,
              FSpectrumPalette[FixRange(Y1 + 1)]);
            Dec(Y1);
          end;

        Y1 := Y;
        while (Y >= 0) do
        begin
          FBitmap.SetPixel(X * 2, FBitmap.Height - Y - 1,
            FSpectrumPalette[FixRange(Y + 1)]);
          // draw level
          Dec(Y);
        end;
      end;
    end;
    TSpectrum.tspLogarithmic: // logarithmic, acumulate & average bins
    begin
      B0 := 0;
      for X := 0 to BANDS - 1 do
      begin
        Sum := 0;
        B1 := Trunc(Power(2, X * 10.0 / (BANDS - 1)));
        if B1 > 1023 then
          B1 := 1023;
        if B1 <= B0 then
          B1 := B0 + 1; // make sure it uses at least 1 FFT bin
        SC := 10 + B1 - B0;

        while B0 < B1 do
        begin
          Sum := Sum + fft[1 + B0];
          Inc(B0);
        end;

        Y := Trunc((sqrt(Sum / log10(SC)) * 1.7 * FBitmap.Height) - 4);
        // scale it
        if Y > FBitmap.Height then
          Y := FBitmap.Height; // cap it

        while (Y >= 0) do
        begin
          w := Trunc(0.9 * (FBitmap.Width / BANDS));
          for z := 0 to w - 1 do
            FBitmap.SetPixel(X * (FBitmap.Width div BANDS) + z, FBitmap.Height - Y - 1,
              FSpectrumPalette[FixRange(Y + 1)]);
          Dec(Y);
        end;
      end;
    end;
    TSpectrum.tsp3d: // "3D"
    begin
      for X := 0 to FBitmap.Height - 1 do
      begin
        Y := Trunc(sqrt(fft[X + 1]) * 3 * FBitmap.Height);
        // scale it (sqrt to make low values more visible)
        if Y > FBitmap.Height then
          Y := FBitmap.Height; // cap it
        if Y < 0 then
          Y := 0;

        if (FSpectrumPos < FBitmap.Width) and (X < FBitmap.Height) then
          FBitmap.SetPixel(FSpectrumPos, X, FSpectrumPalette[128 + FixRange(Y)]);
        // plot it
      end;
      // move marker onto next position
      FSpectrumPos := (FSpectrumPos + 1) mod FBitmap.Width;
      for X := 0 to FBitmap.Height - 1 do
        if (FSpectrumPos < FBitmap.Width) and (X < FBitmap.Height) then
          FBitmap.SetPixel(FSpectrumPos, X, FSpectrumPalette[255]);
    end;
  end;
  Image1.Picture.Assign(FBitmap);
end;

end.

My guess is that the way I fill the complex array with the signal data is not correct. 

Hi,

I wrote a small solution to add this fancy semi transparent background effect supported since a while on MacOS. What I did is to translate the NSVisualEffectView class to Delphi and to write some small code which adds this view to the ContentView. First I thought it works fine, but it does not resize automatically and technically it should be moved to the bottom of the rendered subview, otherwise the view used for the FireMonkey controls is not visible. 

Maybe somebody has an idea how to put this view at the bottom of the view list rendered without adding this code in to the FMX.Platform.Mac. I dislike the idea to mess with the regular FMX units around.

visualeffectview.zip

Hi,

I'm somehow a bit confused about the border style property and the tmenuitem implementation on the Mac. I created a simple plain app with the free calypso style for Mac and Windows. Whilst the border is styled correct under windows it is not under OSX. I tried switching the border.style Boolean on runtime and it affects the form under windows like it should, but on the Mac it does not change anything. I do see the style objects defined in the style book. For the Mac it is named "macborderstyle". However procedure TWindowBorderCocoa.Paint(Ctx: CGContextRef); is never called. Which seem to be executed in frameDrawRect under FMX.Platform.Mac, but this function is also not executed.

The second issue which confuses me is the shortcuts. They should look like this:

But they simply do not show the special characters for Command, Option and Control. 

Does someone has an idea? I currently use Delphi 11 with the latest Update from GetIt.

Christian

Yes of course, I just added the player to explain why I need this in particular. By reading the platform implementation for MacOS I found a solution which should work fine on all platforms:

The public SetBoundsF function which is part of the TCommonCustomForm is executed every time the window moved. 

procedure SetBoundsF(const ALeft, ATop, AWidth, AHeight: Single); override;

Christian

Thanks for the link, but this only works on windows. In this particular case I need it on almost all platforms, starting on a Mac. Frankly using a Timer is not the worst thing, but I hate the idea of polling on a high frequency as well as the fact that even a 1ms interval would have a delay while moving the main window and updating the content. 

Hi,

since this is not working properly since the beginning I thought I try to do the following. A TLayout component which helds a transparent borderless TForm. All the layout children are rendered in the form on run time, while the native control behind stays behind. This works fine, but I got stuck in the issue that if I resize the main form, the position of the transparent form won't be updated. I could solve this by a timer which checks the position in the background but this is not the best idea I guess. I added a small example which plays a video stream and draws a icon over the stream. Maybe somebody has an idea how to achieve this without a timer.

Christian

example.zip

I am not quite happy with the solution, but it works on iOS and MacOS. Android is missing, during the lack of a working device here at the moment, maybe somebody would like to add the Android native Image handling into. 

The idea is to have a TLayout descendant which renders the Firemonkey content into a bitmap and draws this to a native Image View.

What I have so far is the following:

unit UImageLayout;

interface

uses System.Types, System.Classes, FMX.Layouts, FMX.Types
{$IFDEF MACOS}
{$IFDEF IOS}
    , iOSApi.UIKit
{$ELSE}
    , Macapi.AppKit
{$ENDIF}
{$ENDIF};

type
  TImageLayout = class(TLayout)
  private
    FActive: Boolean;
    FLastUpdate: UInt64;
{$IFDEF MACOS}
{$IFDEF IOS}
    FView: UIImageView;
{$ELSE}
    FView: NSImageView;
{$ENDIF}
{$ENDIF}
    procedure SetActive(AValue: Boolean);
  protected
    procedure AfterPaint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Active: Boolean read FActive write SetActive;
  end;

implementation

uses System.SysUtils, FMX.Graphics, FMX.Forms, System.IOUtils
{$IFDEF MACOS}
{$IFDEF IOS}
    , Macapi.Helpers, iOSApi.Foundation, FMX.Platform.iOS
{$ELSE}
    , Macapi.CocoaTypes, FMX.Platform.Mac, FMX.Helpers.Mac
{$ENDIF}
{$ENDIF};

{$IFDEF MACOS}
{$IFDEF IOS}

function BitmapToUIImage(const Bitmap: TBitmap): UIImage;
var
  mem: TMemoryStream;
  Data: NSData;
  TmpImage: UIImage;
  AutoreleasePool: NSAutoreleasePool;
begin
  if Bitmap <> nil then
  begin
    Data := nil;
    TmpImage := nil;
    AutoreleasePool := TNSAutoreleasePool.Create;
    try
      mem := TMemoryStream.Create;
      try
        Bitmap.SaveToStream(mem);
        Data := TNSData.Wrap(TNSData.OCClass.dataWithBytes(mem.Memory,
          mem.size));
        TmpImage := TUIImage.Alloc;
        Result := TUIImage.Wrap(TmpImage.initWithData(Data));
      finally
        mem.Free;
      end;
    finally
      AutoreleasePool.release;
    end;
  end;
end;
{$ENDIF}

function MakeNSRect(const ox, oy, sx, sy: Single): NSRect;
begin
  Result.origin.x := ox;
  Result.origin.y := oy;
  Result.size.width := sx;
  Result.size.height := sy;
end;
{$ENDIF}

function GetParentForm(Control: TFmxObject): TCommonCustomForm;
begin
  if (Control.Root <> nil) and (Control.Root.GetObject is TCommonCustomForm)
  then
    Result := TCommonCustomForm(Control.Root.GetObject)
  else
    Result := nil;
end;

{ TImageLayout }

constructor TImageLayout.Create(AOwner: TComponent);
begin
  inherited;
end;

destructor TImageLayout.Destroy;
begin
  Active := false;
  inherited;
end;

procedure TImageLayout.AfterPaint;
var
  LBitmap: TBitmap;
{$IFDEF MACOS}
  LBounds: TRectF;
  Form: TCommonCustomForm;
{$ENDIF}
begin
  inherited;
  if (not Active) then
    exit;

  if TThread.GetTickCount64 - FLastUpdate < 100 then
    exit;
  FLastUpdate := TThread.GetTickCount64;

{$IFDEF MACOS}
  if assigned(FView) then
  begin
    LBounds := GetAbsoluteRect;
    Form := GetParentForm(self);

    if assigned(Form) then
      FView.setFrame(MakeNSRect(LBounds.Left, Form.ClientHeight -
        LBounds.Bottom, LBounds.width, LBounds.height));
  end;
{$ENDIF}
  LBitmap := TBitmap.Create(Trunc(width), Trunc(height));
  try
    if LBitmap.Canvas.BeginScene then
    begin
      LBitmap.Canvas.Clear(0);
      PaintTo(LBitmap.Canvas, LBitmap.BoundsF);

      LBitmap.Canvas.EndScene;
      //LBitmap.SaveToFile(TPath.Combine(TPath.GetDocumentsPath, 'test.png'));
{$IFDEF MACOS}
{$IFDEF IOS}
      FView.setAlpha(AbsoluteOpacity);
      FView.setImage(BitmapToUIImage(LBitmap));
{$ELSE}
      FView.setAlphaValue(AbsoluteOpacity);
      FView.setImage(BitmapToMacBitmap(LBitmap));
{$ENDIF}
{$ENDIF}
    end;
  finally
    LBitmap.Free;
  end;
end;

procedure TImageLayout.SetActive(AValue: Boolean);
{$IFDEF MACOS}
var
  LBounds: TRectF;
  Form: TCommonCustomForm;
{$IFDEF IOS}
  FormView: UIView;
{$ELSE}
  FormView: NSView;
{$ENDIF}
{$ENDIF}
begin
  if AValue <> Active then
  begin
{$IFDEF MACOS}
    LBounds := AbsoluteRect;
    Form := GetParentForm(self);

    if (AValue) and (not assigned(FView)) and (assigned(Form)) then
    begin
{$IFDEF IOS}
      FView := TUIImageView.Wrap(TUIImageView.Alloc.initWithFrame
        (MakeNSRect(LBounds.Left, Form.ClientHeight - LBounds.Bottom,
        LBounds.width, LBounds.height)));

      FView.retain;

      FormView := TUIView.Wrap
        (NSObjectToID(WindowHandleToPlatform(Form.Handle).View));
      FormView.addSubview(FView);
{$ELSE}
      FView := TNSImageView.Wrap(TNSImageView.Alloc.initWithFrame
        (MakeNSRect(LBounds.Left, Form.ClientHeight - LBounds.Bottom,
        LBounds.width, LBounds.height)));
      FView.retain;
      FView.setWantsLayer(true);

      FormView := TNSView.Wrap(WindowHandleToPlatform(Form.Handle)
        .Wnd.contentView);
      FormView.addSubview(FView, NSWindowAbove, nil);
{$ENDIF}
    end;
    if assigned(FView) then
      FView.setHidden(not AValue) else
      AValue := false;
{$ENDIF}
    FActive := AValue;
  end;
end;

end.

Hi,

i am wondering if there is an elegant way to draw over a native control like the Media player or Webbrowser under mobile platforms resp. MacOS. In my case I have to use AVPlayerItemVideoOutput because the content is DRM protected and I can not get the surface texture in order to paint it to the screen, embedded in Firemonkey controls. My solution is to render the FireMonkey output into a bitmap and to draw it on a NSImageView Layer which is on top. This is slow as hell and I wonder how it can be achieved in a better way than using an image. 

Christian 

Sure, 

sorry for the delay - I just forgot to post it here.

You have to update the FMX.Media.Mac resp. IOS in the following way:

constructor TMacMedia.Create(const AFileName: string);
var
  LURL: NSUrl;
  LAbsoluteFileName: string;
  LAsset: AVURLAsset;
begin
  inherited Create(AFileName);
  AVMediaTypeAudio; // Force load the framework
  if FileExists(FileName) then
  begin
    if ExtractFilePath(FileName).IsEmpty then
      LAbsoluteFileName := TPath.Combine(TPath.GetHomePath, FileName)
    else
      LAbsoluteFileName := FileName;
    LURL := TNSUrl.Wrap(TNSUrl.OCClass.fileURLWithPath(StrToNSStr(LAbsoluteFileName)));
  end
  else
    LURL := StrToNSUrl(FileName);
  if LURL = nil then
    raise EFileNotFoundException.Create(SSpecifiedFileNotFound);
  FPixelBufferBitmap := TBitmap.Create;
  LAsset := TAVURLAsset.Wrap(TAVURLAsset.OCClass.URLAssetWithURL(LURL, nil));
  if LAsset.hasProtectedContent then
   ContentKeyManager.addContentKeyRecipient(LAsset);

  FPlayerItem := TAVPlayerItem.Wrap(TAVPlayerItem.OCClass.playerItemWithAsset(LAsset));
  FPlayerItem.retain;
  FPlayer := TAVPlayer.Wrap(TAVPlayer.OCClass.playerWithPlayerItem(FPlayerItem));
  FPlayer.retain;
  FPlayerLayer := TAVPlayerLayer.Wrap(TAVPlayerLayer.OCClass.playerLayerWithPlayer(FPlayer));
  FPlayerLayer.retain;
  FPlayerLayer.setVideoGravity(CocoaNSStringConst(libAVFoundation, 'AVLayerVideoGravityResizeAspectFill'));
  FPlayerLayer.setAutoresizingMask(kCALayerWidthSizable or kCALayerHeightSizable);
  FVideoView := TNSView.Create;
  FVideoView.retain;
  FVideoView.setWantsLayer(True);
  FVideoView.layer.addSublayer(FPlayerLayer);
  SetupVideoOutput;
end;

The ContentKeyManager needs two callbacks which could look like this:

procedure TfrmMain.DoGetCertificate(Sender: TObject; ACert: TMemoryStream);
var
  http: THTTPClient;
begin
  http := THTTPClient.create;
  try
    http.ContentType := 'application/octet-stream';
    http.Get(FAIRLPLAY_SERVER_URL, ACert);
  finally
    http.Free;
  end;
end;

procedure TfrmMain.DoRequestContentKey(Sender: TObject;
  ARequest, AResponse: TMemoryStream);
var
  http: THTTPClient;
begin
  http := THTTPClient.create;
  try
    ARequest.Position := 0;
    http.ContentType := 'application/octet-stream';
    http.Post(LS_SERVER_URL, ARequest, AResponse);
  finally
    http.Free;
  end;
end;

First Fairplay asks for the certificate and returns a request to the license server which should be send as post command. In return it delivers some binary data which is the key to decode the stream.

I made an "example" screenshot with a test server here. The annoying thing is that DRM content does not allow to play the video in a texture. If you start to use copyPixelBufferForItemTime in order to get the video content audio and video playback stops (without any notification). I was thinking about how to put some alpha blended NSView or UIView on top which contain the buttons and other things. One of my projects involves a media player on Android, iOS and MacOS (using Metal). It heavily uses Metal and OpenGL for the output and the video view is drawn over it (using regular firemonkey controls). Maybe you have an idea? 

By default the video is shown on the top right and some ui is drawn above. In fullscreen the video is in the background and the rest of the context is shown in front. You can imagine what happen if DRM is involved. You only see the image, but the ui is hidden.

Christian

UFairplay.pas.zip

Thanks, the whole translation from this:

func requestApplicationCertificate() throws -> Data {
        
        print("requestApplicationCertificate called")
        // MARK: ADAPT - You must implement this method to retrieve your FPS application certificate.
        var certificateData: Data? = nil
        
        let request = NSMutableURLRequest(url: URL(string: DNSRestServices.DNS_FAIRLPLAY_SERVER_URL)!)
        request.httpMethod = "POST"
        request.cachePolicy = NSURLRequest.CachePolicy.reloadIgnoringCacheData
        request.setValue("application/octet-stream", forHTTPHeaderField: "Content-Type")
        
        let semaphore = DispatchSemaphore(value: 0)
        
        URLSession.shared.dataTask(with: request as URLRequest) { (responseData, _, error) -> Void in
            certificateData = responseData
            semaphore.signal()
            }.resume()
        
        semaphore.wait(timeout: .distantFuture)
        
        guard certificateData != nil else {
            throw ProgramError.missingApplicationCertificate
        }
        
        return certificateData!
    }

func requestContentKeyFromKeySecurityModule(spcData: Data, assetID: String) throws -> Data {
        
        var ckcData: Data? = nil
        
        var licenseURL : String?
        licenseURL = DispatchQueue.main.sync {
            var licenseURLForSelectedChannel = ""
            if let keyWindow = UIWindow.key {
                let menuViewController = keyWindow.rootViewController as! MenuSplitViewController
                let playerController = menuViewController.viewControllers[1] as! DNSPlayerViewController
                licenseURLForSelectedChannel = playerController.licenseURLForSelectedChannel() ?? ""
            }
            return licenseURLForSelectedChannel
        }
        
        
 
        guard licenseURL != nil else {
            throw ProgramError.missingLicenseURL
        }
        
        
        guard let url = URL(string: licenseURLString) else {
            print("Error! Invalid URL!") //Do something else
            throw ProgramError.missingLicenseURL
        }
        
        let request = NSMutableURLRequest(url: url)
        request.httpMethod = "POST"
        request.cachePolicy = NSURLRequest.CachePolicy.reloadIgnoringCacheData
        request.httpBody = spcData
        let postLength:NSString =  NSString(data: spcData, encoding:String.Encoding.ascii.rawValue)!
        request.setValue(String(postLength.length), forHTTPHeaderField: "Content-Length")
        request.setValue("application/octet-stream", forHTTPHeaderField: "Content-Type")
        
        let semaphore = DispatchSemaphore(value: 0)
        
        URLSession.shared.dataTask(with: request as URLRequest) { (responseData, _, error) -> Void in
            ckcData = responseData
            semaphore.signal()
            }.resume()
        
        semaphore.wait(timeout: .distantFuture)
        
        
        guard ckcData != nil else {
            throw ProgramError.noCKCReturnedByKSM
        }
        
        return ckcData!
    }

func handleStreamingContentKeyRequest(keyRequest: AVContentKeyRequest) {
        guard let contentKeyIdentifierString = keyRequest.identifier as? String,
            let contentKeyIdentifierURL = URL(string: contentKeyIdentifierString),
            let assetIDString = contentKeyIdentifierURL.host,
            let assetIDData = assetIDString.data(using: .utf8)
            else {
                print("Failed to retrieve the assetID from the keyRequest!")
                return
        }

        let provideOnlinekey: () -> Void = { () -> Void in

            do {
                let applicationCertificate = try self.requestApplicationCertificate()

                let completionHandler = { [weak self] (spcData: Data?, error: Error?) in
                    guard let strongSelf = self else { return }
                    if let error = error {
                        keyRequest.processContentKeyResponseError(error)
                        return
                    }

                    guard let spcData = spcData else { return }

                    do {
                        // Send SPC to Key Server and obtain CKC
                        let ckcData = try strongSelf.requestContentKeyFromKeySecurityModule(spcData: spcData, assetID: assetIDString)

                        /*
                         AVContentKeyResponse is used to represent the data returned from the key server when requesting a key for
                         decrypting content.
                         */
                        let keyResponse = AVContentKeyResponse(fairPlayStreamingKeyResponseData: ckcData)

                        /*
                         Provide the content key response to make protected content available for processing.
                         */
                        keyRequest.processContentKeyResponse(keyResponse)
                    } catch {
                        keyRequest.processContentKeyResponseError(error)
                    }
                }

                keyRequest.makeStreamingContentKeyRequestData(forApp: applicationCertificate,
                                                              contentIdentifier: assetIDData,
                                                              options: [AVContentKeyRequestProtocolVersionsKey: [1]],
                                                              completionHandler: completionHandler)
            } catch {
                keyRequest.processContentKeyResponseError(error)
            }
        }
        
        provideOnlinekey()
    }
}