Для одного проекта писал такое пару месяцев назад, пользуйтесь.Под 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.
Здравствуйте, решил написать клиента для своего сайта, делпхи не открывал 15 лет без шуток, перешел в веб разработку, а сейчас все возвращается на свои места как говориться
так вот меня интересует теоретический набросок использования элементов форм
схема типичная: слева скрытый список MultiView1, справа рабочая область
вот о рабочей области и вопрос
я выбираю в меню MultiView1 СТАТЬИ(1 пункт), слева должен появиться список свежих статей, внизу панель (добавить), жмем на добавить и открывается форма добавления статьи.
как это лучше реализовать?
например:
1. накидать на каждый пункт меню панель и в них разместить свои элементы форм
2. нагромоздить несколько форм и их подключать как то
3. ваш вариант
gdm_it отреагировална Равиль Зарипов (ZuBy) в ListBox, Edit и клавиатура