• 0
gorec323

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

Вопросы

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

1330363221_88045.jpeg

 

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

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


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

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

  • 0

Добрый день,

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

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


Ссылка на сообщение
Поделиться на другие сайты
  • 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.

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


Ссылка на сообщение
Поделиться на другие сайты
  • 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;

Как то так...

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


Ссылка на сообщение
Поделиться на другие сайты
  • 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 

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


Ссылка на сообщение
Поделиться на другие сайты
  • 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;

 

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


Ссылка на сообщение
Поделиться на другие сайты
  • 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

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


Ссылка на сообщение
Поделиться на другие сайты
  • 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

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


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

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

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

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


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

Для публикации сообщений создайте учётную запись или авторизуйтесь

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

Создать учетную запись

Зарегистрируйте новую учётную запись в нашем сообществе. Это очень просто!

Регистрация нового пользователя

Войти

Уже есть аккаунт? Войти в систему.

Войти

  • Последние посетители   0 пользователей онлайн

    Ни одного зарегистрированного пользователя не просматривает данную страницу