Перейти к содержанию
Fire Monkey от А до Я

Евгений Корепов

Пользователи
  • Постов

    738
  • Зарегистрирован

  • Посещение

  • Победитель дней

    100

Активность репутации

  1. Like
    Евгений Корепов отреагировална Brovin Yaroslav в Delphi XE8 автозагрузка приложения в Android   
    Haword прав. 
    Обратите ваше внимание на строчку в манифесте:
    <receiver android:name="com.embarcadero.firemonkey.notifications.FMXNotificationAlarm" /> Это аналогичный вашему ресивер. name указывает, что ресивер FMXNotificationAlarm находится в пакетах: "com.embarcadero.firemonkey.notifications". 
  2. Like
    Евгений Корепов отреагировална haword в Delphi XE8 автозагрузка приложения в Android   
    ну вообще то надо задать java класс а указано - .BootReceiver
  3. Like
    Евгений Корепов отреагировална 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.
  4. Like
    Евгений Корепов получил реакцию от 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.
  5. Like
    Евгений Корепов отреагировална krapotkin в [Отклонение] [Android] Не меняется KeyboardType при переходе на следующий TEdit   
    этот ответ можно вынести на главную страничку и закрыть все темы форума разом )))
  6. Like
    Евгений Корепов отреагировална 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;
  7. Like
    Евгений Корепов отреагировална 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
  8. Like
    Евгений Корепов получил реакцию от Алмаз Амангельды в Сообщения чата в виде сообщений в 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.
  9. Like
    Евгений Корепов получил реакцию от 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.
  10. Like
    Евгений Корепов отреагировална Martifan в Как поменять надписи для кнопок в MessageDlg?   
    Извините я сам нашел решение если кому пригодится:
     
    1. находим файл FMX.Consts.pas
    2. Положи его в папку с проектом.
    3. Menu Project->Add to Project - добавь этот файл.
    4. Сохрани проект. Закрой проект. Открой проект заново.
    5. Menu -> Project -> Build All Project
    6. Запускаем.
  11. Like
    Евгений Корепов отреагировална Brovin Yaroslav в TServerSocket TClientSocket в FireMonkey   
    Ребята, форум существует для ответов на любые вопросы. Если вы считаете, что автор вопроса поленился и не захотел попробовать найти информацию, НЕ пишите и не отвечайте ему, если вам не хочется. Чем разводить бессмысленные словесные перепалки. Эмоции здесь совершенно ни к чем.
     
    Спасибо за понимание
  12. Like
    Евгений Корепов отреагировална Равиль Зарипов (ZuBy) в [Android/Win] Клиент для fire-monkey.ru [разработка]   
    Разработка продолжается
     
    Полностью перевел приложение на XML RPC API (демо и исходник тут) Авторизация (если её можно так назвать) Информация о пользователе из профиля (добавлена информация о возрасте +незначительные улучшения кода) Обновил немного дизайн Кэширование данных пользователя и навигации форума (самостоятельное обновление когда это требуется) Используется OXml для Android Кэширование всех картинок пользователей (на данный момент это ~1200 юзеров, НО не все юзеры имеют фотографии) Кэшируется всё на внешнюю память Теперь можно открывать "сайт" из профиля юзера (для Windows с окном уведомления) в ближайшее время собираюсь реализовать
    Доделать навигацию по веткам (как только пойму почему косяк с TTreeView) Кэширование всех картинок пользователей разработать иконку и сплеш картинку (может её и вовсе уберу) много чего... Проект также open-source, помощь приветствуется
     
    исходники выкладываю без бинарников, бинарники лежат на google диске в соответствующих папках (но синхронизация не всегда включена )
     
    FireMonkey.ru.zip
     


  13. Like
  14. Like
    Евгений Корепов отреагировална 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.
     
    Спасибо
     
  15. Like
    Евгений Корепов отреагировална 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);
  16. Like
    Евгений Корепов отреагировална Виктор в Сокращается текст в компоненте TLabel   
    Комрад, в nextSettings отключи trimming и WordWrap. Скорей всего поможет. И имей ввиду что тоже текст в win7, win xp, win server может иметь фактически разную длину)
  17. Like
    Евгений Корепов отреагировална bigjorj в Ошибка в FMX.Graphics.Android   
    Да с GetCachePath работает без нареканий.
    Могу обмануть, но этот механизм используется только для анройда 5 версии. Это способ исправления бага при котором приложения на XE7 висли при попытке вывода картинки из TStream. А здесь сначала записывается в файл, а потом считывается уже в контрол. А то что вы показали, это элемент стиля. 
  18. Like
    Евгений Корепов отреагировална bigjorj в Ошибка в FMX.Graphics.Android   
    А я думал что только у меня такая ошибка проявляется...
     
    У меня нормально заработало только с такой строкой
    Result := TPath.Combine( TPath.GetCachePath , 'TmpBitmapStream'); В tempPah все равно периодически выдавало ошибку прав доступа.
     
    Причем установил приложение -вываливается с ошибкой. Перезапускаешь устройство начинает работать...
  19. Like
    Евгений Корепов получил реакцию от 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).
     
     
  20. Like
    Евгений Корепов отреагировална 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);
  21. Like
    Евгений Корепов получил реакцию от Равиль Зарипов (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;
  22. Like
    Евгений Корепов отреагировална ruslan в [Android] [XE7] Потоки   
    посмотри. может что интересное найдешь )
    стр. 129  
    Delphi Cookbook.pdf
  23. Like
    Евгений Корепов отреагировална 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) и как его проигрывать на сервере, может у кого есть опыт работы с этом сфере или какой нибудь документация имеется или какой нибудь предложение есть как все это сделать все совете и предложении очень важен 
     
    Заранее спасибо согласитесь интересно использовать микрофон так и не дожидая пока он создаст файл
    всем удачи
  24. Like
    Евгений Корепов отреагировална ruslan в Решение Segmentation fault(11). Или "Axe beats in the balls"   
    Добрый день всем тем несчастным кто пишет на фаирманки.
    Если ваше приложение (под андроид) делает больше, чем приложения из папки Samples, если оно содержит не только ButtonClick и Memo, то, наверняка, вы постоянно наблюдаете мою "любимую" ошибку при закрытии приложения: Segmentation fault(11).
    Если Вам надоело править исходники из папки {XE7}\Source, если ваше приложение ну никак не хочет полностью выгружаться и висит в фоновых процессах, 
    покажу Вам свое решение данной, мягко говоря, проблемы.
     
    Подключаем к проекту приложенный .pas и в нужном месте кода(желательно на OnClose главной формы) юзаем процедуру KillMe.
    Теперь Ваше приложение всегда будет выгружаться из памяти, а также запускаться с 1-го раза.
     
     
    п.с. Если посмотреть исходники, то можно понять смысл названия топика.
     
    uVedroProcess.zip
  25. Like
    Евгений Корепов отреагировална ildvild в [Windows] TnTRayIcon не визуальный компонент обеспечивающий управление значком в области System Tray   
    Nix0N, спасибо за компонент.
    Не хватает проверок на наличие событий
        if Assigned(mOnClick)      then mOnClick(nil);
×
×
  • Создать...