• 0
gorec323

Сообщения чата в виде сообщений в iphone.

Вопрос

Здравствуйте, подскажите пожалуйста есть ли уже готовые компоненты на FireMonkey или на основе чего можно сделать сообщения в окне переписки в виде сообщений iphone? Как показано ниже:

1330363221_88045.jpeg

 

Заранее спасибо.

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах

17 ответов на этот вопрос

  • 0

Добрый день,

  1. Я бы взял TScrollBox для контейнера сообщений.
  2. Каждое сообщени представил в виде TLabel с вашим стилем в виде облаков
  3. TLabel поместил в TLayout и внутри него выравнивал бы по правому или левому краю.
  4. А сами TLayout выравнивал бы по верху.
kami, Kitty, Евгений Корепов и 1 другому понравилось это

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

Примерно так и предполагал, попробую.

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

Для содания стиля сообщения используйте TStyleObject. Он позволяет исходную растровую картинку облака собщения растягивать в любой размер.

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 2

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

 

Screenshot004_resize.png

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.
ENERGY, xenon54, Rusland и 7 другим понравилось это

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

Евгений Корепов, а как пользоваться этим чатом?

Вот, например, я подцепил к проекту unit ChatBox и пытаюсь добавить сообщения.

  public
    { Public declarations }
    chat:TChatBox;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
  chat.AddMessage(1,'22:15','Автор1','сообщение',TMessagePos.msgLeft);
  chat.AddMessage(2,'22:16','Автор2','сообщение2',TMessagePos.msgRight);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  chat:=TChatBox.Create(Layout1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  chat.Destroy;
end;

но ничего не происходит.

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 1
В 17.05.2016 в 16:46, Rusland сказал:

Евгений Корепов, а как пользоваться этим чатом?

Вот, например, я подцепил к проекту unit ChatBox и пытаюсь добавить сообщения.


  public
    { Public declarations }
    chat:TChatBox;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
  chat.AddMessage(1,'22:15','Автор1','сообщение',TMessagePos.msgLeft);
  chat.AddMessage(2,'22:16','Автор2','сообщение2',TMessagePos.msgRight);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  chat:=TChatBox.Create(Layout1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  chat.Destroy;
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;

Как то так...

Rusland и zairkz понравилось это

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

Заработало!

Но почему-то появляются полоски:

chat.png

Отчего это?

И при нажатии на кнопку Открыть урл не открывается.

procedure TChatBox.ButtonClick(Sender: TObject);
Var URL : String;
begin
  URL:=TButton(Sender).HelpKeyword;
  if Assigned(FonURLButtonClick) then
    FonURLButtonClick(URL); // сюда не заходит
end;

И как очистить чат?

Изменено пользователем Rusland

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0
 

Очистить : 

Chat.ClearChildren(Chat);

Полоски это TLabel видимо с бордюром, поэкспериментируйте со стилем или с свойством Clip 

Rusland понравилось это

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

При нажатие на кнопку и не должно ничего происходить. Вы сами обрабатываете событие:

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

 

Rusland понравилось это

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

Спасибо. Пока этот чат нравится больше остальных.

20 минут назад, Евгений Корепов сказал:

Очистить : 


Chat.ClearChildren(Chat);

 

После очистки длинного чата, остается висеть скроллер VertScrollBox. Как его скрыть?

 

Как сделать, например, на longtap облачка открытие url (вместо отображения кнопки... не очень красиво выходит) или предложить выбор (если ссылок несколько)?  (копирование из мемо не интересует, поэтому готов им пожертвовать... тем более что если CalloutRectangle не белого цвета, то при активации мемо - он белого цвета)

Изменено пользователем Rusland

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0
4 часа назад, Евгений Корепов сказал:

Полоски это TLabel видимо с бордюром, поэкспериментируйте со стилем или с свойством Clip 

Похоже этот бордюр бывает только в Windows (в Android не наблюдаю), причем если окно свернуть/развернуть или проскроллировать сообщения, то бордюр исчезает. Видимо что-то с прорисовкой. Пробовал делать Invalidate - не помогает. 

Изменено пользователем Rusland

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 1

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

Чат2.png

ChatBox.zip

Евгений Корепов, zairkz, r@di0 и 1 другому понравилось это

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0
В 19.05.2016 в 21:02, Rusland сказал:

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

Чат2.png

ChatBox.zip

Всем привет! Под Андроид у некоторых сообщений внизу создаётся лишнее пустое пространство.
В примере это видно (выделил красным). Rad Studio 10.2 Tokyo.
Никто это не правил?
 

573dc67daa0a1_2.png.0084dcb7a497a64596c8120701ea74cf.png

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

В HTML Library в комплекте идет пример чата с автоматической конвертации ссылки на картинку в картинку, ссылки на гугл карту в кусок карты, просто ссылки в активную ссылку и.т.д

Ну и понятно, что сообщения могут содержать абсолютно любое оформление текста, картинки и.т.д.

Компилированный вариант для VCL http://delphihtmlcomponents.com/editorchatdemo.zip

IMG_0982.PNG

Anatoliy понравилось это

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0
В 07.09.2017 в 17:44, r@di0 сказал:

Всем привет! Под Андроид у некоторых сообщений внизу создаётся лишнее пустое пространство.
В примере это видно (выделил красным). Rad Studio 10.2 Tokyo.
Никто это не правил?

Скорее всего неправильно задана ширина области для функции, которая возвращает высоту текста.

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах

Создайте аккаунт или войдите для комментирования

Вы должны быть пользователем, чтобы оставить комментарий

Создать аккаунт

Зарегистрируйтесь для получения аккаунта. Это просто!


Зарегистрировать аккаунт

Войти

Уже зарегистрированы? Войдите здесь.


Войти сейчас

  • Сейчас на странице   0 пользователей

    Нет пользователей, просматривающих эту страницу