CHackbart

Hi, i am a bit clueless. All the buttons on the remote are not detected, except the cursor keys. My code is quite simple: protected procedure IsDialogKey(const Key: Word; const KeyChar: WideChar; const Shift: TShiftState; var IsDialog: Boolean); override; public ... procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState); begin SendKey(Key, KeyChar); end; procedure TForm1.IsDialogKey(const Key: Word; const KeyChar: WideChar; const Shift: TShiftState; var IsDialog: Boolean); begin SendKey(Key, KeyChar); inherited; end; procedure TForm1.SendKey(const AKey: Word; const AKeyChar: WideChar); begin Label1.Text := format('%d - %s (%d)', [AKey, AKeyChar, ord(AKeyChar)]); end; The form only has a Label. I got a IsDialogKey event triggered when pressing, but Key and AKeyChar are 0 in every case - except when the cursor keys are pressed. Does someone have an idea? When I set a breakpoint at function TAndroidTextInputManager.HandleAndroidKeyEvent(AEvent: PAInputEvent): Int32; I see that my keys are detected well, but got lost in PlatformKeyToVirtualKey *wth*. I have to register all keys which are available for this certain platform. Christian

const DefaultKeys: Array [0 .. 284] of integer = ( (* soft_left *) 1, (* soft_right *) 2, (* home *) 3, (* back *) 4, (* call *) 5, (* endcall *) 6, (* 0 *) 7, (* 1 *) 8, (* 2 *) 9, (* 3 *) 10, (* 4 *) 11, (* 5 *) 12, (* 6 *) 13, (* 7 *) 14, (* 8 *) 15, (* 9 *) 16, (* star *) 17, (* pound *) 18, (* dpad_up *) 19, (* dpad_down *) 20, (* dpad_left *) 21, (* dpad_right *) 22, (* dpad_center *) 23, (* volume_up *) 24, (* volume_down *) 25, (* power *) 26, (* camera *) 27, (* clear *) 28, (* a *) 29, (* b *) 30, (* c *) 31, (* d *) 32, (* e *) 33, (* f *) 34, (* g *) 35, (* h *) 36, (* i *) 37, (* j *) 38, (* k *) 39, (* l *) 40, (* m *) 41, (* n *) 42, (* o *) 43, (* p *) 44, (* q *) 45, (* r *) 46, (* s *) 47, (* t *) 48, (* u *) 49, (* v *) 50, (* w *) 51, (* x *) 52, (* y *) 53, (* z *) 54, (* comma *) 55, (* period *) 56, (* alt_left *) 57, (* alt_right *) 58, (* shift_left *) 59, (* shift_right *) 60, (* tab *) 61, (* space *) 62, (* sym *) 63, (* explorer *) 64, (* envelope *) 65, (* enter *) 66, (* del *) 67, (* grave *) 68, (* minus *) 69, (* equals *) 70, (* left_bracket *) 71, (* right_bracket *) 72, (* backslash *) 73, (* semicolon *) 74, (* apostrophe *) 75, (* slash *) 76, (* at *) 77, (* num *) 78, (* headsethook *) 79, (* focus *) 80, (* plus *) 81, (* menu *) 82, (* notification *) 83, (* search *) 84, (* media_play_pause *) 85, (* media_stop *) 86, (* media_next *) 87, (* media_previous *) 88, (* media_rewind *) 89, (* media_fast_forward *) 90, (* mute *) 91, (* page_up *) 92, (* page_down *) 93, (* pictsymbols *) 94, (* switch_charset *) 95, (* button_a *) 96, (* button_b *) 97, (* button_c *) 98, (* button_x *) 99, (* button_y *) 100, (* button_z *) 101, (* button_l1 *) 102, (* button_r1 *) 103, (* button_l2 *) 104, (* button_r2 *) 105, (* button_thumbl *) 106, (* button_thumbr *) 107, (* button_start *) 108, (* button_select *) 109, (* button_mode *) 110, (* escape *) 111, (* forward_del *) 112, (* ctrl_left *) 113, (* ctrl_right *) 114, (* caps_lock *) 115, (* scroll_lock *) 116, (* meta_left *) 117, (* meta_right *) 118, (* function *) 119, (* sysrq *) 120, (* break *) 121, (* move_home *) 122, (* move_end *) 123, (* insert *) 124, (* forward *) 125, (* media_play *) 126, (* media_pause *) 127, (* media_close *) 128, (* media_eject *) 129, (* media_record *) 130, (* f1 *) 131, (* f2 *) 132, (* f3 *) 133, (* f4 *) 134, (* f5 *) 135, (* f6 *) 136, (* f7 *) 137, (* f8 *) 138, (* f9 *) 139, (* f10 *) 140, (* f11 *) 141, (* f12 *) 142, (* num_lock *) 143, (* numpad_0 *) 144, (* numpad_1 *) 145, (* numpad_2 *) 146, (* numpad_3 *) 147, (* numpad_4 *) 148, (* numpad_5 *) 149, (* numpad_6 *) 150, (* numpad_7 *) 151, (* numpad_8 *) 152, (* numpad_9 *) 153, (* numpad_divide *) 154, (* numpad_multiply *) 155, (* numpad_subtract *) 156, (* numpad_add *) 157, (* numpad_dot *) 158, (* numpad_comma *) 159, (* numpad_enter *) 160, (* numpad_equals *) 161, (* numpad_left_paren *) 162, (* numpad_right_paren *) 163, (* volume_mute *) 164, (* info *) 165, (* channel_up *) 166, (* channel_down *) 167, (* zoom_in *) 168, (* zoom_out *) 169, (* tv *) 170, (* window *) 171, (* guide *) 172, (* dvr *) 173, (* bookmark *) 174, (* captions *) 175, (* settings *) 176, (* tv_power *) 177, (* tv_input *) 178, (* stb_power *) 179, (* stb_input *) 180, (* avr_power *) 181, (* avr_input *) 182, (* prog_red *) 183, (* prog_green *) 184, (* prog_yellow *) 185, (* prog_blue *) 186, (* app_switch *) 187, (* button_1 *) 188, (* button_2 *) 189, (* button_3 *) 190, (* button_4 *) 191, (* button_5 *) 192, (* button_6 *) 193, (* button_7 *) 194, (* button_8 *) 195, (* button_9 *) 196, (* button_10 *) 197, (* button_11 *) 198, (* button_12 *) 199, (* button_13 *) 200, (* button_14 *) 201, (* button_15 *) 202, (* button_16 *) 203, (* language_switch *) 204, (* manner_mode *) 205, (* 3d_mode *) 206, (* contacts *) 207, (* calendar *) 208, (* music *) 209, (* calculator *) 210, (* zenkaku_hankaku *) 211, (* eisu *) 212, (* muhenkan *) 213, (* henkan *) 214, (* katakana_hiragana *) 215, (* yen *) 216, (* ro *) 217, (* kana *) 218, (* assist *) 219, (* brightness_down *) 220, (* brightness_up *) 221, (* media_audio_track *) 222, (* sleep *) 223, (* wakeup *) 224, (* pairing *) 225, (* media_top_menu *) 226, (* 11 *) 227, (* 12 *) 228, (* last_channel *) 229, (* tv_data_service *) 230, (* voice_assist *) 231, (* tv_radio_service *) 232, (* tv_teletext *) 233, (* tv_number_entry *) 234, (* tv_terrestrial_analog *) 235, (* tv_terrestrial_digital *) 236, (* tv_satellite *) 237, (* tv_satellite_bs *) 238, (* tv_satellite_cs *) 239, (* tv_satellite_service *) 240, (* tv_network *) 241, (* tv_antenna_cable *) 242, (* tv_input_hdmi_1 *) 243, (* tv_input_hdmi_2 *) 244, (* tv_input_hdmi_3 *) 245, (* tv_input_hdmi_4 *) 246, (* tv_input_composite_1 *) 247, (* tv_input_composite_2 *) 248, (* tv_input_component_1 *) 249, (* tv_input_component_2 *) 250, (* tv_input_vga_1 *) 251, (* tv_audio_description *) 252, (* tv_audio_description_mix_up *) 253, (* tv_audio_description_mix_down *) 254, (* tv_zoom_mode *) 255, (* tv_contents_menu *) 256, (* tv_media_context_menu *) 257, (* tv_timer_programming *) 258, (* help *) 259, (* navigate_previous *) 260, (* navigate_next *) 261, (* navigate_in *) 262, (* navigate_out *) 263, (* stem_primary *) 264, (* stem_1 *) 265, (* stem_2 *) 266, (* stem_3 *) 267, (* dpad_up_left *) 268, (* dpad_down_left *) 269, (* dpad_up_right *) 270, (* dpad_down_right *) 271, (* media_skip_forward *) 272, (* media_skip_backward *) 273, (* media_step_forward *) 274, (* media_step_backward *) 275, (* soft_sleep *) 276, (* cut *) 277, (* copy *) 278, (* paste *) 279, (* system_navigation_up *) 280, (* system_navigation_down *) 281, (* system_navigation_left *) 282, (* system_navigation_right *) 283, (* all_apps *) 284, (* refresh *) 285); .. if TPlatformServices.Current.SupportsPlatformService(IFMXKeyMappingService, KeyMappingService) then begin for i := 0 to high(DefaultKeys) do KeyMappingService.RegisterKeyMapping(DefaultKeys[i], DefaultKeys[i], TKeyKind.Usual); end; Thanks, I use the code above which seem to work fine with the remotes.

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

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, 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

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, 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

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.

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 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

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

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.

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.

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'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

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

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, 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

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'm not sure if I did something wrong, but it is nearly impossible to debug - since the application is crashing without any further error message after providing the necessary information to the AVContentKeySession. Apples documentation is also quite rudimentary when it comes to proper handling of DRM content. In theory you create a content key session: FContentKeySession := TAVContentKeySession.Wrap(TAVContentKeySession.OCClass.contentKeySessionWithKeySystem (AVContentKeySystemFairPlayStreaming)); // FairPlayStreaming Next you implement your own implementation of AVContentKeySessionDelegate which handles receiving the certificate and key for your stream you want to play back. I first accidentally made a stupid mistake in not adding the Methodnames to its methods, but that's I think not the issue in my case now. When you now intend to play a content encrypted stream, according to apple, you have to open an AVUrlAsset, like: aURL := TNSUrl.Wrap(TNSUrl.OCClass.URLWithString(StrToNSStr(url))); FAsset := TAVURLAsset.Wrap(TAVURLAsset.OCClass.URLAssetWithURL(aURL, nil)); AVURLAsset has a property named hasProtectedContent which is true, when the stream is encrypted. In this case all you have to do is to provide recipient which provided the DRM key with a call named addContentKeyRecipient: FContentKeySession.addContentKeyRecipient(FAsset); The problem I have now is that when I provide my receiver asset to the AVContentKeySession the application terminates immediately. My work around, In order to get at least a system report, is to put the routine in a separate task via. rocedure TfrmMain.FormActivate(Sender: TObject); begin onactivate := nil; TTask.Create( procedure() var url: string; aURL: NSUrl; begin url := 'http://delphiworlds.s3-us-west-2.amazonaws.com/kastri-sponsor-video.mp4'; aURL := TNSUrl.Wrap(TNSUrl.OCClass.URLWithString(StrToNSStr(url))); FAsset := TAVURLAsset.Wrap(TAVURLAsset.OCClass.URLAssetWithURL (aURL, nil)); FAsset.retain; // if FAsset.hasProtectedContent then FContentKeySession.addContentKeyRecipient(FAsset); end).Start; end; The report then shows at least a bit information: Crashed Thread: 0 Dispatch queue: com.apple.main-thread Exception Type: EXC_CRASH (SIGABRT) Exception Codes: 0x0000000000000000, 0x0000000000000000 Exception Note: EXC_CORPSE_NOTIFY External Modification Warnings: Debugger attached to process. Application Specific Information: dyld: in dlopen() abort() called terminating with uncaught foreign exception Does someone has an idea what the reason for this behavior might be? example.zip

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