Доска почета


Popular Content

Showing most liked content since 01.04.2017 in Сообщения

  1. 16 likes
    Эх, попкорн закончился) Доброго вечера всем. Вот вы тут развели ср..., прям диву даешься. Неужели тут кто то всерьез верит, что Rad Studio похоронят - вы чего? СМена кадровой политики - абсолютно нормальное явление в любой организации, которая не сидит на месте. Другой вопрос - что послужило толчком? Но не суть. Тут прочитал - вот мол никто на FMX не пишет - вы судите по тому, сколько информации (удивленный смайл). Неужто кто то всерьез думает, что солидные компании, которые базируются на Rad Studio, будет трубить на каждом углу - смотрите, у нас софт написан на Rad Studio? (если быть точным, то с использованием, не придирайтесь)) ЗАЧЕМ оно им? С такой ценовой политикой, достаточно нескольких сотен пользователей для безбедной жизни, хотя думаю их в разы больше. А вот про баги и тд - улыбнуло. Есть у меня опыт небольшой работы и с FMX под ANdroid, и куда больший по десктоп, естественно под VCL. Есть опыт с плюсами и шарпом на Visual Studio тоже под десктоп. Ну и Qt немного. И судя по своему скромному опыту, еще вопрос - где больше багов, когда начинаешь копать глубже. Тута вон галку снял, и софт с 99% уверенностью запустится у всех, а Visual Studio - без опыта, один процесс настройки зависимостей проекта в новых версиях - тот еще гемморой. А потом начинаешь пользователям долбить - скачайте рантайм, а вот еще ддлку эту, а у вас версия Фреймворка не та))) Адекватно собрать статически слинкованный Qt мне так и не удалось, точнее удалось под MinGW - не впечатлило. Похоже многие забыли - FMX, Rad, Visual, pascal, c++, c#, и тд, и тп - это только инструмент, все зависит от того, кто его держит. Kitty - мне очень интересно - отчего такая потребность - закопают или нет? А кто мешает перебраться, в случае необходимости в другую среду - знания то лишними не будут. Напоминает покупку первой машины - месяцами выбирают (количество критериев зашкаливает - и чтоб то не сломалось, и не устарело, и тд), в итоге покупается что то непотребное, просто из-за подхода, при этом количество нервов потраченных...) вы же не на всю жизнь покупаете) Так и тут - ну случится беда, закопают - так правильно сказали: может через пару лет и Андроид гавкнет - что теперь не писать под него. В крайнем случае можно на время перебирания в другую среду остаться на старой версии. Хотя, вынужден извиниться, возможно у вас действительно вперед смотрящие, долгосрочные проекты, тогда стоит думать сейчас (ни в коем случае не сарказм). Но положа руку на сердце, поверьте - выбор то не велик, к сожалению, когда дело доходит до чего - то большего, чем Hello World. P.S. не первый год пытаюсь переползти в Visual Studio - именно написание кода там куда более комфортное, но увы - так и не смог) сошелся на Dll-ках, из Visual Studio, и основе в Rad Studio - довольно удобно и комфортно.
  2. 8 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.
  3. 7 likes
    Первый набросок компонента, позволяющего организовать централизованное хранение графических ресурсов для всех платформ. Основные особенности: Спроектирован для использования одного экземпляра изображения во многих компонентах. Позволяет хранить все графические ресурсы любых размеров. В будущем не будет грузить картинки в память, если они не используются. А будет подгружать их из файла по мере необходимости. Тем самым будет значительно экономиться память. Хранение именованных графических ресурсов, а не по индексу. Это позволяет отразить в названии назначение картинки. Использование папок. Группировка изображений по смыслу для удобства работы с ними. Возможность загрузки разных картинок для разных устройств, или же загрузить один набор картинок для всех устройств. Удобная и быстрая загрузка изображений путем перетаскивания Хранение отступов изображения. Наглядное отображение картинки в свойствах компонентах. При изменении имени картинки, в компонентах используемых картинку идет автоматическое обновление имени картинки. В стандартном TImageList, из-за индексной структуру все картинки съезжают и при удалении картинки, компонент начинает отображать уже другую картинку.
  4. 7 likes
    вопрос закрыт. все получилось. с ардуино получаю и отправляю данные ничего такого особо интересного - я делаю экструдер
  5. 6 likes
    Доброго времени суток уважаемые пользователи форума! Часто в постах Вы делаете отсылку(упоминание) на пользователя, но как правило делается это не правильно. Я записал небольшое видео, которое поможет сделать это правильно При упоминании пользователя, он получает уведомление (даже если он не подписан на эту тему) и сможет быстрее ответить на вопрос Удачи!
  6. 5 likes
    Нормативная документация (устав, цели, программа) Актуальные вопросы на предстоящую повестку дня на какой-нибудь сессии Обращения от граждан (хотя они гораздо чаще идут на конкретного представителя) "Внутреннее" голосование по какому-нибудь разрабатываемому документу / согласование уполномоченными должностными лицами А вообще - лучше всего уточнить у заказчика. Не "какой функционал должен быть у приложения" , "дайте ТЗ", а "давайте вместе подумаем / пофантазируем - вот у нас есть мобильное приложение. И мы будем его использовать для / чтобы ...". Причем это лучше делать не в письменной форме, а при личной встрече (при наличии такой возможности).
  7. 5 likes
    после долгих мучений нашёл проблему. баг в деплойменте. файл не деплоится если в имени файла есть символ подчёркивания _ ! почему я не проверил сразу т.к. почти все файлы аппликации содержат этот символ а то и два. я вообще-то и взял файл для проверки один из стандартных. но они проходят на ура а файлы которые идут в документс не проходят. спасибо всем кто помогал.
  8. 5 likes
    Я поступил проще - на Токио пока даже и не пробовал переходить... Берлин работает, как работает - устраивает. Пока Токио не допилят, пока об этом все не напишут, и пока не появится как минимум первый апдейт - даже и пробовать не буду. Политика Embarcadero мне понятна. Искренне надеюсь, что им хватит ума и бюджета на то, чтобы развивать продукт. Оставался и остаюсь приверженцем Delphi, и во многих случаях ему просто нет объективной замены/альтернативы. Но кидаться "в омут" (на каждую новую версию) - желания нет.
  9. 5 likes
    Ссылка: http://delphifmandroid.blogspot.ru/2017/04/onrequestpermissionsresult.html Автор: Андрей Ефимов Описание:
  10. 5 likes
    Ссылка: http://blog.rzaripov.kz/2017/04/android.html Автор: @Равиль Зарипов (ZuBy) Описание: Устанавливаем тему для нативных диалогов в Android
  11. 5 likes
    картинка из примера Загружаем её в BitmapListAnimation настройка BitmapListAnimation ну и не забываем BitmapListAnimation1.Enabled := true;
  12. 5 likes
    Создание Android приложений с NDK R13 Не мог смириться с суевериями ), и решил сам проверить. Delphi не дружит с линкером (компоновщиком) версии 4.9, а с 4.8 дружит нормально. Все остальное на вкладке NDK использую из последнего релиза. С сегодняшнего дня, я живу вот так: PS: Интересно, если компоновщик брать из каталога другой архитектуры, приложения заработают корректно на устройствах с Intel?
  13. 5 likes
    у @Andrey Efimov есть статья от себя: 1) это качать с сервера (неважно с какого, хоть с облака) 2) инкрементное имя для базы, файла и тд. сейчас объясню: папка с файлами test_1.db test_2.db test_3.db всегда брать файл с большей циферкой, а другие например удалять. (как будут в эту папку попадать файлы не важно, деплой или скачивание) может не лучший вариант, зато кроссплатформенный
  14. 5 likes
    Иконка изменится внутри приложения в рамах текущего контекста до ее завершения. С других приложений и в системе ничего не поменяется (см. прикрепление). Чтобы не влиять на другой функционал, достаточно сделать следующее: //запоминаем ид по умолчанию lDefaultId := TAndroidHelper.Context.getApplicationInfo.icon; //устанавливаем нашу кастомную иконку TAndroidHelper.Context.getApplicationInfo.icon := lId; //создаем локальное уведомление NotificationCenter.PresentNotification(lNotification); //возвращаем обратно TAndroidHelper.Context.getApplicationInfo.icon := lDefaultId; п.с. Если такой вариант не устраивает, всегда можно написать class helper for TBaseNotificationCenter и использовать классы JNotificationCompat_Builder, JNotificationManager, JNotification. Справка из developer.android.com.
  15. 4 likes
    это не случайные символы. и создаете вы его сами, когда НАСЛЕДУЕТЕ master-форму для конкретных платформ и разрешений http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Using_FireMonkey_Views
  16. 4 likes
    http://stackoverflow.com/questions/2413426/playing-an-arbitrary-tone-with-android тут формируют буфер синусом и audioTrack = new AudioTrack(AudioManager.STREAM_MUSIC, sampleRate, AudioFormat.CHANNEL_CONFIGURATION_MONO, AudioFormat.ENCODING_PCM_16BIT, (int)numSamples*2, AudioTrack.MODE_STATIC); audioTrack.write(generatedSnd, 0, generatedSnd.length); // Load the track audioTrack.play(); ну или тут https://gist.github.com/slightfoot/6330866
  17. 4 likes
    Пришлось набирать весь код по видео. Если кому будет полезно, вот исходник PathAnim2.rar
  18. 4 likes
    А если решитесь писать свой, то присмотретьсь к App Tethering
  19. 4 likes
    Это приложение для OS Windows выполняет тягово-динамический расчёт транспортного средства (как проверочный так и проектный) с механической или автоматической коробкой передач а также троллейбуса (электробуса) с электродвигателем. Результаты в основном показаны в виде графиков. Можно исходные данные и результаты вывести в MSWord. В базу данных уже введены некоторые внешние характеристики двигателей и характеристики коробок передач и гидротрансформаторов. Пользователь может вводить свои данные и хранить их. Дополнительно можно производить некоторые расчёты на прочность деталей подвески и сохранять их в базе данных. Просто распакуйте архив. СпасиБО EMBARCADERO. Автор: Олег Киреев-ведущий инженер-конструктор, gelo1@tut.by, +375 29 676 13 84 БЕЛАРУСЬ, г.Минск. TDR.rar
  20. 4 likes
    Добрый день! Коллеги, хочу озвучить одну из причин, из-за которой может возникать ситуация " Иногда бывает что при вставке пути в TPath, компонент его отображает некорректно" Дело в том, что существуют сокращения в представлении данных и не все из низ TPath понимает, вот с чем столкнулся: Есть команда 'c' - рисование кривой. не буду вдаваться в подробности, можно найти в интернете описание, скажу только то, что данная команда содержит 6 чисел. В идеале должно быть: сX1 X2 X3 X4 X5 X6 Но очень часто (например в иконках Material Design) можно встретить: c-1.1 0-1.99.9-1.99 2 И на этой строчке парсер TPath падает с ошибкой, так как пытается сконвертировать '-1.99.9' в число, что не верно. В реальности данная запись соответствует двум числам -1.99 и 0.9. Для обхода проблемы я загружаю SVG в рантайме, и сроку пропускаю через корректор: function CorrectSVG(const Value: String): String; var SB : TStringBuilder; I: Integer; C : Char; begin SB := TStringBuilder.Create; try I := 0; for C in Value do begin if C='.' then Inc(I) else if not CharInSet(C, ['0'..'9']) then I := 0; if I=2 then begin SB.Append(' 0.'); I := 0; end else SB.Append(C); end; Result := SB.ToString; finally FreeAndNil(SB); end; end;
  21. 4 likes
  22. 4 likes
    Из PlatformSDK (PlatformSDKs\android-sdk-windows\sources\android-23\android\support\v4\content\) портировал в Delphi класс TJLocalBroadcastManager. Это очень полезный класс, если вы не хотите рассылать сообщения по всей системе, а есть необходимость общаться только внутри приложения или между хост-приложением и сервисом. Во вложении сам класс, в своем приложении убедитесь, что в Target Platforms (Android) → Android → Libraries включена библиотека android-support-v4.dex.jar. Прилагаю пример, для изучения и использования в работе, который демонстрирует работу обычного BroadcastReceiver и LocalBroadcastReceiver. В примере демонстрируется работа сообщений в приложении и сервисе. Сначала делаем build проекта LBCRService, потом будет доступна возможность собрать LocalBCR. Собираю в Berlin 10.1, но на младших версиях тоже должно работать, по крайней мере в Seatlle. В реализации методов procedure RegisterReceiver(); procedure UnRegisterReceiver(); необходимо снять комментарий с соответствующих строчек, в зависимости от того, какой тип ресивера вы хотите использовать. Androidapi.JNI.LocalBroadcastManager.pas.zip LocalBroadCastReceiver.zip
  23. 4 likes
    Под Android я делаю так. Вставляю изначально файл БД в Deploy. Потом вызываю при необходимости процедуру procedure TForm1.RefreshBD; { TODO -cKod : RefreshBD - обновление БД } var PackageName: JString; zip: TZipFile; begin // Отключаемся от базы FDConnection1.Connected := False; // Получаем имя apk файла PackageName := SharedActivityContext.getPackageResourcePath; if TFile.Exists(JStringToString(PackageName)) then begin // Удаляем старый файл базы TFile.Delete(TPath.GetHomePath + PathDelim + 'DBGK.db'); // Извлекаем новый файл базы zip := TZipFile.Create; zip.Open(JStringToString(PackageName), TZipMode.zmRead); zip.Extract('assets/internal/DBGK.db', TPath.GetDocumentsPath, False); zip.Close; zip.free; end; // Подключаемся к базе FDConnection1.Connected := True; end; Под iOS вставляю в ресурсы, потом вот так procedure TForm1.RefreshBD; { TODO -cKod : RefreshBD - обновление БД } begin // Отключаемся от базы FDConnection1.Connected := False; if FindResource(0, 'res_bd', PChar(RT_RCDATA)) <> 0 then rs_bd := TResourceStream.Create(0,'res_bd',PChar(RT_RCDATA)); if TFile.Exists(TPath.GetHomePath+PathDelim+'Documents'+PathDelim +'dbgkios.db') then begin TFile.Delete(TPath.GetHomePath+PathDelim+'Documents'+PathDelim +'dbgkios.db'); rs_bd.SaveToFile(TPath.GetHomePath+PathDelim+'Documents'+PathDelim +'dbgkios.db'); end else begin rs_bd.SaveToFile(TPath.GetHomePath+PathDelim+'Documents'+PathDelim +'dbgkios.db'); end; FDConnection1.Connected := True; end;
  24. 3 likes
    Периодически членам партии в пушах присылать призывы поддержать материально (из своего кармана) какое-нибудь благое начинание типа скинуться на: ремонт дороги, школы, больницы...
  25. 3 likes
    Подумайте о будущем, если проект будет развиваться и одной цифры ошибки станет не достаточно. Подумайте о наследниках-программистах (или о себе через пять лет) которые будут чесать репу и угадывать (вспоминать) что же означает каждая цифра ответа. Времена экономии каждого байта трафика прошли. Вспомните истории предшественников - 640 килобайт более чем достаточно для любого компьютера, 4294967296 ip адресов достаточно для всего человечества, размера MTU 1500 байт достаточно для TCP пакета в обозримом будущем, максимального размера файла в 4 гигабайта достаточно для любых нужд и вряд ли в будущем появятся накопители объемом более 9 терабайт (FAT32). Отдавая данные/результат в теле ответа в формате JSON вы развязываете себе руки и делаете задел на будущее. Вначале вам достаточно будет вот такого { "status" : true, "error" : 0 } потом возможно такое { "status" : false, "error" : 123, "errormessage" : "mysql deadlock in tables employments", } а потом еще что нибудь { "status" : true, "error" : 0, "errormessage" : "", "executiontime" : 304, "clastersource" : "bagama_server" } все эти добавления займут у вас одну-две строчки на php и одну-две строчки в приложении. При этом, вы сможете диагностировать ответ сервера, сидя на берегу моря, с помощью браузера вашего телефона.
  26. 3 likes
    function FileSize(const aFilePath: string): Int64; var vSR : TSearchRec; begin if FindFirst(aFilePath, faAnyFile, vSR ) = 0 then begin Result := vSR.Size; FindClose(vSR); end else Result := -1; end; Мультиплатформенный вариант без открытия файла (размер берется из файловой системы).
  27. 3 likes
    Во время добавления так же можно отключить обработчики ListView1.OnUpdatingObjects и(или) ListView1.OnUpdateObject (если у вас в них есть какой либо код). ListView1.BeginUpdate; ListView1.OnUpdatingObjects:=Nil; ListView1.OnUpdateObjects:=Nil; for i := 0 to List.Count - 1 do begin LVItems := ListView1.Items.Add; LVItems.Data['MyData']:=... ... end; ListView1.OnUpdatingObjects:=ListView1UpdateObjects; ListView1.OnUpdateObjects:=ListView1UpdatingObjects; ListView1.EndUpdate;
  28. 3 likes
    Например так: var path: TPathData; .......... Path:=TPathData.Create; Path.Clear; Path.MoveTo(PointF(x[0],y[0])); for i:=1 to N do Path.LineTo(PointF(x[i],y[i])); Path.ClosePath;
  29. 3 likes
    картинку желательно не загружать в базу а складывать в папку на сервере (и лучше всего сжать до нужных размеров) и в базу вписать лишь путь до файла вот мануалчик на пхп http://php.net/manual/ru/features.file-upload.post-method.php на delphi это просто составляем POST запрос aURL - путь до скрипта, который будет принимать файлы aFileName - полный путь до файла, который нужно отправить var aData: TMultipartFormData; aHTTP: THTTPClient; aResp: TStringStream; begin aResp := TStringStream.Create('', aEncoding); aData := TMultipartFormData.Create(); aHTTP := THTTPClient.Create; try try aData.AddFile('image', aFileName); // на php считываем по полю image aHTTP.Post(aURL, aData, aResp); Result := aResp.DataString; // тут скрипт должен что-то вернуть о успешном принятии except Result := TmyHTTPClient.ERROR_COMMON; // генерация своей ошибки, если что-то пошло не так end; finally FreeAndNil(aHTTP); FreeAndNil(aData); FreeAndNil(aResp); end;
  30. 3 likes
    да, T(Net)HTTPClient как раз и работает адекватно на всех платформах при запуске проверить функцией CheckInet, если нету доступа показать окно с прокси
  31. 3 likes
    Друзья, столкнулся с проблемой, описанной в посте Хочу предложить свое решение (может кому пригодится). Чтобы центр масштабирования был именно в центре объекта (в моем случае это TImage), необходимо после масштабирования установить свойство Align = TAlignLayout.Center, причем до этого нужно установить его в TAlignLayout.None ! Примерно вот так: Image1.Scale.X:= 1.3; Image1.Scale.Y:= 1.3; Image1.Align:= TAlignLayout.None; Image1.Align:= TAlignLayout.Center; В этом случае будет эффект увеличения объекта из центра. Если убрать строчку "Image1.Align:= TAlignLayout.None;" - увеличение будет из левого верхнего угла. На мой взгляд некорректное поведение платформы. Возможно в будущих релизах это поправят. Embarcadero® Delphi 10.1 Berlin Update 2 Version 24.0.25048.9432
  32. 3 likes
  33. 3 likes
    Добавил тестовый проект и серверную часть, статью по ссылке обновил https://github.com/rzaripov1990/PUSHTestFCM
  34. 3 likes
    Замените код на такой procedure TForm1.WebBrowser1DidStartLoad(ASender: TObject); var aThread: TThread; begin aThread := TThread.CreateAnonymousThread( procedure begin TThread.Synchronize(nil, procedure begin If CheckBox1.IsChecked Then Image1.Bitmap := WebBrowser1.MakeScreenshot; end) end); aThread.FreeOnTerminate := true; aThread.Start; end;
  35. 3 likes
    думаю, подойдет a:=lst1.ItemByPoint(10,0); b:=lst1.ItemByPoint(10,lst1.height);
  36. 3 likes
    Обратите внимание: 1) На пост Виталия с примером кода по скачиванию файла из Интернета 2) На пост Равиля, две темы, в одной есть ссылка на мою статью, во второй код из моей статьи 3) Совместите два этих пункта и получите Профит. p.s. Не забудьте, перед непосредственным обновлением файла (или раньше), необходимо отключиться от базы!
  37. 3 likes
    Я хоть не начинающий, но нет андроида и если и программирую для мобил, то только на iOs. Я это использую для десктопов. Я думаю, для андроида почти также. У вас должен быть доступ к серверу. Вы ложите туда готовый файлик с sql кодом. Там куча инсертов разделёных точно с запятой. Ты по http его закачиваешь. Я использую для этого indy, но для андроида, точно знаю его нельзя использовать, ибо так глюк какой то в 6 андроиде. Поэтому используй NetHTTPClient я делаю так: lStream1 := TMemoryStream.Create; form1.idhttp1.Get( 'http://твой сайт/file_base_update/'+'имя файла', lStream1); lStream1.SaveToFile(ExtractFilePath(ParamStr(0)) + 'имя файла' ); Я дальше забрасываю этот файлик в базу данных. Я не использую стандартную обертку, а использую от Devart- LiteDac. Но думаю и в fireDac есть тоже самое. Там есть LiteScript1 в него кидаешь файл sql с разделителями ; и он разом выполняется.
  38. 3 likes
    Ну, из всех вопросов - важен только первый. Остальное уже есть неоднократно. Пропиарю себя: https://github.com/kami-soft/SimpleTCPComponents
  39. 3 likes
    Вот мой юнит для работы с покупками в приложении: unit UnitInAppPurchase; interface uses // UnitGetDeviceInfo, FMX.InAppPurchase, System.Classes, System.SysUtils, System.Hash; //const // HashMixer = 'p345mcq34mq'; type TBillingEventPurchased = procedure(ASecretKey : String) of object; TBillingEventNotPurchased = procedure of object; TBillingLog = procedure(AMessage : String) of object; TBilling = class private InAppPurchase: TInAppPurchase; FBillingEventPurchased : TBillingEventPurchased; FBillingEventNotPurchased : TBillingEventNotPurchased; FBillingLog : TBillingLog; FNoAdsID : String; FSecretKey : String; FApplicationLicenseKey : String; procedure InAppPurchaseSetupComplete(Sender: TObject); procedure InAppPurchaseProductsRequestResponse(Sender: TObject; const Products: TIAPProductList; const InvalidProductIDs: TStrings); procedure InAppPurchaseError(Sender: TObject; FailureKind: TFailureKind; const ErrorMessage: string); procedure InAppPurchasePurchaseCompleted(Sender: TObject; const ProductID: string; NewTransaction: Boolean); procedure ConsumeComplete(Sender: TObject; const ProductID: string); procedure ConsumeFailed(Sender: TObject; const ProductID, ErrorMessage: string); function GetSecretKey : String; function CheckSecretKey : Boolean; procedure LogMy(AMessage : String); public // Constructor Create(AApplicationLicenseKey, ANoAdsID, ASecretKey : String); constructor Create(AApplicationLicenseKey, ANoAdsID : String); destructor Destroy; procedure CheckPurchase; procedure Purchase; // published property OnPurchased : TBillingEventPurchased read FBillingEventPurchased write FBillingEventPurchased; property OnNotPurchased : TBillingEventNotPurchased read FBillingEventNotPurchased write FBillingEventNotPurchased; property OnPurchasedError : TBillingEventNotPurchased read FBillingEventNotPurchased write FBillingEventNotPurchased; property OnLog : TBillingLog read FBillingLog write FBillingLog; end; implementation //Constructor TBilling.Create(AApplicationLicenseKey, ANoAdsID, ASecretKey : String); Constructor TBilling.Create(AApplicationLicenseKey, ANoAdsID : String); begin FNoAdsID:=ANoAdsID; FApplicationLicenseKey:=AApplicationLicenseKey; // FSecretKey:=ASecretKey; InAppPurchase:=TInAppPurchase.Create(Nil); InAppPurchase.ApplicationLicenseKey:=FApplicationLicenseKey; InAppPurchase.ProductIDs.Add(FNoAdsID); InAppPurchase.OnSetupComplete := InAppPurchaseSetupComplete; InAppPurchase.OnProductsRequestResponse := InAppPurchaseProductsRequestResponse; InAppPurchase.OnError := InAppPurchaseError; InAppPurchase.OnPurchaseCompleted := InAppPurchasePurchaseCompleted; InAppPurchase.OnConsumeCompleted := ConsumeComplete; InAppPurchase.OnConsumeFailed := ConsumeFailed; end; Destructor TBilling.Destroy; begin if Assigned(InAppPurchase) then FreeAndNil(InAppPurchase); inherited; end; procedure TBilling.Purchase; begin try InAppPurchase.PurchaseProduct(FNoAdsID); except LogMy('PurchaseProduct except'); end; end; procedure TBilling.CheckPurchase; begin if CheckSecretKey Then begin LogMy('CheckSecretKey True - Disable Ads'); FSecretKey:=GetSecretKey; if Assigned(OnPurchased) then OnPurchased(FSecretKey); Exit; end; LogMy('CheckSecretKey False - Check InAppPurchase status'); InAppPurchase.SetupInAppPurchase; end; function TBilling.GetSecretKey : String; Var ADeviceIMEI : String; begin // Это был костыль для хранения флага о покупке локально, не оправдал себя и изъят из обращения // ADeviceIMEI:=GetDeviceIMEI; // Result:=System.Hash.THashSHA1.GetHashString(HashMixer+ADeviceIMEI+FNoAdsID); end; function TBilling.CheckSecretKey : Boolean; begin Result:=False; // Result:=FSecretKey.Equals(GetSecretKey); end; procedure TBilling.InAppPurchaseSetupComplete(Sender: TObject); begin LogMy('InAppPurchaseSetupComplete'); try LogMy('InAppPurchase.QueryProducts'); InAppPurchase.QueryProducts; except on E:Exception do LogMy('QueryProducts Exception: '+e.Message); end; end; procedure TBilling.InAppPurchaseProductsRequestResponse(Sender: TObject; const Products: TIAPProductList; const InvalidProductIDs: TStrings); var Product: TProduct; begin LogMy('TMainForm.InAppPurchaseProductsRequestResponse'); LogMy('Start search '+FNoAdsId); LogMy('Products.Count='+Products.Count.ToString); for Product in Products do begin LogMy('Start search '+FNoAdsId); if Product.ProductID = FNoAdsId then begin LogMy('Founded '+FNoAdsId); if InAppPurchase.IsProductPurchased(FNoAdsId) then begin // КУПЛЕНО!!!! LogMy(FNoAdsID+' Yes ProductPurchased'); FSecretKey:=GetSecretKey; if Assigned(OnPurchased) then OnPurchased(FSecretKey); end Else begin LogMy(FNoAdsID+' Not ProductPurchased'); if Assigned(OnNotPurchased) then OnNotPurchased; end; Exit; end; end; LogMy('Product not found - OnNotPurchased'); if Assigned(OnNotPurchased) then OnNotPurchased; LogMy('TMainForm.InAppPurchaseProductsRequestResponse END'); end; procedure TBilling.InAppPurchaseError(Sender: TObject; FailureKind: TFailureKind; const ErrorMessage: string); Var S: String; begin if FailureKind = TFailureKind.ProductsRequest Then S:='ProductsRequest'; if FailureKind = TFailureKind.Purchase Then S:='Purchase'; if Assigned(OnPurchasedError) then OnPurchasedError; LogMy('Purchasing error ('+S+'):'+ErrorMessage); end; procedure TBilling.InAppPurchasePurchaseCompleted(Sender: TObject; const ProductID: string; NewTransaction: Boolean); begin LogMy('TMainForm.InAppPurchasePurchaseCompleted'); if ProductID = FNoAdsID then begin LogMy('HideAndDestroyAds'); FSecretKey:=GetSecretKey; if Assigned(OnPurchased) then OnPurchased(FSecretKey); end; end; procedure TBilling.ConsumeComplete(Sender: TObject; const ProductID: string); begin LogMy('Consume Complete: ' + ProductID); end; procedure TBilling.ConsumeFailed(Sender: TObject; const ProductID, ErrorMessage: string); begin LogMy('Consume Failed: ' + ProductID); end; procedure TBilling.LogMy(AMessage : String); begin if Assigned(OnLog) then OnLog(AMessage); end; end. Использовать вот так: const NoAdsID = 'mysuperapp_remove_ad'; //название товара, тоже что и консоли разработчика ... private Billing : TBilling; procedure BillingEventPurchased(ASecretKey : String); procedure BillingEventNotPurchased; procedure BillingEventPurchasedError; procedure BillingLog(AMessage : String); procedure DisablePurchaseUI; procedure EnablePurchaseUI; ... FormCreate start Var AppLicenseKey : String; ... AppLicenseKey:='MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAxim8ZGAIhK/FPhpXT0r6MXHYxYi1qcMfIiKOkiBDHcRYgRLK7'; AppLicenseKey:=AppLicenseKey+'********************************************************************************'; AppLicenseKey:=AppLicenseKey+'******************************************************************************'; AppLicenseKey:=AppLicenseKey+'*******************************************************************************'; AppLicenseKey:=AppLicenseKey+'Mgv7JP8A+qcDV3lm4M9OKBgxBRLaejxHd1iH3tsMR8PLkKUUf3yrMW8QIDAQAB'; Billing:=TBilling.Create(AppLicenseKey, NoAdsID); Billing.OnPurchased:=BillingEventPurchased; Billing.OnNotPurchased:=BillingEventNotPurchased; Billing.OnPurchasedError:=BillingEventPurchasedError; Billing.OnLog:=BillingLog; Billing.CheckPurchase; FormCreate stop ... procedure TFormMain.BillingEventPurchased(ASecretKey : String); begin // LogMy('CheckSecretKey True - Disable Ads'); Setting.Flags.AdsShowFlag:=False; DisablePurchaseUI; // удаляет кнопки и прочую фигню предлагающую купить товар (товар в данном случае - Удаление рекламы) HideAndDestroyAds; // удаление рекламы из приложения, так как товар куплен // Setting.SecretKey:=ASecretKey; // SaveFormState; end; procedure TFormMain.BillingEventNotPurchased; begin Setting.Flags.AdsShowFlag:=True; EnablePurchaseUI; ShowAds; end; procedure TFormMain.BillingEventPurchasedError; begin Setting.Flags.AdsShowFlag:=True; // EnablePurchaseUI; ShowAds; end; procedure TFormMain.BillingLog(AMessage : String); begin // Memo.Lines.Insert(0,AMessage); end; procedure TFormMain.DisablePurchaseUI; begin ButtonRemoveAds.Visible:=False; LayoutRemoveAds.Visible:=False; end; procedure TFormMain.EnablePurchaseUI; begin LayoutRemoveAds.Visible:=True; ButtonRemoveAds.Visible:=True; end;
  40. 3 likes
    проверка интернета function CheckInet: boolean; var aResp: IHTTPResponse; aHTTP: THTTPClient; begin Result := false; aHTTP := THTTPClient.Create; try try aResp := aHTTP.Head('http://google.com'); Result := aResp.StatusCode < 400; except Result := false; end; finally FreeAndNil(aHTTP); end; end; get запрос function HTTPGet(const aURL: string): string; var aHTTP: THTTPClient; aResp: TStringStream; begin Result := 'Error'; aResp := TStringStream.Create('', TEncoding.UTF8); aHTTP := THTTPClient.Create; try try aHTTP.Get(aURL, aResp); Result := aResp.DataString; except Result := 'Error'; end; finally FreeAndNil(aHTTP); FreeAndNil(aResp); end; end;
  41. 3 likes
    При отправке пуша из консоли kinvey,API Calls (обращение к API сервиса) не защитывается,что правильно,ведь запроса от пользователя мы не получаем.То есть,теоретически,вы имеете "безлимитку" на пуши. Все таки Kinvey это не совсем "про пуши",сервис имеет гораздо больше функций и применений,а пуши это можно сказать бонус.Если пользоваться чисто пушами,то единственный запрос от пользователя будет приходить при первом запуске приложения,для получения пары ID/токен.Так что вариант с Kinvey,особенно при небольшом количестве пользователей,имеет право на существование).Но и тут не все так гладко.Kitty в соседней теме описала про дублирование уведомлений.
  42. 3 likes
    Например, вот так: Создаём фрейм FFrmSettings := TfrmSettings.Create(Self); FFrmSettings.Parent := Parent; Уничтожаем фрейм if FFrmSettings <> nil then begin FFrmSettings.Parent := nil; FFrmSettings.DisposeOf; FFrmSettings := nil; end;
  43. 3 likes
    function GetDefaultFilePath(const FileName: string): string; begin {$IFDEF Android} Result := TPath.Combine(TPath.GetSharedDocumentsPath, FileName); {$ENDIF} {$IFDEF IOS} Result := TPath.Combine(TPath.GetDocumentsPath, FileName); {$ENDIF} {$IFDEF MSWindows} Result := TPath.Combine(TPath.GetDocumentsPath, FileName); {$ENDIF} ForceDirectories(ExtractFilePath(Result)); end; procedure TForm.ShowPDF; var {$IFDEF Android} Intent: JIntent; {$ENDIF} FilePath, tmpStr: string; begin FilePath := GetDefaultFilePath(Filename); {$IFDEF Android } try Intent := TJIntent.Create; Intent.setAction(TJIntent.JavaClass.ACTION_VIEW); Intent.setDataAndType(StrToJURI('file:' + FilePath), StringToJString('application/pdf')); Intent.setFlags(TJIntent.JavaClass.FLAG_ACTIVITY_NO_HISTORY); Intent.setFlags(TJIntent.JavaClass.FLAG_ACTIVITY_NEW_TASK); SharedActivity.startActivity(Intent); except on E: Exception do ShowToast(E.Message); end; {$ENDIF} {$IFDEF IOS} wbViewPDF.Visible := True; wbViewPDF.URL := 'file:/' + FilePath; {$ENDIF} end; Приблизительно так...
  44. 3 likes
    Чтобы не лезть в исходники, можно сделать так для Android: 1. В Deployment : добавляешь нужную картинку X.png и устанавливаешь у картинки "Remote Path" "res\drawable\"; 2. В коде перед созданием уведомления добавляешь: const IMAGE = 'drawable/X'; //расширение картинки не указывается var lId : Integer; begin lId := TAndroidHelper.Context.getResources().getIdentifier( StringToJString(IMAGE), StringToJString('drawable'), TAndroidHelper.Context.getPackageName); TAndroidHelper.Context.getApplicationInfo.icon := lId; //именно отсюда потом берется Id картинки для локального уведомления *Проверял на Android 4.4, в более поздних версиях могут быть различия, версия IDE = Delphi 10 Seattle. **В прошивках типа MIUI код выше может не работать из-за жестокого кеширования.
  45. 3 likes
    В наследнике TThread объявите FCancelledEvent: TSimpleEvent; Переопределите TerminatedSet; в нем сделайте inherited и FCancelledEvent.SetEvent Ну и вместо Sleep используйте FCancelledEvent.WaitFor После этого Ваша проблема исчезнет
  46. 3 likes
    Подправил uChatBox.pas под себя, заменил TLabel на TText, теперь проблем с отрисовкой бордюра не наблюдаю. Добавил выделение заголовка и градиент в "облачка". ChatBox.zip
  47. 3 likes
    uses AndroidApi.JNI.Media; procedure MakeSound(ADuration: Integer); var Volume: Integer; StreamType: Integer; ToneType: Integer; ToneGenerator: JToneGenerator; begin Volume := TJToneGenerator.JavaClass.MAX_VOLUME; // задаем громкость StreamType := TJAudioManager.JavaClass.STREAM_ALARM; ToneType := TJToneGenerator.JavaClass.TONE_DTMF_0; // тип звука ToneGenerator := TJToneGenerator.JavaClass.init(StreamType, Volume); ToneGenerator.startTone(ToneType, ADuration); end; Типы звука можно посмотреть здесь
  48. 3 likes
    Все, окончательно осознал механизм работы, теперь все стало на свои места. Все дело в том, что моя камера выдает данные в формате AARRGGBB, только вот значение старших двух бит равно $00, а не $FF. Поэтому картинка и воспринимается прозрачной для TImage. В итоге пробежался в цикле по памяти, поменял нули на $FF и все заработало.
  49. 3 likes
    Ура! Я победил проблему. Причем с помощью почти забытой мной процедуры FindFirst ;-) Код работает корректно под Windows и Android. Файл не передергивается, антивирус спокоен. function TFileManager.GetFileSize(APath : String) : String; Var AFileSizeByte : Int64; AFileSizeFloat : Double; SearchRec : TSearchRec; FileAttrs: Integer; begin FileAttrs :=faArchive; FileAttrs := FileAttrs + faAnyFile; Result:='unknow'; AFileSizeByte:=0; try FindFirst(APath,FileAttrs,SearchRec); AFileSizeByte:=SearchRec.Size; FindClose(SearchRec); except Exit; end; if AFileSizeByte<1024 then begin Result:=Format('%d',[AFileSizeByte])+' Byte'; Exit; end; if AFileSizeByte<1048576 then begin AFileSizeFloat:=AFileSizeByte/1024; Result:=Format('%6.3f',[AFileSizeFloat])+' KByte'; Exit; end; if AFileSizeByte<1073741824 then begin AFileSizeFloat:=AFileSizeByte/1048576; Result:=Format('%6.3f',[AFileSizeFloat])+' MByte'; Exit; end; AFileSizeFloat:=AFileSizeByte/1073741824; Result:=Format('%6.3f',[AFileSizeFloat])+' GByte'; end;
  50. 3 likes
    procedure TMainForm.SearchChanelEditChangeTracking(Sender: TObject); var Lower: string; begin Lower := SearchChanelEdit.Text.Trim.ToLower; if Lower = '' then begin if Assigned(listView.Items.Filter) then begin // Clear filter listView.Items.Filter := nil; end; end else begin // Start or update filter listView.ItemIndex := -1; listView.Items.Filter := function(X: string): Boolean begin Result := Lower.IsEmpty or X.ToLower.Contains(Lower); end; end; end; Передача фильтра в ListView
This leaderboard is set to Москва/GMT+03:00