DirtyBorov

Это пожалуй единственное место куда я не догадался проверить. Спасибо.

Коллега, вы совершенно не верно подходите к решению задачи. TreeView - это представление, а база данных - это модель. Потому построение дерева должно опираться на данных в БД, а не наоборот. Дерево в базе хранят обычно в одной таблице такой структуры: id - id объекта parent - id родителя text - наименование например ваша структура в БД будет примерно так выглядеть: 1, null, Родитель 1 2, 1, Потомок 1-1 3, 1, Потомок 1-1 4, null, Родитель 2 5, 4, Потомок 2-1 6, 4, Потомок 2-2 7, 6, Потомок 2-3 - обратите внимание - потомок потомка и т.д. Для того что бы связать запись БД и Item в дереве используйте свойство Tag. Это просто и удобно. Как строить дерево: 1. Самый плохой способ - при запуске программы, из БД считывается все данные и по ним строится полное дерево. При добавлении/удалении записи все повторяем - перечитываем полное дерево. Таким способом лучше не делать. За такой метод бьют ногами не похвалят. Причем и пользователи (за тормоза программы) и админ сервера БД (за нагрузку на сервер). 2. Этот способ немного лучше - при запуске мы точно также считываем полное дерево из БД. Но при добавлении записей, мы добавляем только конкретный Item в дерево и его Tag присваиваем ID который назначил сервер при создании записи в БД. Но тут все еще есть недостаток - полное построение дерева - если записей много, то может занимать много времени. 3. Самый лучший способ - при запуске считываются только корневые записи (parent = null). А остальные подгружаются по мере необходимости. Когда пользователь разворачивает ветку, то из БД получаем все записи parent = Selected.Tag и добавляем детей к этой ветке. Добавление новых записей так же как в способе 2. Рекомендую вам использовать именно способ 3. Во первых он самый быстрый, во вторых считывание из БД наиболее простое. Иначе вам без рекурсивных хранимых процедур будет сделать полное чтение дерево очень сложно. Здесь же можно все выбирать простыми запросами. Еще пара советов: если данных много и по дереву ходят много - то постепенно программа подгрузит много веток и это может занимать много памяти, что может привести к тормозам. Потому при сворачивании ветки, лучше всех детей удалять. Когда ветка не имеет детей, то у нее нет слева стрелочки для разворачивания. Потому возникает вопрос - как же тогда развернуть ветку, чтобы подгрузить детей? Все просто. Надо создать одного фейкового ребенка. Т.е. просто Item-пустышку не связанную с БД. А когда ветку разворачивают, то первым делом надо пустышку удалить. Потом считать БД. Естественно при сворачивании делаем наоборот - сначала удаляем все реальные Item-ы, а потом вновь добавляем пустышку. Вот как то так.

Вот модуль который решает проблему минимального размера: FMX.FormHelper.zip Просто подключите модуль к своему проекту и объявите его в uses. Пользоваться вот так: procedure TForm1.FormCreate(Sender: TObject); begin SetMinSize(640, 480); end; Все. Теперь размер формы будет ограничен 640х480.

Кто то пользовался новым TnetHTTPClient? У меня вот что то не получается использовать его с SSL под андроидом. Для windows программа работает и прекрасно работает по https. А вот этот же код под андроидом сразу сообщает "Server Certificate Invalid or not present". При этом указанного в документации события OnValidateServerCertificate на андроиде вообще не происходит. http://docwiki.embarcadero.com/RADStudio/XE8/en/Using_an_HTTP_Client Сталкивался кто то с таким? UPD: Вопрос снят. Оказалось у меня слетела дата на телефоне.

За ранее прошу простить если не в ту ветку. Вопрос двоякий и анимация и жесты. Нужно реализовать анимацию, таким образом, что бы она постепенно останавливалась. Вот например есть 10 картинок, надо их пальцем прокручивать. Но так, чтоб они постепенно останавливались. Причем картинки небольшие, сразу на экране могут быть 3 картинки. Как бы лента из картинок. Картинок может быть много 100+. Стоит ли копать в сторону анимации? Не будет ли тормозить на слабеньком телефоне? Посоветуйте куда копать - анимация, Box2D?

SendMessage(WindowHandleToPlatform(Handle).Wnd, WM_SETICON, 1, NewAppIcon.Handle); Это первое что попробовал. Забыл об этом сказать. К сожалению этот трюк не работает. Именно потому я и обратился за помощь. Верней он работает, только если не используется стиль но рамку окна. Если же используется стиль, то тут уже либо не работает (самодельный стиль на основе стандартных): Либо вот такие глюки (стиль jet). Причем если подвигать окно, то окно восстановит рамку из стиля и... вернет иконку по умолчанию. Очевидно что проблема связана именно с использованием стилей. Я пробовал расширенные стили для XE7 - у всех такая проблема в XE8. У стилей, где нет стилизации окна - проблем нет. Надеюсь что данная проблема связана именно с использованием стилей от ХЕ7 в ХЕ8. Насколько я понял, стили подверглись изменениям в связи с TImageList (картинки не будут отображаться в старых стилях). К сожалению премиум стилей для ХЕ8 у меня нет и проверить истинность своих догадок я не могу. В любом случае - спасибо за помощь. По крайней мере я теперь знаю что был на верном пути.

Подскажите как можно изменить иконку окна в runtime? Суть проблемы в том, что мне надо поддерживать приложение для разных заказчиков. Каждый из них хочет иметь собственную иконку в приложении. Очевидное решение - создать несколько проектов и каждому задать требуемую иконку. Однако на практике это весьма утомительное занятие. Хотелось бы сделать одно приложение, а иконки подгружать динамически на основании настроек приложения. Вспоминая практику VCL и WinAPI, подменить иконку Application оказалось задачей тривиальной: NewAppIcon := TIcon.Create; NewAppIcon.LoadFromFile(AIconFile); SendMessage(ApplicationHWND, WM_SETICON, 1, NewAppIcon.Handle); А вот дальше начались проблемы. Окна уже прогрузили иконку по умолчанию и добраться до них у меня не получается. Добраться через стиль не получается, потому что TForm не является наследником TStyledObject и не имеет StylesData. Через FindStyleResource тоже не получается добраться. Может кто знает как?

Суть проблемы в том, что в WinXP (SP3), данный компонент не работает от слова совсем. Вместо меню получаем "Abstract Error". В других ОС все нормально.

На XP SP3 при нажатии правой кнопкой на иконке в трее вылетает "Abstract Error". К сожалению нет возможности продебажить под XP. Может кто знает куда копать? UPD: Валится PopupMenu. Трей не причем. Похоже очередная бага в FMX.

В ХЕ8 появился новый модуль System.Hash

По каким то причинам мне не удается прикрепить файл содержащий TWaitControl. Потому просто выложу его код полностью. Благо он совсем короткий. Модуль универсальный. Его можно использовать не только для REST но и вообще для любых длительных операций которые нужно выполнять в потоках. Обратите внимание, что в конструктор передается TForm. Это экземпляр ГЛАВНОЙ формы приложения. Это нужно потому что TWaitControl , будет перекрывать главную форму полупрозрачным квадратом, создавая эффект затемнения и заодно делая недоступным разные кнопки на форме. Рекомендую создавать TWaitControl в событии OnCreate главной формы: TMainForm = class(TForm) private Wait: TWaitControl; end; procedure TMainForm.FormCreate(Sender: TObject); begin Application.OnException := OnException; Wait := TWaitControl.Create(Self); Wait.Title.Text := 'Ждите пожалуйста...'; end; unit Wait.Control; interface uses FMX.Forms, FMX.Objects, FMX.Types, FMX.Effects, FMX.StdCtrls, System.SysUtils, System.Classes, System.UITypes; type TWaitControl = class(TRectangle) private FWindow: TRectangle; FTitle: TLabel; FHadErrors: Boolean; FWaiting: Boolean; procedure DoErrorHandling(E: Exception; AOnError: TProc<TWaitControl, Exception>); procedure DoOnCompleted(AOnComplete: TProc<TWaitControl>); public constructor Create(MainForm: TForm); reintroduce; procedure Run(ATask: TProc<TWaitControl>; AOnComplete: TProc<TWaitControl> = nil; AOnError: TProc<TWaitControl, Exception> = nil); virtual; property Waiting: Boolean read FWaiting; property HadErrors: Boolean read FHadErrors; property Window: TRectangle read FWindow; property Title: TLabel read FTitle; end; implementation { TWaitControl } constructor TWaitControl.Create(MainForm: TForm); begin inherited Create(MainForm); Parent := MainForm; Align := TAlignLayout.Contents; Visible := False; Fill.Color := $4B000000; FWindow := TRectangle.Create(Self); FWindow.Parent := Self; FWindow.Fill.Color := $96000000; FWindow.Align := TAlignLayout.Center; FWindow.Width := 250; FWindow.Height := 65; FTitle := TLabel.Create(FWindow); FTitle.Parent := FWindow; FTitle.Align := TAlignLayout.Client; FTitle.StyledSettings := FTitle.StyledSettings - [TStyledSetting.Size, TStyledSetting.Style]; FTitle.TextSettings.Font.Size := 16; // FTitle.TextSettings.Font.Style := [TFontStyle.fsBold]; with TAniIndicator.Create(FWindow) do begin Parent := FWindow; Style := TAniIndicatorStyle.Circular; Align := TAlignLayout.Left; Margins.Left := 15; Margins.Top := 15; Margins.Right := 15; Margins.Bottom := 15; Width := Height; Enabled := True; end; with TShadowEffect.Create(FWindow) do Parent := FWindow; end; procedure TWaitControl.DoErrorHandling(E: Exception; AOnError: TProc<TWaitControl, Exception>); begin TThread.Synchronize(TThread.CurrentThread, procedure begin FWaiting := False; FHadErrors := True; Visible := False; if Assigned(AOnError) then AOnError(Self, E); end); end; procedure TWaitControl.DoOnCompleted(AOnComplete: TProc<TWaitControl>); begin TThread.Synchronize(nil, procedure begin FWaiting := False; Visible := False; if Assigned(AOnComplete) then AOnComplete(Self); end); end; procedure TWaitControl.Run; begin Visible := True; FWaiting := True; TThread.CreateAnonymousThread( procedure begin try FHadErrors := False; ATask(Self); DoOnCompleted(AOnComplete); except on E:Exception do DoErrorHandling(E, AOnError); end; // DoOnCompleted(AOnComplete); end).Start; end; end.

Логично. Но тема не раскрыта. Во первых, я написал, о том что мне было НУЖЕН json, потому ответы не десереализуются в объекты. Во вторых нет необходимости использовать TJson.JsonToObject. Все гораздо проще. Как я уже писал, нужно изменить функцию Request. Например так: function Request<T: class>(ABody: TApiObject): T; ... function TRestAPI.Request<T>(ABody: TApiObject): T; var i: integer; begin RESTRequest.ClearBody; RESTRequest.AddBody(ABody); RESTRequest.Execute; if (RESTResponse.StatusCode <> 200) then raise Exception.CreateFmt('Оштбка сервера %d "%s"',[RESTResponse.StatusCode, RESTResponse.StatusText]); if not Assigned(RESTResponse.JSONValue) then raise Exception.Create('Ответ сервера не содержит подходящих данных'); Result := RESTResponse.JSONValue.GetValue<T>('content'); end; Теперь по поводу потоков. Все верно, но не совсем. Поскольку TRestAPI это наследник TDataModule, то я подразумевал использование в программе единственного его экземпляра. А значит код на подобии такого - полный отстой: function TRestAPI.GetUserInfo(ABody: TApiInfo): TJSONValue; begin TThread.CreateAnonymousThread(procedure begin RESTClient.BaseURL := BaseURL + '?act=terminal&area=info&infoType=2&response=js'; Result := Request(ABody); end).Start; end; Почему? Потому что если из главного модуля выполнить подряд сразу два запроса - то мы получим exception. Так как потоки раздерутся из-за единственных экземпляров: RESTClient: TRESTClient; RESTRequest: TRESTRequest; RESTResponse: TRESTResponse; Первое что приходит на ум: 1. Создавать динамически TRestAPI для каждого запроса 2. Создавать TRESTClient, TRESTRequest, TRESTResponse для каждого запроса. Логично? Нет. Это вообще полное гамно плохая идея. Потому что будет много лишнего кода, а мы стремимся все сделать красиво. Что же, мы к этому подошли, покажу как же я использовал данный код. А использовал я его конечно же в потоках. Идея очень простая и весьма удобная. Взял я ее с сайта fmxexpress.com (к сожалению не помню автора, но вы можете найти). Мне она настолько понравилась, что я теперь использую ее повсеместно. Конечно код я модернизировал под себя и адаптировал для использования на desktop. Код позволяет отправить в поток любую функцию. При этом при завершении или ошибке будет вызваны соответсвующие функции. Но весь код будет находится в одном месте (используются анонимные методы). При выполнении запроса будет выведено окно с анимацией и надписью "Ждите..." Вот пример вызова запроса: procedure TFormCashbox.RequestCardInfo(const ACardNum: string); var Json: TJSONValue; Body: TApiInfo; begin lblStatus.Text := 'Запрос информации...'; Wait.Run( procedure(AWait: TWaitControl) begin Body := TApiInfo.Create; Body.Card_num := ACardNum; Body.Hall_id := '1600'; Json := RestAPI.SendRequest(Body); end, procedure(AWait: TWaitControl) begin CurrentCard.SetState(TCardState.Used, ACardNum, Json); lblStatus.Text := 'Готов'; end, procedure (AWait: TWaitControl; AException: Exception) begin OnException(Self, AException); end ); end; Весь секрет кроется в Wait. Метод Run принимает три метода: 1.основной код 2.код завершения потока 3.код при возникновении ошибки в потоке. Сам же Wait: TWaitControl - это наследник от TRectangle. Когда выполняется метод Run, он появляется на экране и показывает надпись. Дополнительно он поверх всей формы выводит полупрозрачный фон, что создает эффект как на многих сайтах. Я не буду объяснять как работает TWaitControl, там все тривиально. Просто приложу готовый модуль - пользуйтесь. С помощью него вы можете сильно упростить жизнь при работе с потоками.

У вас какая то надуманная проблема. На самом деле "руками" все делается намного проще чем кажется. При этом код будет минимизировать ошибки, потому что он будет типовой, шаблонный. Вот я приведу кусочек код из одной моей программы: unit Rest.API; interface uses CodeSiteLogging, System.JSON, REST.JsonReflect, Rest.Classes, System.SysUtils, System.Classes, IPPeerClient, REST.Client, REST.Types, Data.Bind.Components, Data.Bind.ObjectScope; type TApiObject = class abstract end; TApiLogin = class(TApiObject) public Login: string; Password: string; end; TRestAPI = class(TDataModule) RESTClient: TRESTClient; RESTRequest: TRESTRequest; RESTResponse: TRESTResponse; private const BaseURL = 'http://bla-bla.com/index.php'; private // Выполняет запрос function Request(ABody: TApiObject): TJSONValue; function SendLogin(ABody: TApiLogin): TJSONValue; function SendRegistry(ABody: TApiUser): TJSONValue; function GetUserInfo(ABody: TApiInfo): TJSONValue; function SetBalance(ABody: TApiBalance): TJSONValue; public function SendRequest(AObject: TApiObject; AOwn: Boolean = true): TJSONValue; end; var RestAPI: TRestAPI; implementation {%CLASSGROUP 'FMX.Controls.TControl'} {$R *.dfm} { TDataHTTP } /// Основная функция отправки json-объекта. она принимает обычный объект и сериализует его в json function TRestAPI.Request(ABody: TApiObject): TJSONValue; var i: integer; begin RESTRequest.ClearBody; RESTRequest.AddBody(ABody); RESTRequest.Execute; /// проверяем ответ сервера if (RESTResponse.StatusCode <> 200) then raise Exception.CreateFmt('Оштбка сервера %d "%s"',[RESTResponse.StatusCode, RESTResponse.StatusText]); /// проверяем, содержит ли ответ json if not Assigned(RESTResponse.JSONValue) then raise Exception.Create('Ответ сервера не содержит подходящих данных'); /// Проверяем, не содержится ли в ответе ошибок Result := RESTResponse.JSONValue.GetValue<TJSONValue>('content'); if not RESTResponse.JSONValue.GetValue<string>('status').Equals('success') then raise Exception.Create(RESTResponse.JSONValue.GetValue<string>('error')); end; /// Так делаем отправку на конкретный URL /// Запрос логина (проверка существования пользователя) function TRestAPI.SendLogin(ABody: TApiLogin): TJSONValue; begin RESTClient.BaseURL := BaseURL + '?act=users&area=login&response=js'; Result := Request(ABody); end; /// регистрация нового пользователя function TRestAPI.SendRegistry(ABody: TApiUser): TJSONValue; begin RESTClient.BaseURL := BaseURL + '?act=terminal&area=create&registerType=2&response=js'; Result := Request(ABody); end; /// Информация о пользователе function TRestAPI.GetUserInfo(ABody: TApiInfo): TJSONValue; begin RESTClient.BaseURL := BaseURL + '?act=terminal&area=info&infoType=2&response=js'; Result := Request(ABody); end; /// Изменить баланс пользователя function TRestAPI.SetBalance(ABody: TApiBalance): TJSONValue; begin RESTClient.BaseURL := BaseURL + '?act=terminal&area=cash&response=js'; Result := Request(ABody); end; /// Это не обязательная функция, она просто упрощает работу. По сути просто вызывает нужную функцию, /// в зависимости от переданного объекта. после отправки запроса, удаляет объект из памяти. function TRestAPI.SendRequest(AObject: TApiObject; AOwn: Boolean): TJSONValue; begin try if (AObject is TApiLogin) then Result := SendLogin(AObject as TApiLogin) else if (AObject is TApiUser) then Result := SendRegistry(AObject as TApiUser) else if (AObject is TApiInfo) then Result := GetUserInfo(AObject as TApiInfo) else if (AObject is TApiBalance) then Result := SetBalance(AObject as TApiBalance) finally if AOwn and Assigned(AObject) then FreeAndNil(AObject); end; end; end. А работать с этим так: procedure DoLogin(const AUser, APassw: string); var Usr: TApiLogin; Jsn: TJsonObject; begin Usr := TApiLogin.Create; Usr.Login := AUser; Usr.Password := APassw; Jsn := RestAPI.SendRequest(Usr, True); end; Следует заметить, что все запросы возвращают json. Просто потому что мне так было нужно. Однако можно немного изменить функцию Request, что бы возвращался объект конкретного типа.

Случилось так, что потребовался мне ввод номера телефона. Компонента, аналога 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.

Пробовал кто то наследоваться от TListItemSimpleControl? Печаль-беда Меня собственно не устроил TListItemTextButton. Захотел я сделать свою кнопочку. Для этого создал свой unit и наследовался от TListItemSimpleControl. Но тут меня ждал большой сюрприз. Дело в том что многие поля и даже методы оказались не доступны! Беглое изучение кода в файле FMX.ListView.Types показали что "не боги горшки обжигают". Досадных ошибок в нем хватает. Когда разработчики писали этот модуль, у них все было хорошо, потому что как известно в пределах видимости unit можно в одном классе иметь доступ к полям private другого класса. Это известная "болезнь". В чем собственно проблемы? Сначала не нашлось некоторые константы и поля классов. Эти поля активно используются в наследниках, хотя объявлены они так: TListItemSimpleControl = class(TListItemObject) private const DisabledOpacity = 0.6; private FEnabled: Boolean; FPressed: Boolean; FMouseOver: Boolean; FOnClick: TNotifyEvent; FTouchExpand: Single; ... Дальше оказалось еще интересней. Есть такой метод: procedure SetData(const AValue: TValue); override; Как видим, метод перекрытый. Это значит что он где то в родительском классе объявлен как virtual, однако компилятор бодро сообщил что такой метод не найден в базовом классе. Внезапно! Смотрим базовые классы и что же мы видим: TListItemObject = class(TInterfacedPersistent) private ..... procedure SetData(const Value: TValue); virtual; Браво! Аплодирую стоя! Дальше копать я не стал. Уже и так стало ясно что затея с наследованием обречена на провал. Единственное пожалуй решение из данной ситуации это скопировать модуль FMX.ListView.Types в папку с проектом, добавить его в проект и внести нужные изменения. Ну или дописать в этом модуле свои классы. Написал я это с горяча. Достали нелепые ошибки. Может кому то пригодится мои исследования и сэкономят немного времени.

В примерах все есть. Смотри папку Mobile Samples\User Interface\ListView