Rusland

Вместо утреннего кофе, уперся рогом и сделал получение информации через CUDA, тесовый проект прилагаю.
В режиме отладки работает отлично, вижу размер видеопамяти, но потом вылетает с access violation (при обращении к визуальным компонентам или просто при продолжении работы). В чем дело понять не могу, сначала грешил на FMX, но проект на VCL выдает те же симптомы. Очень, очень странные дела...
Код простой, используется cudaRT.pas из CUDA wraper Паскуда https://code.google.com/archive/p/pascuda/source/default/source и cudart32_65.dll идущая вместе с драйверами NVIDIA
Var CudaDeviceProp : TCudaDeviceProp; hDevice: Integer; GPUMemorySize : Cardinal; LMessage : String; begin hDevice:=0; if CudaGetDeviceProperties(CudaDeviceProp, hDevice)=ceSuccess then begin GPUMemorySize:=CudaDeviceProp.TotalGlobalMem div 1024 div 1024; LMessage:=Format('GPU Memory size = %d Mb', [GPUMemorySize]); Memo.Lines.Add(LMessage); end;  
test099 Cuda Info VCL.7z

Периодически членам партии в пушах присылать призывы поддержать материально (из своего кармана) какое-нибудь благое начинание типа скинуться на: ремонт дороги, школы, больницы...

Проблема решена - приложение в Апп сторе.
Опишу как решил.
Конфигурация - Berlin 10.1 - update 2, Xcode 8.
Datasnap сервер, использую tcpIp.
Компоненты на клиенте TSqlConnection - для Datasnap, TIdTcpClient - использую для проверки соединения перед открытием ДатаСнар соединения, т.к. в нем не работает ТаймОут и есть вероятность "залипнуть"
Сервер так и остался в ИП4  ( вначале хотел перевести его в ип6, но провайдер МТС ответил, что такие адреса не дает, сделал туннель с tunnelbroker.net  на тестовый сервер, но так и не пригодилось ( кстати бесплатно, но без гарантии пропускной способности)  .
Никаких квадратных скобок , если у вас имена хостов а не ИП адреса не нужны.
Смысл простой - у обоих компонентов нужно выставить свойства протоколов в зависимости от сети нахождения клиента.
Вначале ставлю у обоих ИПв4, если коннект ексептиться - то ставлю ипв6 и еще раз пробую коннектится. и только второй ексепт скажет, что сети действительно нет.
function TClientModule1.gethost(aHost : string):string; var dbxProps: TDBXDatasnapProperties; begin try TabbedForm.HostDS := TabbedForm.Host4; TabbedForm.HostP := TabbedForm.Host4; // ставим все в ип4 IdTCPClient1.IPVersion := TIdIpVersion.Id_IPv4; IdTCPClient1.Host:=TabbedForm.Host4; IdTCPClient1.Port:=StrToInt(TabbedForm.port); //порт сервера DataSnap idTCPClient1.ConnectTimeout := 12000; //заданный тайм-аут Assert(SQLConnection1.DriverName = 'DataSnap', 'Driver must be DataSnap'); dbxProps := SQLConnection1.ConnectionData.Properties as TDBXDatasnapProperties; dbxProps.CommunicationProtocol := 'tcp/ip'; dbxProps.CommunicationIPVersion := 'IP_IPv4'; IdTCPClient1.Connect; if IdTCPClient1.Connected then begin //подключились result:=TabbedForm.Host4; TabbedForm.HostDS := TabbedForm.Host4; TabbedForm.HostP := TabbedForm.Host4; IdTCPClient1.Disconnect; end; except on E: Exception do begin //toast ('IPv4 except '+E.Message); try IdTCPClient1.IPVersion := TIdIpVersion.Id_IPv6; IdTCPClient1.Host:= TabbedForm.Host6P; IdTCPClient1.Port:=StrToInt(TabbedForm.port); //порт сервера DataSnap idTCPClient1.ConnectTimeout := 12000; //заданный тайм-аут IdTCPClient1.Connect; if IdTCPClient1.Connected then begin //подключились result:=TabbedForm.Host6DS; TabbedForm.HostDS := TabbedForm.Host6DS; TabbedForm.HostP := TabbedForm.Host6P; IdTCPClient1.Disconnect; dbxProps.CommunicationIPVersion := 'IP_IPv6'; end; except on E: Exception do begin //не подключились result:='Не подключились'; dbxProps.CommunicationIPVersion := 'IP_IPv4'; IdTCPClient1.IPVersion := TIdIpVersion.Id_IPv4; TabbedForm.HostDS := TabbedForm.Host4; TabbedForm.HostP := TabbedForm.Host4; end; end; end; end; Тут немного есть излишества кода - думал что для Ип4 и Ип6 будут разные имена хостов, но сейчас это одно и тоже имя Сервера  который находится в Ип4 и не имеет ни выхода ни адреса в ип6.
вызвав эту фунцию я заполняю глобальные переменные  ( ds- датаснап сервер. P- для пробного открытия ("пинг" )) на самом деле они тоже одинаковые.
клиента проверял, как описано http://www.brianjcoleman.com/tutorial-how-to-test-your-app-for-ipv6-compatibility/
т.е. макбук подключен через 3ж модем в сеть и через WiFi раздает ИпВ6 сеть и Айфон к ней  присоединен. Если приложение работает в этой внутренней ипв6 сети, то все - проблема решена - Аппле именно так и проверяет.
 
 

Периодически членам партии в пушах присылать призывы поддержать материально (из своего кармана) какое-нибудь благое начинание типа скинуться на: ремонт дороги, школы, больницы...

Периодически членам партии в пушах присылать призывы поддержать материально (из своего кармана) какое-нибудь благое начинание типа скинуться на: ремонт дороги, школы, больницы...

Периодически членам партии в пушах присылать призывы поддержать материально (из своего кармана) какое-нибудь благое начинание типа скинуться на: ремонт дороги, школы, больницы...

Многократное щёлканье получилось вот так.
В объявлении класса:
#ifdef __ANDROID__ _di_JAudioTrack audioTrack; TJavaArray__1<short>* samples; #endif В конструкторе:
#ifdef __ANDROID__ samples = new TJavaArray__1<short>(1); samples->Items[0] = 0x0FFF; audioTrack = TJAudioTrack::JavaClass->init(TJAudioManager::JavaClass->STREAM_MUSIC, 11025, TJAudioFormat::JavaClass->CHANNEL_OUT_MONO, TJAudioFormat::JavaClass->ENCODING_PCM_16BIT, TJAudioTrack::JavaClass->getMinBufferSize(11025, TJAudioFormat::JavaClass->CHANNEL_OUT_MONO, TJAudioFormat::JavaClass->ENCODING_PCM_16BIT), TJAudioTrack::JavaClass->MODE_STREAM); #endif На событие:
#ifdef __ANDROID__ audioTrack->write(samples, 0, 1); audioTrack->play(); audioTrack->stop(); #endif В деструкторе:
#ifdef __ANDROID__ delete samples; #endif  

[ОФФТОП] Интересно, а как метод ExtractAll должен поступать в случае, если в нескольких поддиректориях лежат файлы с одинаковыми именами? (Выберите верный вариант)
В тихую перезаписывать (в конечном итоге оставляя одну версию файла, да еще непонятно какую) Останавливаться (возможно с выбросом ошибки или исключения) Долбать пользователя запросами (дергая какое-нибудь событие) P.S.
выбрав вариант, предложите разработчикам "допилить" этот (метод | класс | компонент).

Во время добавления так же можно отключить обработчики  ListView1.OnUpdatingObjects и(или) ListView1.OnUpdateObject (если у вас в них есть какой либо код).
ListView1.BeginUpdate; ListView1.OnUpdatingObjects:=Nil; ListView1.OnUpdateObjects:=Nil; for i := 0 to List.Count - 1 do begin LVItems := ListView1.Items.Add; LVItems.Data['MyData']:=... ... end; ListView1.OnUpdatingObjects:=ListView1UpdateObjects; ListView1.OnUpdateObjects:=ListView1UpdatingObjects; ListView1.EndUpdate;  

function FileSize(const aFilePath: string): Int64; var   vSR : TSearchRec; begin   if FindFirst(aFilePath, faAnyFile, vSR ) = 0 then   begin     Result := vSR.Size;     FindClose(vSR);   end   else      Result := -1; end; Мультиплатформенный вариант без открытия файла (размер берется из файловой системы).

DisposeOf не освобождает память, а просто вызывает деструктор.
Можно не использовать его, а использовать обычный Close с TCloseAction.caFree.
Я проверял на мобильном компиляторе (Android) - все уничтожается корректно, срабатывает деструктор формы.
Обязательно создавать надо форму с Owner nil, иначе форма не уничтожится. 
frmLoading := TfrmLoading.Create(nil); frmLoading.Show; //В форме: procedure TfrmLoading.FormClose(Sender: TObject; var Action: TCloseAction); begin   Action := TCloseAction.caFree; end; //Уничтожаем: frmLoading.Close; frmLoading := nil;  
Если на ARC компиляторах вместо Close, вызвать FreeAndNil(frmLoading)  - форма не уничтожится и останется видимой.

Можно еще сокращенный вариант, без объявления TStringStream;
 Get возвращает IHTTPResponse . Там есть и StatusCode и ContentAsString.
Напомню, переменные тип которых начинаются с буквы I (Interface), как IHTTPResponse не нужно уничтожать, они самоуничтожаются при выходе из процедуры.
uses System.Net.HttpClient; with THTTPClient.Create do try  Result := Get(vURL).StatusCode = ADDED_TO_DB; finally   Free; end;  
Также в этом теме описано как отправить файл.
 

Огромное спасибо Равиль! Как хорошо что вы помогаете.
Итак для тех кто не знает, в TListView есть режим DynamicAppearance , который позволяет добавлять предустановленные элементы - картинки, текст, GlyphButon. В хелпе  написано что их может быть любое количество.
Итак добавляем TListView, в панели Structure  выбираем TListView > ItemAppearance > Item.
В инспекторе объектов выбрать свойство Appearance и  комбобоксе Dynamic Appearance. Рядом в инспекторе появится свойство Objects - нажать на него и там уже добавляем нужные поля. Там же можно переименовать поле, в AppearanceObjectName чтобы позже использовать в RunTime. У меня периодически на этих этапах вылетает Catastrophic Failure и среду приходится терминировать с диспетчера (Berlin Update 2).
Дальше, жмем правой кнопкой мыши по ListView и выбираем Toggle Design Mode, где можно увидеть эти добавленные Custom поля и расставить их мышкой и указать выравнивание.
Это имя затем можно использовать в Runtime, для картинки это индекс в ImageList, который нужно указать в ListView  таким образом (за это еще раз спасибо Равилю! :), почему это сделали так неочевидно и почему это не указано в мануале, остается загадкой.. 
Для TImageObjectAppearance с именем Star - 
ListView1.Items.Add.Data['Star'] := Integer(1);
Например заполняем список с картинками с индексами 0 и 1:
procedure TForm5.FormShow(Sender: TObject); var   I: Integer; begin   for I := 0 to 9 do   begin     with ListView1.Items.Add do     begin       Text := 'Item ' + I.ToString;       Data['Star'] := Integer(I mod 2 = 0);     end;   end; end; Переключаем с картинки с индексом 1 на 0 и наоборот. procedure TForm5.ListView1ItemClick(const Sender: TObject; const AItem: TListViewItem); begin   AItem.Data['Star'] := AItem.Data['Star'].AsInteger xor 1; end ;
 
 
 

как-то так, но это наверное сложно для понимания)
LVStars.rar

да, T(Net)HTTPClient как раз и работает адекватно на всех платформах
при запуске проверить функцией CheckInet, если нету доступа показать окно с прокси

ага, посмотрел логом, думаю правильней будет так
// ZuBy *** procedure TCustomWebBrowser.FormHandleCreated(const Sender: TObject; const Msg: TMessage); var WBService: IFMXWBService; begin if not(Sender.ClassNameIs('TCustomPopupForm')) then if not(csDesigning in ComponentState) and TPlatformServices.Current.SupportsPlatformService(IFMXWBService, WBService) then begin FWeb := WBService.CreateWebBrowser; FWeb.SetWebBrowserControl(Self); FWeb.UpdateContentFromControl; FWeb.URL := FURL; FWeb.Navigate; end; end; // *** ZuBy не реагировать на создание Попап окон, на формы это не влияет. Сильно не тестил, так что хз.

Подправил uChatBox.pas под себя, заменил TLabel на TText, теперь проблем с отрисовкой бордюра не наблюдаю. Добавил выделение заголовка и градиент в "облачка".

ChatBox.zip

По 1-му вопросу для MacOS:
function CheckRunning: Boolean; var sl: TStringList; iCount: Integer; s: String; begin sl := TStringList.Create; try GetRunningAplications(sl); iCount := 0; for s in sl do if SameText(s, APP_BundleID) then // APP_BundleID - константа с BundleID приложения Inc(iCount); Exit(iCount < 2) finally sl.Free; end; end; procedure GetRunningAplications(AList: TStrings); var WorkSpace: NSWorkSpace; App: NSRunningApplicationEx; i: Integer; list: NSArray; begin WorkSpace := TNsWorkspace.Wrap(TNsWorkSpace.OCClass.SharedWorkspace); list := Workspace.runningApplications; if (list <> nil) and (list.count > 0) then begin for i := 0 to list.count-1 do begin App := TNSRunningApplicationEx.Wrap(list.objectAtIndex(i)); if App.bundleIdentifier <> nil then AList.Add(string(App.bundleIdentifier.UTF8String)) else AList.Add(String(App.executableURL.path.UTF8String)); end; end; end; Ответ на 3-ий вопрос сам уже долго ищу

http://stackoverflow.com/questions/2413426/playing-an-arbitrary-tone-with-android
тут формируют буфер синусом и 
audioTrack = new AudioTrack(AudioManager.STREAM_MUSIC, sampleRate, AudioFormat.CHANNEL_CONFIGURATION_MONO, AudioFormat.ENCODING_PCM_16BIT, (int)numSamples*2, AudioTrack.MODE_STATIC); audioTrack.write(generatedSnd, 0, generatedSnd.length); // Load the track audioTrack.play(); ну или тут
https://gist.github.com/slightfoot/6330866
 

uses AndroidApi.JNI.Media; procedure MakeSound(ADuration: Integer); var Volume: Integer; StreamType: Integer; ToneType: Integer; ToneGenerator: JToneGenerator; begin Volume := TJToneGenerator.JavaClass.MAX_VOLUME; // задаем громкость StreamType := TJAudioManager.JavaClass.STREAM_ALARM; ToneType := TJToneGenerator.JavaClass.TONE_DTMF_0; // тип звука ToneGenerator := TJToneGenerator.JavaClass.init(StreamType, Volume); ToneGenerator.startTone(ToneType, ADuration); end; Типы звука можно посмотреть здесь 

В общем вот работающий костыль, который полностью убирает полосы.
2 Timage лежат на TLayout.
Если после каждого поворота менять высоту Tlayout на 0,001 туда-обратно, то полос нет.  На глаз никакого движения не заметно.
 
Жмем по FloatAnimation  и выбираем событие OnProcess.
Далее  
procedure TfrmSplash.FloatAnimation1Process(Sender: TObject); begin {$IFDEF MSWINDOWS} if Layout1.Height > fNormHeight then Layout1.Height := Layout1.Height - 0.001 else Layout1.Height := Layout1.Height + 0.001; {$ENDIF} end; procedure TfrmSplash.FormCreate(Sender: TObject); begin   fNormHeight := Layout1.Height; end;  

чтобы прям кросс, думаю такой код подойдёт
function StartGranted: boolean; // uses System.IOUtils begin Result := not TFile.Exists(TPath.Combine(TPath.GetDocumentsPath, 'IamStarted')); TFile.WriteAllText(TPath.Combine(TPath.GetDocumentsPath, 'IamStarted'), ''); end; в dpr пишем
begin if StartGranted then begin Application.Initialize; Application.CreateForm(TForm2, Form2); Application.Run; end; end. ну и в дестрое главной формы
procedure TForm2.FormDestroy(Sender: TObject); //uses  System.IOUtils; begin   TFile.Delete(TPath.Combine(TPath.GetDocumentsPath, 'IamStarted')); end; Но это не точно, может есть и  аналог mutex'a в MacOS

Для Windows как и в VCL можно использовать Mutex-ы:
// в dpr-е uses FMX.Forms, Winapi.Windows, ... {$R *.res} var MUT: THandle; begin MUT := OpenMutex(MUTEX_ALL_ACCESS, false, 'MySuperProgram'); if MUT <> 0 then Application.Terminate; if MUT = 0 then MUT := CreateMutex(nil, false, 'MySuperProgram'); Application.Initialize; ...  

Для Windows как и в VCL можно использовать Mutex-ы:
// в dpr-е uses FMX.Forms, Winapi.Windows, ... {$R *.res} var MUT: THandle; begin MUT := OpenMutex(MUTEX_ALL_ACCESS, false, 'MySuperProgram'); if MUT <> 0 then Application.Terminate; if MUT = 0 then MUT := CreateMutex(nil, false, 'MySuperProgram'); Application.Initialize; ...  

Надо было написать и как исправить )