Евгений Корепов
-
Постов
738 -
Зарегистрирован
-
Посещение
-
Победитель дней
100
Активность репутации
-
Евгений Корепов отреагировална Brovin Yaroslav в Delphi XE8 автозагрузка приложения в Android
Haword прав.
Обратите ваше внимание на строчку в манифесте:
<receiver android:name="com.embarcadero.firemonkey.notifications.FMXNotificationAlarm" /> Это аналогичный вашему ресивер. name указывает, что ресивер FMXNotificationAlarm находится в пакетах: "com.embarcadero.firemonkey.notifications".
-
Евгений Корепов отреагировална haword в Delphi XE8 автозагрузка приложения в Android
ну вообще то надо задать java класс а указано - .BootReceiver
-
Евгений Корепов отреагировална DirtyBorov в MaskEdit
Случилось так, что потребовался мне ввод номера телефона. Компонента, аналога TMaskEdit в FMX нет, так что пришлось "изобретать на коленке". Компонент писать было лень, потому просто покажу как я решил это в конкретном диалоге с использованием TEdit. Может кому то пригодится. Из кода я убрал все лишнее, оставил только то что относится к делу.
uses .... System.MaskUtils, System.Character; type TFormRegistry = class(TForm) edtPhone: TEdit; procedure edtPhoneValidating(Sender: TObject; var Text: string); procedure edtPhoneKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); procedure FormCreate(Sender: TObject); procedure edtPhoneEnter(Sender: TObject); procedure edtPhoneTyping(Sender: TObject); private const Mask = '+7(000)000-00-00;0;*'; /// '+0(000)000-00-00;0;*' - для других стран, например для Украины +3(999).... private PhoneNumber: string; function GetCaretPos: Integer; function GetMaxLength: integer; public end; procedure TFormRegistry.FormCreate(Sender: TObject); begin edtPhone.Text := FormatMaskText(Mask, PhoneNumber); end; function TFormRegistry.GetCaretPos: Integer; var i: integer; begin Result := 0; for i := 0 to Mask.Length-1 do begin if not (MaskGetCharType(Mask, i) in [mcDirective, mcMask]) then Result := Result + 1; if (Result + PhoneNumber.Length) = i then Break; end; Result := Result + PhoneNumber.Length - 1; end; function TFormRegistry.GetMaxLength: integer; var i: integer; begin Result := 0; for i := 0 to Mask.Length-1 do if (MaskGetCharType(Mask, i) in [mcMask]) then Result := Result + 1; end; procedure TFormRegistry.edtPhoneKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); begin if (Key = 8) and (PhoneNumber.Length > 0) then PhoneNumber := Copy(PhoneNumber, 1, PhoneNumber.Length-1) else if (PhoneNumber.Length < GetMaxLength) and (Key = 0) and IsDigit(KeyChar) then PhoneNumber := PhoneNumber + KeyChar else KeyChar := #0; end; procedure TFormRegistry.edtPhoneEnter(Sender: TObject); begin edtPhone.CaretPosition := GetCaretPos; end; procedure TFormRegistry.edtPhoneTyping(Sender: TObject); begin edtPhone.CaretPosition := GetCaretPos; end; procedure TFormRegistry.edtPhoneValidating(Sender: TObject; var Text: string); begin Text := FormatMaskText(Mask, PhoneNumber); end; end. -
Евгений Корепов получил реакцию от rakhmet в Сообщения чата в виде сообщений в iphone.
Для одного проекта писал такое пару месяцев назад, пользуйтесь.Под 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. -
Евгений Корепов отреагировална krapotkin в [Отклонение] [Android] Не меняется KeyboardType при переходе на следующий TEdit
этот ответ можно вынести на главную страничку и закрыть все темы форума разом )))
-
Евгений Корепов отреагировална Brovin Yaroslav в Как определить, что ListBox прокручен в самый конец?
Добрый день,
Определить, что TListBox (TScrollBox) прокручен до конца можно используя событие OnViewPortPositionChange. Это событие вызывается каждый раз при прокручивании контента. Этот метод возвращает текущее положение ViewPort - позиция окна, в котором отображаются текущие элементы TListBox. Об этом подробно описано в этой статье: "Платформонезависимый скроллинг в Fire Monkey"
Ниже приведен код, который проверяет, что TListBox прокручен до конца.
procedure TForm1.ListBox1ViewportPositionChange(Sender: TObject; const OldViewportPosition, NewViewportPosition: TPointF; const ContentSizeChanged: Boolean); begin if NewViewportPosition.Y > ListBox1.ContentBounds.Height - ListBox1.Height then ShowMessage('End!'); end; -
Евгений Корепов отреагировална Belov.V. в После активации TSearchBox не возвращается индекс нового добавленого элемента
Готового решения на просторах интернета не нашел. То, что напридумывал сам, оформил в виде хелпера к TListBox. Может кому пригодится.
Реализовал только необходимые мне методы. И только для режима MultiSelectStyle=None
Самое главное, что так индекс возвращается корректно.
unit ListBoxHelper; interface uses FMX.Controls, FMX.Types, System.SysUtils, FMX.ListBox, FMX.SearchBox; // Создаем Helper для класса TListBox type TListBoxHelper = class helper for TListBox function ResetFilter : string; // возвращает старый фильтр function GetSearchBox : TSearchBox; // возвращает SearchBox function AddAndClearSelect(const S : string) : integer; // добавить, ничего не выбирать, фильтр очистить function AddAndSelect(const S : string) : integer; // добавить, выбрать, фильтр очистить function AddAndSaveOldSelect(const S : string) : integer; // добавить, сохранить выбор, фильтр очистить function AddAndSaveOldView(const S : string) : integer; // добавить, сохранить выбор и фильтр, вернуть номер добавленного в отфильтрованном списке, или -1 если не попадает в фильтр procedure DeleteItem(const i : integer = -1); // удалить по индексу. если индекс не указан то удалить выбранный end; implementation function TListBoxHelper.GetSearchBox : TSearchBox; var Child : TControl; FxmChild : TFmxObject; begin Result := nil; for Child in self.Controls do for FxmChild in Child.Controls do if FxmChild is TSearchBox then Exit( TSearchBox( FxmChild ) ); end; function TListBoxHelper.ResetFilter : string; var s : TListBoxItem; sb : TSearchBox; begin Result := EmptyStr; s := Selected; sb := GetSearchBox; if Assigned( sb ) then begin Result := sb.Text; sb.Text := EmptyStr; end; if Assigned( FilterPredicate ) then FilterPredicate := nil; if Assigned( s ) then ItemIndex := s.Index; end; function TListBoxHelper.AddAndClearSelect(const S : string) : integer; begin ClearSelection; ResetFilter; Result := Items.Add( s ); end; function TListBoxHelper.AddAndSelect(const S : string) : integer; begin Result := AddAndClearSelect( s ); if Result <> -1 then ItemIndex := Result; end; function TListBoxHelper.AddAndSaveOldSelect(const S : string) : integer; var sel : TListBoxItem; begin sel := Selected; Result := AddAndClearSelect( s ); if Assigned( sel ) then ItemIndex := sel.Index end; function TListBoxHelper.AddAndSaveOldView(const S : string) : integer; var sb : TSearchBox; iSel, iNew : TListBoxItem; flt : string; begin iSel := Selected; iNew := nil; ClearSelection; sb := GetSearchBox; flt := ResetFilter; // Result := Items.Add( s ); if Result <> -1 then iNew := ItemByIndex( Result ); // if flt <> EmptyStr then begin sb.Text := flt; if Assigned( iNew ) then Result := iNew.Index; end; if Assigned( iSel ) then ItemIndex := iSel.Index; end; procedure TListBoxHelper.DeleteItem(const i : integer = -1); var sb : TSearchBox; flt : string; iSel, iDel : TListBoxItem; begin if i > Count-1 then Exit; sb := GetSearchBox; if i > -1 then begin iSel := Selected; iDel := ItemByIndex( i ); end else begin iSel := nil; iDel := Selected; end; flt := ResetFilter; if Assigned( iDel ) then Items.Delete( iDel.Index ); // if flt <> EmptyStr then sb.Text := flt; if Assigned( iSel ) then ItemIndex := iSel.Index; end; end. Еще на XE7 есть глюк в режиме Sorted := True, при добавить одинаковые значения (или несколько одинаковых) и сразу выделении одного через IntemIndex.
Но пока на выявление закономерностей и борьбу нет времени.
ListBoxHelper.zip
-
Евгений Корепов получил реакцию от Алмаз Амангельды в Сообщения чата в виде сообщений в iphone.
Для одного проекта писал такое пару месяцев назад, пользуйтесь.Под 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. -
Евгений Корепов получил реакцию от ENERGY в Сообщения чата в виде сообщений в iphone.
Для одного проекта писал такое пару месяцев назад, пользуйтесь.Под 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. -
Евгений Корепов отреагировална Martifan в Как поменять надписи для кнопок в MessageDlg?
Извините я сам нашел решение если кому пригодится:
1. находим файл FMX.Consts.pas
2. Положи его в папку с проектом.
3. Menu Project->Add to Project - добавь этот файл.
4. Сохрани проект. Закрой проект. Открой проект заново.
5. Menu -> Project -> Build All Project
6. Запускаем.
-
Евгений Корепов отреагировална Brovin Yaroslav в TServerSocket TClientSocket в FireMonkey
Ребята, форум существует для ответов на любые вопросы. Если вы считаете, что автор вопроса поленился и не захотел попробовать найти информацию, НЕ пишите и не отвечайте ему, если вам не хочется. Чем разводить бессмысленные словесные перепалки. Эмоции здесь совершенно ни к чем.
Спасибо за понимание
-
Евгений Корепов отреагировална Равиль Зарипов (ZuBy) в [Android/Win] Клиент для fire-monkey.ru [разработка]
Разработка продолжается
Полностью перевел приложение на XML RPC API (демо и исходник тут) Авторизация (если её можно так назвать) Информация о пользователе из профиля (добавлена информация о возрасте +незначительные улучшения кода) Обновил немного дизайн Кэширование данных пользователя и навигации форума (самостоятельное обновление когда это требуется) Используется OXml для Android Кэширование всех картинок пользователей (на данный момент это ~1200 юзеров, НО не все юзеры имеют фотографии) Кэшируется всё на внешнюю память Теперь можно открывать "сайт" из профиля юзера (для Windows с окном уведомления) в ближайшее время собираюсь реализовать
Доделать навигацию по веткам (как только пойму почему косяк с TTreeView) Кэширование всех картинок пользователей разработать иконку и сплеш картинку (может её и вовсе уберу) много чего... Проект также open-source, помощь приветствуется
исходники выкладываю без бинарников, бинарники лежат на google диске в соответствующих папках (но синхронизация не всегда включена )
FireMonkey.ru.zip
-
-
Евгений Корепов отреагировална BurcevD в Вроде как ошибка!
Уважаемые разработчики!
Хочу обратить Ваше внимание на следующие коды,
в модуле FMX.ListView.Types
строка 1530
if ImageSource = TImageSource.ImageList then Bitmap := Images.Bitmap(TSizeF(TPointF(FLocalRect.Size) * Canvas.Scale), FImageIndex) else Bitmap := GetBitmap; ... далее текст работы с Bitmap В то же время ImageSource может иметь 3 значения:
1481 строка
function TListItemImage.GetImageSource: TImageSource; begin if (FImageIndex <> -1) and (Images <> nil) and Images.BitmapExists(ImageIndex) then FImageSource := TImageSource.ImageList else if GetBitmap <> nil then FImageSource := TImageSource.Bitmap else FImageSource := TImageSource.None; Result := FImageSource; end; И если Bitmap из прошлого кода равен nil, то происходит ошибка.
Следует либо обработать третьего состояния либо обработать bitmap на nil.
Спасибо
-
Евгений Корепов отреагировална xenon54 в [TidTCPServer] [TidTCPClient] Как отправить файл с сервера на клиент используя Indy10 и получить файл на стороне клиента?
Отправка:
var len : integer; begin Context.Connection.IOHandler.WriteBufferOpen; Context.Connection.IOHandler.Write(len); Context.Connection.IOHandler.WriteFile(AFileName); Context.Connection.IOHandler.WriteBufferFlush; Context.Connection.IOHandler.WriteBufferClose; Прием ( Тут на клиентской стороне должен быть метод, который по таймеру смотрит есть ли данные на входном буффере ):
var sz : integer; FS : TMemoryStream; begin if FIdTCPClient.IOHandler.InputBufferIsEmpty then exit; sz := FIdTCPClient.IOHandler.InputBuffer.Size; if sz <= 0 then exit; FS := TMemoryStream.Create; FIdTCPClient.IOHandler.ReadStream(FS,sz); -
Евгений Корепов отреагировална Виктор в Сокращается текст в компоненте TLabel
Комрад, в nextSettings отключи trimming и WordWrap. Скорей всего поможет. И имей ввиду что тоже текст в win7, win xp, win server может иметь фактически разную длину)
-
Евгений Корепов отреагировална bigjorj в Ошибка в FMX.Graphics.Android
Да с GetCachePath работает без нареканий.
Могу обмануть, но этот механизм используется только для анройда 5 версии. Это способ исправления бага при котором приложения на XE7 висли при попытке вывода картинки из TStream. А здесь сначала записывается в файл, а потом считывается уже в контрол. А то что вы показали, это элемент стиля.
-
Евгений Корепов отреагировална bigjorj в Ошибка в FMX.Graphics.Android
А я думал что только у меня такая ошибка проявляется...
У меня нормально заработало только с такой строкой
Result := TPath.Combine( TPath.GetCachePath , 'TmpBitmapStream'); В tempPah все равно периодически выдавало ошибку прав доступа.
Причем установил приложение -вываливается с ошибкой. Перезапускаешь устройство начинает работать...
-
Евгений Корепов получил реакцию от estra в Ошибка в FMX.Graphics.Android
[Delphi XE8, Android]
Ошибка в Studio\16.0\source\fmx\FMX.Graphics.Android.pas и соответственно в Studio\16.0\lib\android\release\FMX.Graphics.Android.o и Studio\16.0\lib\android\debug\FMX.Graphics.Android.o
Строка 258 function GetTmpFileName: String;
Выглядит так:
function GetTmpFileName: String; begin Result := TPath.GetTempPath + 'TmpBitmapStream' end; Подозреваю что выглядеть должна вот так:
function GetTmpFileName: String; begin Result := TPath.Combine(TPath.GetTempPath, 'TmpBitmapStream'); end; Из за этой ошибки временный файл создается не в '/storage/emulated/0/Android/data/<application ID>/files/tmp' (TPath.GetTempPath), а в '/storage/emulated/0/Android/data/<application ID>/files' (TPath.GetSharedDocumentsPath).
-
Евгений Корепов отреагировална ophion в [Android] Использование ACloseDialogProc в MessageDlg
Коротко объясню....
ACloseDialogProc - это процедура-обработчик результатов, полученных при помощи MessageDlg, поскольку в этой версии RAD XE7 все диалоги являются не блокирующими, т.е. во время показа диалога, продолжается выполнение следующих строк кода.
Вам необходимо объявить новую процедуру, которая будет вызываться после нажатия любых кнопок в MessageDlg.
Т.е. будет что-то вроде
procedure TForm1.doSomethingWithDialogResult(const AResult: TModalResult); begin if AResult=mrYes then begin {тут обработка нажатия кнопки Yes} end; end; а вызвать диалог необходимо следующим образом
MessageDlg('Тут текст сообщения', TMsgDlgType.mtConfirmation, mbYesNo, 0, doSomethingWithDialogResult); -
Евгений Корепов получил реакцию от Равиль Зарипов (ZuBy) в Доработка компонента для чтения штрих-кодов под RAD XE7
Я вот так у себя сделал:
procedure TFormMain.CButtonScanClick(Sender: TObject); begin If IsAppInstalled('com.google.zxing.client.android')Then TKRBarCodeScanner.Scan Else OpenURL('https://play.google.com/store/apps/details?id=com.google.zxing.client.android&hl=ru'); end; function TFormMain.IsAppInstalled(const AAppName: string): Boolean; var PackageManager: JPackageManager; begin PackageManager := SharedActivity.getPackageManager; try PackageManager.getPackageInfo(StringToJString(AAppName), TJPackageManager.JavaClass.GET_ACTIVITIES); Result := True; except on Ex: Exception do Result := False; end; 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; -
Евгений Корепов отреагировална ruslan в [Android] [XE7] Потоки
посмотри. может что интересное найдешь )
стр. 129
Delphi Cookbook.pdf
-
Евгений Корепов отреагировална Martifan в Получить голос из микрофона потоками
Доброго времени сутки
недавно для себя открыл что можно из микрофона получить данные потоками:
Uses ..., Androidapi.JNI.Media; procedure TForm1.Button1Click(Sender: TObject); var bufferSize: integer; buffer: TJavaArray<Byte>; M: TMemoryStream; begin audioRecord := TJAudioRecord.JavaClass.init(TJMediaRecorder_AudioSource.JavaClass.MIC, 44100, TJAudioFormat.JavaClass.CHANNEL_IN_MONO, TJAudioFormat.JavaClass.ENCODING_PCM_16BIT, 44100 * 2); (audioRecord as JAudioRecord).startRecording; buffer := TJavaArray<Byte>.Create(8820); (audioRecord as JAudioRecord).read(buffer, 0, 8820); (audioRecord as JAudioRecord).stop; audioRecord.release; buffer заполняется данными я проверил все работает (можно код прописать чтобы этот buffer проигрывал)
audioRecord := TJAudioRecord.JavaClass.init(TJMediaRecorder_AudioSource.JavaClass.MIC, 44100, TJAudioFormat.JavaClass.CHANNEL_IN_MONO, TJAudioFormat.JavaClass.ENCODING_PCM_16BIT, 44100 * 2); <--- как мне кажется здесь видно что это формат Wave
я пытаюсь передать это все серверу:
IdUDPClient1.SendBuffer(IdUDPClient1.Host, IdUDPClient1.Port, RawToBytes(buffer, buffer.Length)); сервер запущен на Windows но не получается я слышу только пикание
Вопрос:
как мне передать этот поток серверу (среды Windows) и как его проигрывать на сервере, может у кого есть опыт работы с этом сфере или какой нибудь документация имеется или какой нибудь предложение есть как все это сделать все совете и предложении очень важен
Заранее спасибо согласитесь интересно использовать микрофон так и не дожидая пока он создаст файл
всем удачи
-
Евгений Корепов отреагировална ruslan в Решение Segmentation fault(11). Или "Axe beats in the balls"
Добрый день всем тем несчастным кто пишет на фаирманки.
Если ваше приложение (под андроид) делает больше, чем приложения из папки Samples, если оно содержит не только ButtonClick и Memo, то, наверняка, вы постоянно наблюдаете мою "любимую" ошибку при закрытии приложения: Segmentation fault(11).
Если Вам надоело править исходники из папки {XE7}\Source, если ваше приложение ну никак не хочет полностью выгружаться и висит в фоновых процессах,
покажу Вам свое решение данной, мягко говоря, проблемы.
Подключаем к проекту приложенный .pas и в нужном месте кода(желательно на OnClose главной формы) юзаем процедуру KillMe.
Теперь Ваше приложение всегда будет выгружаться из памяти, а также запускаться с 1-го раза.
п.с. Если посмотреть исходники, то можно понять смысл названия топика.
uVedroProcess.zip
-
Евгений Корепов отреагировална ildvild в [Windows] TnTRayIcon не визуальный компонент обеспечивающий управление значком в области System Tray
Nix0N, спасибо за компонент.
Не хватает проверок на наличие событий
if Assigned(mOnClick) then mOnClick(nil);