Лидеры

Поддержка XP в Rad Studio давно прекращена, поэтому глюки под XP могут быть любые. Скорее всего текстуры теряются по какой-то причине, попробуй использовать прорисовку с помощью GDI+, для этого надо в главном файле приложения снять флаг FMX.Types.GlobalUseDirect2D := False;

Полагаю, что на этом поприще на Firemonkey вы первая Вообще тема Beacon очень интересная.

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

Лучше сделайте сразу правильно, все равно придете к этому, при загрузке фото на сервер переименовывайте файл, общепринятый вариант дать определенное стандартное имя, например наименование вашего проекта и время в формате unix, например: Name+1424238237362, далее от имени сгенерировать MD5 хэш, и записать его в базу, после чего вернуть в ответ имя нового файла если нужен. Таким образом даже если будут одинаковые файлы имена не повторятся, а вот Random без проверки точно повторится, да и проверять надо постоянно базу шерстить.

Zuby выкладывал кастомные диалоги Там можно делать все что угодно

Если в гриде планируется выводить только текстовую информацию то используйте TStringGrid. Для отображения текста в ячейке в несколько строк используйте в тексте символ абзаца. Пример: StrinGrid1.Cells[1, 1] := 'строка 1 в ячейке 1.1' + #13#10 + 'строка 2 в ячейке 1.1'; Если же надо чтоб текст в одной ячейке был отображен разным шрифтом/цветом используйте событие TGrid.OnDrawColumnCell. Ниже описано как работать с TextLayout в этом событии: Добавлю, что в одной ячейке можно рисовать несколько TextLayout указывая для каждого цвет и размер шрифта, например как TStringGrid на скриншоте: P.S. Если планируете писать мобильное приложение, используйте TListView вместо грида.

THTTPClient не визуальный, так же у него отсутствуют события OnAuthEvent и другие. Все ручками надо обрабатывать.

Вот и склоняюсь к SQLite. Спасибо. Просто думала, что все уже давно наработано для однократных уведомлений - есть рекомендации и решения, и не надо ничего додумывать, оказываеться нет.

Симпатично, черт побери! ;-)

Вообще работать должно так - идет обращение на сервер, сервер отлупливает и сообщает давай авторизацию, TNetHTTPClient обрабатывает овет в OnAuthEvent и посылает второй запрос с авторизацией. Хотя могу и ошибаться, всегда использую THTTPClient, с TNetHTTPClient не баловался.

Left := screen.Displays[1].BoundsRect.Left;

Добрый день! Не могла ответить Вам своевременно. Поддержка Берлина уже включена, если вы еще не обновились - обновляйтесь!

При нажатие на кнопку и не должно ничего происходить. Вы сами обрабатываете событие: ... TFormMain = class(TForm) procedure ChatBoxURLButton(PURL: string); ... ChatBox.OnURLButtonClick:=ChatBoxURLButton; // При создании ChatBox ... procedure TFormMain.ChatBoxURLButton(PURL: string); begin OpenURL(PURL); // Открываем url мультиплатформенной процедурой end; // К примеру такой: procedure TFormMain.OpenURL(const AUrl: string); {$IFDEF ANDROID} var Uri: Jnet_Uri; OpenLinkIntent: JIntent; {$ENDIF ANDROID} begin {$IFDEF MSWINDOWS} ShellExecute(0, 'open', PChar(AUrl), nil, nil, SW_SHOWNORMAL); {$ENDIF MSWINDOWS} {$IFDEF ANDROID} Uri := StrToJURI(AUrl); OpenLinkIntent := TJIntent.JavaClass.init(TJIntent.JavaClass.ACTION_VIEW, Uri); SharedActivity.startActivity(OpenLinkIntent); {$ENDIF ANDROID} end;

Очистить : Chat.ClearChildren(Chat); Полоски это TLabel видимо с бордюром, поэкспериментируйте со стилем или с свойством Clip

Я думаю чаще чем раз в день нет смысла выдавать пуш одному и тому же человеку, иначе превратится в спам рассылку )

Может элементарные вещи, но хочу уточнить пару моментов: 0. HTTPclient - это ведь INDY компонент, TidHTTP? 1. Запросы каждые 10 секунд, на время выполнения операции отключается ли таймер? 2. Отлавливаете ли exception в запросах HTTPClient? 3. Включен и работает ли TimeOut в запросе HTTPClient? 4. HTTPclient создается динамически для каждого запроса или статичный компонент? 5. Если сервер возвращает ошибку (правильную ошибку которую вы ожидаете) или же заканчивается TimeOut запроса какие действия? Таймер продолжает работать или остановка процесса? 6. При успешном выполнении операции вызывается Синхронизация или же визуальных действий не происходит?

Извиняюсь что долго, перепроверьте процедуру, с размером облок вроде все нормально: procedure TForm2.ChatUp(UsID: integer; LastId: integer; CText: string); var Labb: TLabel; Marg: Single; LT: TLayout; begin LT := TLayout.Create(PR); LT.Parent := PR.Content; LT.Margins.Top := 2; LT.Align := TAlignLayout.Top; LT.Position.Y := PR.ContentBounds.Height + 50; Marg := PR.Width * 0.20; Labb := TLabel.Create(PR); Labb.Parent := PR; Labb.Align := TAlignLayout.Top; Labb.AutoSize := True; Labb.WordWrap := True; Labb.TextSettings.WordWrap := True; if UsID = 0 then begin Labb.Margins.Left := Marg; Labb.Margins.Right := 4; Labb.TextAlign := TTextAlign.Trailing; Labb.StyleLookup := 'labelchat_green'; end else begin Labb.Margins.Right := Marg; Labb.Margins.Left := 4; Labb.TextAlign := TTextAlign.Leading; Labb.StyleLookup := 'labelchat_white'; end; Labb.NeedStyleLookup; Labb.Text := ' ' + CText + ' '; LT.Height := Labb.Height + 4; Labb.Parent := LT; if UsID = 0 then Labb.Align := TAlignLayout.Right else Labb.Align := TAlignLayout.Left; end; По поводу очистке Опишите клас: TOpenScrollBox = class(TPresentedScrollBox); до TForm_Main = class(TForm) ... и процедурка procedure ClearChildren(AScrollBox: TPresentedScrollBox); begin Assert(AScrollBox <> nil); TOpenScrollBox(AScrollBox).Content.DeleteChildren; AScrollBox.Repaint; end;

procedure TForm1.FormCreate(Sender: TObject); begin chat:=TChatBox.Create(Layout1); Chat.Align:=TAlignLayout.Client; Chat.MsgWidthPercentage:=66; Chat.CalloutLength:=10; Chat.CalloutXRadius:=5; Chat.CalloutYRadius:=5; Chat.MessageFontSize:=14; Layout1.AddObject(Chat); end; Как то так...

У edit есть свойство ReturnKeyType нужно установить его в Next но некоторые клавиатуры косячат и могут игнорить эту установку гугл вроде норм. работает

Для одного проекта писал такое пару месяцев назад, пользуйтесь.Под 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.