Доска почета


Popular Content

Showing most liked content since 13.09.2017 Во всех областях

  1. 10 likes
    Для одного проекта писал такое пару месяцев назад, пользуйтесь.Под 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.
  2. 5 likes
    ну вот такая есть штука у меня Это нативные окошки пока только под андроид NativeView.zip
  3. 4 likes
    Мобильное приложение для курьера службы доставки. Приложение не самостоятельное, работает с системой автоматизации Tillypad XL. Возможности: получение и отображение информации о назначенных (выполненных) заказах курьера уведомления о новых заказах и изменениях в текущих просмотр информации о заказе (клиент, адрес, дата доставки, сумма и состав заказа) изменение статусов заказа, а так же времени, требуемого для доставки отображение заказа (всех заказов) на карте прокладка маршрута до клиента в навигаторе (Google, Yandex, 2GIS) связь с клиентом (оператором) - передача номера телефона или заказ обратного вызова через АТС отправка на сервер информации по фактическому маршруту курьера до клиента, а так же его местонахождения Активно разрабатывается взаимодействие с ККТ, для выдачи фискального чека клиенту в момент расчета. Приложение написано в RAD Studio Berlin 10.1 (Delphi). Огромное СПАСИБО: Ярослав Бровин - компоненты FGX (fgActivityDialog, fgToast, fgActionSheet), Равиль Зарипов - ModernListView, Андрей Ефимов - CustomActivityEvent
  4. 4 likes
    Исходный код TCustomWebBrowser.FormHandleCreated исправлен? На всякий случай - привожу сам код исправления. Файл FMX.WebBrowser.pas необходимо скопировать из исходников студии себе в проект, положив его рядом с dpr. И уже в нем сделать метод FormHandleCreated следующего вида (часть проверок 100% лишняя, но когда менял - подумал "пусть будет"): procedure TCustomWebBrowser.FormHandleCreated(const Sender: TObject; const Msg: TMessage); var WBService: IFMXWBService; begin if not Assigned(Self) then Exit; if not Assigned(Self.Root) then Exit; if Sender <> Self.Root.GetObject then Exit; if not(csDesigning in ComponentState) and TPlatformServices.Current.SupportsPlatformService(IFMXWBService, WBService) then // if not Assigned(FWeb) then begin if FWeb <> nil then WBService.DestroyWebBrowser(FWeb); FWeb := nil; // possibly, this not needed... FWeb := WBService.CreateWebBrowser; FWeb.SetWebBrowserControl(Self); FWeb.UpdateContentFromControl; FWeb.URL := FURL; FWeb.Navigate; end; end;
  5. 3 likes
    Вот набросал на скорую руку примерчик (может конечно не идеальный пример, но сегодня что-то голова совсем деревянная) 111.zip
  6. 3 likes
    В информации о пользователе слева от вопроса или ответа неправильный падеж слова публикация
  7. 3 likes
  8. 2 likes
    Переключил режим Энергосбережения с Оптимальный на Отключено и сразу проблема с коннектом пропала
  9. 2 likes
    Проблема в MUI. Предполагаю, что надо искать решение в запросе разрешений на уведомления, разбудить телефон, показать приложение поверх других окон, еще что-нибудь такое. Потому что в MUI большой упор на энергосбережение, безопасность и спам. Я замучился уже с MUI, не для разработчиков ось =)
  10. 2 likes
    есть событие OnTap - там можно считать. а интерес - только заинтересованность в рекламе так в правилах четко и написано. https://support.google.com/admob/answer/2753860
  11. 2 likes
    Попробовал реализовать стилем - никаких проблем не возникло: object TEllipse StyleName = 'ButtonEllipseStyle' Align = Center Size.Width = 256.000000000000000000 Size.Height = 191.000000000000000000 Size.PlatformDefault = False object TColorAnimation Duration = 0.500000000000000000 Inverse = True PropertyName = 'Fill.Color' StartValue = x00808080 StopValue = xAF808080 Trigger = 'IsMouseOver=true' TriggerInverse = 'IsMouseOver=false' end end UPD! Мммда... Насчет проблем я поторопился... Для того чтобы отследить клик по кнопке надо переопределить клик для TEllipse в стиле: procedure TForm1.btnTestApplyStyleLookup(Sender: TObject); var el: TEllipse; begin if TStyledControl(btnTest).FindStyleResource<TEllipse>('ButtonEllipseStyle', el) then el.OnClick := btnTestClick; end;
  12. 2 likes
    Официальное название: Тинькофф Официальный сайт: http://tinkoff.ru Платформы: Android, iOS
  13. 2 likes
    В принципе, проблем не было пока. Обертка нормально создалась, почистили от "лишнего", что связано с интерфейсом. Настройки заполняем самостоятельно, вроде, все работает. Проверяли только BT, до USB пока не дошли. Как отладим работу с ФР, перейдем к платежному терминалу (60Ф). Ну и оформим класс для удобной работы, и выложим на форум, вдруг кому пригодиться.
  14. 2 likes
    Если баннер отображается, то в самом приложении больше ничего делать не надо. Анализировать события в том числе. По клику пользователя на баннере гугл будет автоматически зачислять какую-то сумму на ваш аккаунт в AdMob. Естественно, вашим приложением должны пользоваться люди, то есть приложение должно быть размещено в магазине приложений Google Play или на других площадках.
  15. 2 likes
  16. 2 likes
    Вопрос решился применением обновления Delphi до 10.1 Update 2
  17. 2 likes
    ENERGY Для получения всех активных уведомлений в Android существует метод: getActiveNotifications added in API level 23 StatusBarNotification[] getActiveNotifications () FMX (Berlin и ниже точно, Tokyo не смотрел) не предоставляет доступ к этому методу, в исходниках (Androidapi.JNI.App.pas) он закомментирован. Возможно при использовании своего wrapper для класса JNotificationManager или отсюда можно получить доступ к требуемому функционалу.
  18. 1 like
  19. 1 like
    sl->Strings[i] или sl[i] http://docwiki.embarcadero.com/RADStudio/Berlin/en/Accessing_a_Particular_String
  20. 1 like
    Спустя полгода решение проблемы все-таки нашлось. Благодарю эксперта kami!
  21. 1 like
    Официальное название: Delivery Club Официальный сайт: https://www.delivery-club.ru/ Платформы: Android, iOS
  22. 1 like
    Может и банально, но соответствует критериям... Официальное название: whatsapp Официальный сайт: https://www.whatsapp.com/ Платформы: Android, iPhone, Компьютеры Mac или Windows, Windows Phone
  23. 1 like
    Официальное название: 2ГИС Официальный сайт: https://2gis.ru/ Платформы: Android, iOS
  24. 1 like
    Официальное название: Банк Астана Официальный сайт: https://www.bankastana.kz/ Платформы: Android, iOS
  25. 1 like
    считать можно. там вроде есть событие onClick - там и можно считать. но за клик никаких баллов (пусть и внутри только приложения) начислять нельзя - это прямо противоречит правилам программы AdSense и AdMob. за это забанят пожизненно и никакая апелляция не поможет. плюс могу забанить за недействительные клики, когда с одного устройства будет много кликов (накрутка). даже если это сделает ваш конкурент - вас могут забанить. забанить могут даже за частые показы на одном и том же устройстве. поэтому показ и клики нужно продумать - допустим не более 10 показов и не более 5 кликов за сеанс. Нужно себя обезопасить, чтобы потом можно было доказать Гуглу, что вы настроены на честный зароботок п.с. в AdMob есть видеореклама с вознаграждением. вот за просмотр (!) этой рекламы можно будет начислять какие-то баллы. но TBannerAd ее не поддерживает (как и модуль, который тут есть для межстраничной рекламы)
  26. 1 like
    с нового года пользуюсь приложением для подсчета расходов на автомобиль. довольно неплохое приложение Авто Расходы - Car Expenses
  27. 1 like
    Soccerstand (результаты матчей онлайн) http://www.soccerstand.com Android
  28. 1 like
    Удалось зашифровать и дешифровать текст в трех ЯП Delphi, PHP, GoLang PHP. Используется phpseclib v1.0.7 <?php // phpseclib 1.0.7 // http://phpseclib.sourceforge.net set_include_path('phpseclib'); include('Crypt/AES.php'); $my_key = 'HJORNYCZJXJBUGOA'; $my_iv = '1234567890ABCDEF'; $text = 'Проверка UTF8 текста'; $cipher = new Crypt_AES(); // CRYPT_AES_MODE_CBC $cipher->setKeyLength(128); $cipher->setKey($my_key); $cipher->setIV($my_iv); echo base64_encode($cipher->encrypt($text)).PHP_EOL; Delphi. Использую TMS Cryptography Pack uses CryptBase, AESObj, MiscObj; function AesEncryption:String; var AES: TAESEncryption; begin AES := TAESEncryption.Create(nil); try AES.AType := atCBC; AES.KeyLength := kl128; AES.OutputFormat := base64; AES.Key := 'HJORNYCZJXJBUGOA'; AES.IVMode := AESObj.userdefined; AES.IV := '1234567890ABCDEF'; result := AES.Encrypt('Проверка UTF8 текста'); finally AES.Free; end; end; GoLang. Все родное. Запустить в песочнице package main import ( "bytes" "crypto/aes" "crypto/cipher" "encoding/base64" "fmt" ) func PKCS5Padding(src []byte, blockSize int) []byte { padding := blockSize - len(src)%blockSize padtext := bytes.Repeat([]byte{byte(padding)}, padding) return append(src, padtext...) } func PKCS5UnPadding(src []byte) []byte { length := len(src) unpadding := int(src[length-1]) return src[:(length - unpadding)] } func AesEncryption(key, iv, plainText []byte) ([]byte, error) { block, err := aes.NewCipher(key) if err != nil { return nil, err } blockSize := block.BlockSize() origData := PKCS5Padding(plainText, blockSize) blockMode := cipher.NewCBCEncrypter(block, iv) cryted := make([]byte, len(origData)) blockMode.CryptBlocks(cryted, origData) return cryted, nil } func AesDecryption(key, iv, cipherText []byte) ([]byte, error) { block, err := aes.NewCipher(key) if err != nil { return nil, err } blockMode := cipher.NewCBCDecrypter(block, iv) origData := make([]byte, len(cipherText)) blockMode.CryptBlocks(origData, cipherText) origData = PKCS5UnPadding(origData) return origData, nil } func main() { originalText := "Проверка UTF8 текста" fmt.Println(originalText) mytext := []byte(originalText) key := []byte("HJORNYCZJXJBUGOA") iv := []byte("1234567890ABCDEF") cryptoText, err := AesEncryption(key, iv, mytext) if err != nil { fmt.Println(err) } fmt.Println(base64.StdEncoding.EncodeToString(cryptoText)) decryptedText, _ := AesDecryption(key, iv, cryptoText) fmt.Println(string(decryptedText)) } К сожалению бесплатной либы для Delphi, чтоб работало в WIN и Android не нашел.
  29. 1 like
    Вопрос отменяется. Как всегда документация говорит одно, код- другое, подразумевается третье. Для Tokyo актуален заголовок // запуск встроенной функции регистрации соединения Procedure onCalculateConnectionRegister(AFunc: TSQLiteFunctionInstance; AInputs: TSQLiteInputs; AOutput: TSQLiteOutput; var AUserData: TObject); В примере невнимательно посмотрел. ))) Хотя в официозе в примере: http://docwiki.embarcadero.com/CodeExamples/Tokyo/en/FireDAC.SQLite_Sample procedure TfrmGettingStarted.sqlFunctionCalculate(AFunc: TSQLiteFunction; AInputs: TSQLiteInputs; AOutput: TSQLiteOutput; var AUserData: TObject);
  30. 1 like
    Столкнулся с такой же проблемой. Использую «RAD Studio 10 Seattle». Каждый раз, когда у TMediaPlayer задаешь новый FileName, идёт утечка памяти – это баг Firemonkey. Скорее всего, ошибка находится в файле «FMX.Media.pas». Как исправить эту ошибку? Что и как исправлять в файле «FMX.Media.pas»? Проверил на «RAD Studio 10.2 Tokyo» - проблема утечки памяти тоже присутствует. Просто в цикле задаешь новый (или даже тот же самый) TMediaPlayer.FileName, и каждый раз идёт утечка памяти, и очень скоро программа падает из-за недостатка памяти. Функция TMediaPlayer.Clear не помогает, ибо память не освобождается. Из-за этого бага TMediaPlayer является неработоспособным и TMediaPlayer просто невозможно использовать в реальных проектах. Как решить эту проблему?
  31. 1 like
    Эксперементировал на разных формах, кидал WebBrowser в дизайнере на форму, создавал динамически, загружал страницы в потоке... пока не удалось победить. Зависания могли быть и при вызове календаря, интентах. НО после использования браузера.
This leaderboard is set to Москва/GMT+03:00