Равиль Зарипов (ZuBy)

В озвученном вами примере ScrollableForm в том числе получается высота виртуальной клавиатуры в методе FormVirtualKeyboardShown

Этот компонент я делаю для клиента форума. Чтобы отображать простую разметку постов с форума. Я не планирую, что он будет поддерживать все. По моим планам, это базовые элементы разметки:
Параграф (межстрочный интервал, отступы) Списки Картинки Изменение параметров текста (шрифт, размер, цвет, стиль) Блок кода Ссылка Дальше посмотрим. 

Разобрался. Нужно объявлять объект типа JMediaPlayer.
var Player: JMediaPlayer; ......................... Player:=TJMediaPlayer.Create; Player.setDataSource(StringToJString('URL_MP3_ФАЙЛА')); Player.prepare; Player.Start()

Добрый день!
 
В теме про наш продукт http://fire-monkey.ru/topic/1519-1c-papyc-mobilnoe-prilozhenie-dlia-masterov-priemschiko/ меня просили поделиться исходным кодом компонента TabControl с поддержкой слайда табов пальцем. С удовольствием делюсь
В составе архива сам компонент и пример его использования.
FMXUI.zip

чтобы получить статус GPS (для Android) включен или нет, нужно использовать следующий код
function CheckGPSActive: boolean; // uses // Androidapi.JNIBridge, Androidapi.JNI.Location,  Androidapi.JNI.JavaTypes, // Androidapi.JNI.GraphicsContentViewText, Androidapi.Helpers {$IFDEF ANDROID} var   LocManagerObj: JObject;   LocationManager: JLocationManager;   allProviders: JList;   I: Integer; begin   Result := false;   // запрашиваем сервис Location   LocManagerObj := SharedActivityContext.getSystemService(TJContext.JavaClass.LOCATION_SERVICE);   if Assigned(LocManagerObj) then   begin     // получаем LocationManager     LocationManager := TJLocationManager.Wrap((LocManagerObj as ILocalObject).GetObjectID);     if Assigned(LocationManager) then     begin       // запрашиваем список всех провайдеров       allProviders := LocationManager.getProviders(true);       // выводим список       if Assigned(allProviders) then       begin         with TStringList.Create do         begin           for I := 0 to allProviders.size - 1 do             Add(JStringToString(allProviders.get(I).toString));           if ((IndexOf('gps') >= 0) or (IndexOf('network') >= 0)) then             Result := true;           Free;         end;       end;     end;   end; {$ELSE} begin   Result := false; {$ENDIF} end;

возможно ещё кому и понадобится

switch.zip

возможно ещё кому и понадобится

switch.zip

Для одного проекта писал такое пару месяцев назад, пользуйтесь.Под windows, при клике на сообщение, оно превращается в readonly TMemo - дабы можно было скопировать нужное из сообщения. При наличии URL в сообщении, сбоку появляется кнопка открыть - лучше ничего для открытия ссылок не придумал. Надо бы сделать диалог выбора для открытия одной из нескольких ссылок, но руки пока не доходят. Пощупать чат вживую можно в приложении https://play.google.com/store/apps/details?id=ru.flintnet.InternetAgent , для активации и загрузки примера чата отсканируйте  приложением qr-код с страницы  http://internetagent.flintnet.ru/
 

unit ChatBox; interface uses   System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Layouts,System.Types,   FMX.StdCtrls,FMX.Edit,FMX.Memo,FMX.TextLayout,System.UITypes,FMX.Graphics,FMX.Objects,   FMX.Effects,FMX.Styles.Objects; type   TMessagePos = (msgLeft,msgRight);   TEventText = procedure(PURL: String) of object;   TChatBox = class(TVertScrollBox)   private     FTextLyout : TTextLayout;     FLastMessageId : Integer;     FMsgWidthPercentage : Integer;     FOnURLButtonClick : TEventText;     FCalloutLength : Single;     FCalloutXRadius : Single;     FCalloutYRadius : Single;     FMessageFontSize : Single;     FMemo : TMemo;     procedure ButtonClick(Sender: TObject);     procedure MyMsgContainerOnClick(Sender: TObject);     procedure MyMsgContainerOnExit(Sender: TObject);     function FCreateMsgBlock(AOwner: TComponent; PMessageId : Integer;       PDate, PAutor, PMessage : String; PMessagePos : TMessagePos) : TLayout;     function CalculateTextItemHeight(Sender: TObject) : Single;     procedure LayoutResize(Sender: TObject);     function ExtractURL(pString : String) : String;     procedure Memo1ApplyStyleLookup(Sender: TObject);   public     property LastMessageId : Integer read FLastMessageId;     property MsgWidthPercentage : Integer read FMsgWidthPercentage write FMsgWidthPercentage default 80;     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;     Procedure AddMessage(pMessageId : Integer; PDate, PAutor, PMessage : String; PMessagePos : TMessagePos);     procedure ClearChildren(AChatBox: TChatBox);     procedure ScrollBottomSmoothly;     procedure ScrollBottom;   published     property OnURLButtonClick : TEventText read FonURLButtonClick write FonURLButtonClick;     property CalloutLength : Single read FCalloutLength write FCalloutLength;     property CalloutXRadius : Single read FCalloutXRadius write FCalloutXRadius;     property CalloutYRadius : Single read FCalloutYRadius write FCalloutYRadius;     property MessageFontSize : Single read FMessageFontSize write FMessageFontSize;   end;   TOpenChatBox = class(TChatBox); Procedure Register; implementation procedure Register; begin   RegisterComponents('EKorepov', [TChatBox]); end; constructor TChatBox.Create(AOwner: TComponent); begin   inherited create(Aowner);   FLastMessageId:=-1;   FTextLyout := TTextLayoutManager.DefaultTextLayout.Create;   FMemo:=TMemo.Create(Aowner);   FMemo.TextSettings.WordWrap:=True;   FMemo.ReadOnly:=True;   FMemo.Align:=TAlignLayout.Client;   FMemo.OnExit:=MyMsgContainerOnExit;   FMemo.OnApplyStyleLookup:=Memo1ApplyStyleLookup;   FMemo.StyledSettings:=FMemo.StyledSettings-[TStyledSetting.Size];   With Self as TVertScrollBox do   begin     AniCalculations.Animation := True;     AniCalculations.BoundsAnimation := True;     AniCalculations.TouchTracking := [ttVertical];   end; end; destructor TChatBox.Destroy; begin   FreeAndNil(FMemo);   FreeAndNil(FTextLyout);   inherited Destroy; end; procedure TChatBox.ScrollBottomSmoothly; begin   AniCalculations.MouseWheel(0, ContentBounds.Height+5); end; procedure TChatBox.ScrollBottom; begin   ScrollBy(0, -ContentBounds.Height); end; procedure TChatBox.ButtonClick(Sender: TObject); Var URL : String; begin   URL:=TButton(Sender).HelpKeyword;   if Assigned(FonURLButtonClick) then     FonURLButtonClick(URL); end; procedure TChatBox.Memo1ApplyStyleLookup(Sender: TObject); begin end; procedure TChatBox.MyMsgContainerOnClick(Sender: TObject); begin   FMemo.TextSettings:=TLabel(Sender).TextSettings;   FMemo.Lines.Text:=TLabel(Sender).Text;   TLabel(Sender).AddObject(FMemo); end; procedure TChatBox.MyMsgContainerOnExit(Sender: TObject); begin   if (Sender is TMemo) then     if Assigned(TMemo(Sender).Parent) then       if (TMemo(Sender).Parent is TLabel) then         TLabel(TMemo(Sender).Parent).RemoveObject(TMemo(Sender)); end; procedure TChatBox.ClearChildren(AChatBox: TChatBox); begin   Assert(AChatBox <> nil);   TOpenChatBox(AChatBox).Content.DeleteChildren;   AChatBox.Repaint; end; function TChatBox.CalculateTextItemHeight(Sender: TObject) : Single; var Item: TLabel; begin   Result:=0;   if (Sender is TLabel) then   begin     Item := TLabel(Sender);     FTextLyout.BeginUpdate;     try       FTextLyout.Text := Item.Text;       FTextLyout.MaxSize := TPointF.Create(Item.Width-Item.Margins.Left-Item.Margins.Right-10, 1000);       FTextLyout.Font := Item.Font;       FTextLyout.WordWrap:= Item.WordWrap;       FTextLyout.HorizontalAlign:= Item.TextSettings.HorzAlign;       FTextLyout.VerticalAlign:= Item.TextSettings.VertAlign;     finally       FTextLyout.EndUpdate;     end;     Result:= FTextLyout.Height+10;   end; end; procedure TChatBox.LayoutResize(Sender: TObject); Var Item : TLabel;     CalloutRectangle : TCalloutRectangle;     Layout : TLayout;     I : Integer; begin   Layout:=TLayout(Sender);   for I := 0 to Layout.Children.Count-1 do   begin     If Layout.Children.Items[I] is TCalloutRectangle Then     begin       CalloutRectangle:=TCalloutRectangle(Layout.Children.Items[I]);       Item:=TLabel(CalloutRectangle.Children.Items[0]);       CalloutRectangle.Width:=(Layout.Width / 100) * FMsgWidthPercentage;       Layout.Height:=CalculateTextItemHeight(Item);     end;     If Layout.Children.Items[I] is TButton Then     begin       TButton(Layout.Children.Items[I]).Width:=(Layout.Width / 100) * (100-FMsgWidthPercentage-5);     end;   end; end; Procedure TChatBox.AddMessage(pMessageId : Integer; PDate, PAutor, PMessage : String; PMessagePos : TMessagePos); Var lcLayout : TLayout; begin   PDate:=Trim(PDate);   PAutor:=Trim(PAutor);   PMessage:=Trim(PMessage);   FLastMessageId:=PMessageId;   lcLayout:=FCreateMsgBlock((Self as TVertScrollBox), PMessageId, PDate, PAutor, PMessage, PMessagePos);   Self.AddObject(lcLayout); end; function TChatBox.FCreateMsgBlock(AOwner: TComponent; PMessageId : Integer; PDate, PAutor, PMessage : String;                                   PMessagePos : TMessagePos) : TLayout; Var lcLayout,lcLayout2 : TLayout;     Item : TLabel;     Button : TButton;     CalloutRectangle : TCalloutRectangle;     lcHeight : Single;     URL : String; begin   lcLayout:=TLayout.Create(AOwner);   lcLayout.Tag:=pMessageId;   lcLayout.Align:=TAlignLayout.Top;   lcLayout.Width:=200;   lcLayout.Position.X:=0;   lcLayout.Position.Y:= ((AOwner as TVertScrollBox).ContentBounds.Height+10);   lcLayout.Margins.Bottom:=10;   CalloutRectangle:=TCalloutRectangle.Create(lcLayout);   CalloutRectangle.XRadius:=FCalloutXRadius;   CalloutRectangle.YRadius:=FCalloutYRadius;   CalloutRectangle.CalloutWidth:=10;   CalloutRectangle.CalloutOffset:=-3-FCalloutYRadius-CalloutRectangle.CalloutWidth;   CalloutRectangle.Width:=((AOwner as TVertScrollBox).Width / 100) * FMsgWidthPercentage;   CalloutRectangle.HitTest:=False;   case PMessagePos of     msgRight :     begin       CalloutRectangle.Align:=TAlignLayout.Right;       CalloutRectangle.CalloutPosition:=TCalloutPosition.Right;       CalloutRectangle.Padding.Right:=CalloutRectangle.CalloutLength+CalloutRectangle.XRadius;       CalloutRectangle.Padding.Left:=CalloutRectangle.XRadius;     end;     msgLeft :     begin       CalloutRectangle.Align:=TAlignLayout.Left;       CalloutRectangle.CalloutPosition:=TCalloutPosition.Left;       CalloutRectangle.Padding.Left:=CalloutRectangle.CalloutLength+CalloutRectangle.XRadius;       CalloutRectangle.Padding.Right:=CalloutRectangle.XRadius;     end;   end;   CalloutRectangle.Padding.Top:=1;   CalloutRectangle.Padding.Bottom:=1;   lcLayout.AddObject(CalloutRectangle);   Item:=TLabel.Create(CalloutRectangle);   Item.TextSettings.Font.Size:=MessageFontSize;   CalloutRectangle.AddObject(Item);   Item.Align:=TAlignLayout.Client; {$IFDEF MSWINDOWS}   Item.OnClick:=MyMsgContainerOnClick; {$ENDIF MSWINDOWS}   Item.Text:=PDate+' '+PAutor+#10+PMessage;   Item.HitTest:=True;   Item.WordWrap:=True;   lcHeight:=CalculateTextItemHeight(Item);   lcLayout.Height:=lcHeight;   URL:=ExtractURL(pMessage);   Item.StyledSettings:=Item.StyledSettings- [TStyledSetting.Size,TStyledSetting.Style];   if Not URL.IsEmpty then   begin     lcLayout2:=TLayout.Create(lcLayout);     lcLayout2.Align:=TAlignLayout.Client;     lcLayout2.Margins.Left:=5;     lcLayout2.Margins.Right:=5;     lcLayout.AddObject(lcLayout2);     Button:=TButton.Create(lcLayout2);     Button.Text:='Открыть';     Button.Align:=TAlignLayout.Center;     Button.HelpKeyword:=URL;     Button.OnClick:=ButtonClick;     lcLayout2.AddObject(Button);   end;   lcLayout.OnResize:=LayoutResize;   Result:=lcLayout; end; function TChatBox.ExtractURL(pString : String) : String; Var S : String; begin   Result:='';   if Not pString.Contains('http') then     Exit;   S:=pString.Substring(Pos('http',pString)-1);   S:=S.Remove(S.IndexOfAny([' ',',']));   Result:=S.TrimRight(['.']); end; end.

ну логические операции для пользователя, например заказ товара на TTabControl
1. Товар -> 2. Детали -> 3. Оплата -> 4. Подтверждение
это все через SetActiveTabWithTransition(Таб, TTabTransition.Slide, TTabTransitionDirection.Normal);
 
остальные опции, типа регистрации можно сделать на отдельной форме

Для анимации переходов точно TTabControl, но не лепить все на одной форме

В скриншоте не выключены превью стили в Multi-Device Preview.
0. Перезапустите Дельфи
1. Создайте новый проект MultiDeviceProject
2. Выключите превью стилей в меню Multi-Device Preview как у Вас в скриншоте.
3. Закройте проект не сохраняя
4. Откройте свой проект (не перезапускайте Delphi)
 
Попробуйте пожалуйста еще раз.

Ну так то, я это и писал чтобы отключить превью )

Задержка пропадает, если использовать этот код в TForm.OnShow?
var Buffer: TBitmap; begin // Draw to Bitmap force to load all styles, measure size, build font-glyphs etc Buffer := TBitmap.Create(1, 1); try Buffer.Canvas.BeginScene; try MultiView.PaintTo(Buffer.Canvas, Control.LocalRect); finally Buffer.Canvas.EndScene; end; finally Buffer.DisposeOf; end;

Для анимации переходов точно TTabControl, но не лепить все на одной форме

SMTP.Host:= 'smtp.yandex.ru' ; // хост
SMTP.Port:= 465 ; // порт
Smtp.Username:='TestUser'; 
Smtp.Password:='pass123';


SMTP.UseTLS :=utUseImplicitTLS ;

IdSSLIOHandlerSocketOpenSSL1 := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
IdSSLIOHandlerSocketOpenSSL1.Destination := SMTP.Host+':'+IntToStr(SMTP.Port);
IdSSLIOHandlerSocketOpenSSL1.Host := SMTP.Host;
IdSSLIOHandlerSocketOpenSSL1.Port := SMTP.Port;
IdSSLIOHandlerSocketOpenSSL1.DefaultPort := 0;
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method := sslvTLSv1; // Уверен что именно этот метод используется??
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Mode := sslmUnassigned;
 
SMTP.IOHandler := IdSSLIOHandlerSocketOpenSSL1;

MailMessage.Body.Clear;

MailMessage.Body.Add('Первая строка');
MailMessage.Body.Add('Вторая строка');

SMTP.Connect;
mailMessage.CharSet := 'UTF-8';
mailMessage.CharSet:='UTF-8';

MailMessage.ContentType:='multipart/mixed; charset=UTF-8';
MailMessage.ContentType:='text/plain; charset=KOI8-R';

MailMessage.Subject:=UTF8Encode('Reserve') ; // тема
MailMessage.From.Address:='testadres@yandex.ru' ;
MailMessage.From.Domain:= 'yandex.ru'; // домен
MailMessage.From.User:= 'TestUser';
MailMessage.From.Name:=UTF8Encode('TestUserName');

MailMessage.Recipients.EMailAddresses:='TestUser0@list.ru'; // получатель и копия
//2192100@list.ru

MailMessage.IsEncoded:=true;

SMTP.Send(MailMessage);
SMTP.Disconnect;
 
 
==================================
А теперь еще раз на код посмотри и сделай все правильно

SMTP.IOHandler := IdSSLIOHandlerSocketOpenSSL1;

SMTP.UseTLS :=utUseImplicitTLS ;

IdSSLIOHandlerSocketOpenSSL1 := TIdSSLIOHandlerSocketOpenSSL.Create(nil);

Добрый день,
Делаете стиль для итема, в виде панельки Устаналиваете в лист боксе размер итема: ItemHeight, ItemWidth. Для всех итемов устанавливаете ваш стиль Все готово. P.S. TGridLayout не лучший выбор при большом количестве итемов. Так как листбокс реально грузит стили только для видимой части итемов. И при прокрутке только меняет стили местами. А TGridLayout загрузит все элементы. В итоге проигрышь по памяти и по скорости.

Разработка продолжается
 
Полностью перевел приложение на XML RPC API (демо и исходник тут) Авторизация (если её можно так назвать) Информация о пользователе из профиля (добавлена информация о возрасте +незначительные улучшения кода) Обновил немного дизайн Кэширование данных пользователя и навигации форума (самостоятельное обновление когда это требуется) Используется OXml для Android Кэширование всех картинок пользователей (на данный момент это ~1200 юзеров, НО не все юзеры имеют фотографии) Кэшируется всё на внешнюю память Теперь можно открывать "сайт" из профиля юзера (для Windows с окном уведомления) в ближайшее время собираюсь реализовать
Доделать навигацию по веткам (как только пойму почему косяк с TTreeView) Кэширование всех картинок пользователей разработать иконку и сплеш картинку (может её и вовсе уберу) много чего... Проект также open-source, помощь приветствуется
 
исходники выкладываю без бинарников, бинарники лежат на google диске в соответствующих папках (но синхронизация не всегда включена )
 
FireMonkey.ru.zip
 

Обновленная версия
поддержка Android 5.x обновленный дизайн  

 
Скачать с офф. сайта

Обновленная версия
поддержка Android 5.x обновленный дизайн  

 
Скачать с офф. сайта

Разработка продолжается
 
Полностью перевел приложение на XML RPC API (демо и исходник тут) Авторизация (если её можно так назвать) Информация о пользователе из профиля (добавлена информация о возрасте +незначительные улучшения кода) Обновил немного дизайн Кэширование данных пользователя и навигации форума (самостоятельное обновление когда это требуется) Используется OXml для Android Кэширование всех картинок пользователей (на данный момент это ~1200 юзеров, НО не все юзеры имеют фотографии) Кэшируется всё на внешнюю память Теперь можно открывать "сайт" из профиля юзера (для Windows с окном уведомления) в ближайшее время собираюсь реализовать
Доделать навигацию по веткам (как только пойму почему косяк с TTreeView) Кэширование всех картинок пользователей разработать иконку и сплеш картинку (может её и вовсе уберу) много чего... Проект также open-source, помощь приветствуется
 
исходники выкладываю без бинарников, бинарники лежат на google диске в соответствующих папках (но синхронизация не всегда включена )
 
FireMonkey.ru.zip
 

Обновленная версия
поддержка Android 5.x обновленный дизайн  

 
Скачать с офф. сайта

Ну вам выше вроде ответили, если не хотите лагов интерфейса то используюте синхронизацию