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

Dion

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

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

  • Посещение

Посетители профиля

1 179 просмотров профиля

Достижения Dion

  1. Dion

    Давайте меняться

    У меня есть совершенно четкое ощущение, что можно сделать удобный для программиста способ обработки данных в json формате при использовании локального кэша сохранённого при первой загрузке или уже вошедшего в состав версии приложения. Полностью согласен с тем, что приложение должно отрабатывать мгновенно и этого можно достигнуть.
  2. Ярослав, не стоит смешивать разные понятия. Речь идет о файлах с исходным кодом из папки: Files (x86)\Embarcadero\Studio\17.0\source\fmx, а именно: FMX.ListBox.pas - так как в недрах списка есть таймер без обратной связи и внешнего контроля. FMX.Media.pas и реализаций под конкретные платформы для публикации в инспекторе объектов нового свойства компонента. Я согласен с тем, что я могу и не знать чего-то, на таком глубоком уровне в вопросах компиляции и линковки, но если всё так просто, как здесь утверждается, то это нужно проверить и убедиться в истинности этого утверждения и порадоваться. Я попробую, если всё действительно так просто, то классно
  3. Dion

    Давайте меняться

    Именно на этот случай необходимо реализовать клиент-серверную виртуализацию, когда клиент сообщает серверу о том, что пользователь совершил действие, при этом сервер должен в аптайме уметь подхватывать новую логику, например с помощью микросервисов, обрабатывать и возвращать клиенту GUI для осуществления следующего шага, который может выполнить пользователь. По сути, микросервис должен вместо реального пользователя осуществить обработку команды и вернуть новое состояние. Соответственно интерфейс пользователя становится расширяемым, что само по себе в новой версии приложения должно или перейти на сторону клиента или так и продолжить свой жизненный цикл на стороне микросервиса.
  4. Dion

    Давайте меняться

    А ты воткни платный codesite и поймаешь любой баг в 5 минут, вместо часа. Все кишки наружу вытащить можно из эксепшена, вплоть до внутренних состояний записей и классов. Говоришь о фреймворке?
  5. Dion

    Давайте меняться

    C[6] := Add(WC, 417, TStyleType.ComboBox, 'WebCameraPriority', 'Приоритет', ['SampleChangeWithDynamicLink', 1, 'Качество', 'Скорость']); Динамическое связывание с обработчиком события. Сорри, в этой инструкции должен быть ноль. Не совсем я понял, почему его там не оказалось при вставке. Получается, что имя метода лежит в json. Присваивается как обработчик через RTTI в стиль комбобокса. В принципе и разные другие обработчики тоже доступны. ListItem.StylesData['ComboBox.OnChange'] := TValue.From<TNotifyEvent>(GetEvent(ISO.AsArray.S[0])); Так, что я не совсем понимаю ваши опасения по поводу того, что нужно менять поведение.
  6. Dion

    Давайте меняться

    Сори за флуд. Вот код в прищепке. Alienware.zip
  7. Dion

    Давайте меняться

    { Здравствуйте. Предлагаю вам исходный код для ознакомления. Когда на винде он взлетел, я был счастлив. Надеюсь у вас хватит зрелости его понять. Если будут вопросы, обращайтесь на форум. Чтобы он заработал на других платформах, IDE нужно настраивать. Fire-Monkey.ru имя пользователя Dion. Пусть он будет OpenSource. Хочу + 1 к карме. :) Мож, кто форкнет ;) } unit SuperForm; interface //{$DEFINE CS} uses {$IFDEF MSWINDOWS} Windows, FMX.Platform.Win, {$IFDEF CS} CodeSiteLogging, {$ENDIF} {$ENDIF} // Раздел для использования системных функций. System.SysUtils, System.Classes, System.Variants, System.Math, System.IOUtils, System.Types, System.Character, System.DateUtils, System.Generics.Collections, System.StrUtils, System.TypInfo, System.Hash, System.SyncObjs, System.Devices, System.ImageList, System.NetEncoding, System.Actions, System.Rtti, System.UITypes, // Компоненты FMX. FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.StdCtrls, FMX.ScrollBox, FMX.Objects, FMX.Controls.Presentation, FMX.ListBox, FMX.Dialogs, FMX.Effects, FMX.ImgList, FMX.ExtCtrls, FMX.MultiView, FMX.MultiView.Types, FMX.TabControl, FMX.Edit, FMX.ComboEdit, FMX.Layouts, FMX.Consts, FMX.Memo, FMX.ComboTrackBar, FMX.Media, FMX.Header, FMX.Colors, FMX.Ani, FMX.NumberBox, FMX.MultiResBitmap, FMX.SpinBox, FMX.EditBox, FMX.TreeView, FMX.DateTimeCtrls, FMX.ListView.Types, FMX.ListView, FMX.ActnList, FMX.Gestures, FMX.Calendar, FMX.Platform, SuperObject, Strings; type TStyleType = ( Header, GroupHeader, Edit, ComboBox, ComboEdit, ComboTrack, Memo, Switch, Progress, TrackBar, Glyph, CheckBox, Date, Time, NumberBox, SpinBox, AlphaTrackBar, BWTrackBar, Calendar, ColorBox, ColorButton, ColorComboBox, ColorPanel, HUETrackBar, Status, Banner, ArcDial); TAgent = class(TForm) Styles: TStyleBook; Images: TImageList; DrawerList: TListBox; DrawerButton: TSpeedButton; Drawer: TMultiView; ListBox: TListBox; WebCamera: TCameraComponent; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormResize(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); // Публикуемый метод отклика на изменения в составе компонентов. procedure SampleChangeWithDynamicLink(Sender: TObject); private { ================================================================= } FSO: ISuperObject; { .................. Интерфейс на локальный json - файл } FOO: ISuperObject; { .................. Интерфейс на основной спискок вида } // Подбираем название стиля в зависимости от платформы одной конкатенацией. function GetLookup(aStyleName: string): string; inline; // Подбираем тип стиля в название стиля без типизации на платформу. function GetStyleType(aStyleType: TStyleType): string; inline; // Извлечение события для выполнения по имени. function GetEvent(aMethodName: string): TNotifyEvent; protected // Метод для вызова событий суперобъекта. procedure Explorer(Sender: TObject); // Правильно подставляем путь к файлу для хранения на диске. function GetFiles(aFileName: string): string; virtual; // Установка высоты элемента (по умолчанию). function GetItemHeight(st: TStyleType; Value: Integer = -1): Integer; // Установка ширины элемента (по умолчанию). function GetItemWidth(st: TStyleType; Value: Integer = -1): Integer; // Сериализация суперобъекта в стиль элемента из списка. procedure Serialization(ListItem: TListBoxItem; SOI: ISuperObject; SOIName: string; Deep: Integer = 1); // Метод для передачи управления по пути следования суперобъекта. function Perform(ListItem: TListBoxItem; SOI: ISuperObject): Boolean; // Пример заполнения memo из списка в качестве detail поля. procedure SampleMemo(Value: string); // Метод применения стиля к объекту. procedure ApplyStyle(Sender: TObject); virtual; // Метод инициализации. procedure Init(Recreate: Boolean = True); virtual; // Финализация суперобъекта. procedure Term(AutoSave: Boolean = True); virtual; public property Files[aFileName: string]: string read GetFiles; property Lookup[aStyleName: string]: string read GetLookup; property StyleType[aStyleTyle: TStyleType]: string read GetStyleType; // Рекурсивный метод поиска пути для элементов супер объекта. function Circumvent(SOI: ISuperObject; SOIName: string; var ParentName: string): string; // Обновление списка суперобъектов. procedure Update(ListBox: TListBox; SOI: ISuperObject; SOIName: string); // Добавление суперобъекта и определение его окружения по шаблону. function Add(SOI: ISuperObject; TabOrder: Integer; st: TStyleType; SOIName, Caption: string; const Template: array of Variant): ISuperObject; end; var Agent: TAgent; implementation {$R *.fmx} // Правильно подставляем путь к файлу для хранения на диске. function TAgent.GetEvent(aMethodName: string): TNotifyEvent; var Address: Pointer; PropInfo: PPropInfo; begin if aMethodName = '' then Exit(nil); Address := MethodAddress(aMethodName); TMethod(Result).Code := Address; TMethod(Result).Data := Self; if not Assigned(Result) then begin Address := TypeInfo(TForm); PropInfo := GetPropInfo(Address, aMethodName); if (PropInfo = nil) then Exit(nil); Result := TNotifyEvent(GetMethodProp(Self, PropInfo)); end; end; function TAgent.GetFiles(aFileName: string): string; var FilePath: string; begin {$IFDEF MSWINDOWS} FilePath := GetCurrentDir; {$ELSE} {$IFDEF LINUX} FilePath := System.IOUtils.TPath.GetDocumentsPath; {$ELSE} {$IFDEF ANDROID} FilePath := System.IOUtils.TPath.GetDocumentsPath; {$ELSE} {$IFDEF MACOS} {$IFDEF IOS} FilePath := System.IOUtils.TPath.GetDocumentsPath; {$ELSE} FilePath := System.IOUtils.TPath.GetDocumentsPath; {$ENDIF} {$ENDIF} {$ENDIF} {$ENDIF} {$ENDIF} Result := System.IOUtils.TPath.Combine(FilePath, aFileName); end; // Подбираем тип стиля в название стиля без типизации на платформу. function TAgent.GetStyleType(aStyleType: TStyleType): string; begin Result := GetEnumName(TypeInfo(TStyleType), Integer(aStyleType)); end; // Подбираем название стиля в зависимости от платформы одной конкатенацией. function TAgent.GetLookup(aStyleName: string): string; begin {$IFDEF MSWINDOWS} Result := 'W_' + aStyleName; {$ELSE} {$IFDEF LINUX} Result := 'L_' + aStyleName; {$ELSE} {$IFDEF ANDROID} Result := 'A_' + aStyleName; {$ELSE} {$IFDEF MACOS} {$IFDEF IOS} Result := 'I_' + aStyleName; {$ELSE} Result := 'M_' + aStyleName; {$ENDIF} {$ENDIF} {$ENDIF} {$ENDIF} {$ENDIF} end; // Метод для вызова событий суперобъекта. procedure TAgent.Explorer(Sender: TObject); var FMX, Item: TFmxObject; SOI: ISuperObject; Path, ParentName: string; begin NativeInt(SOI) := ; if Sender is TFmxObject then begin FMX := TFmxObject(Sender); Item := nil; // Выполняем обход предков полученного класса. while FMX <> nil do begin if (FMX.ClassType = TListBoxItem) and (Item = nil) then Item := FMX; if (FMX.ClassType = TListBox) and (Item <> nil) then begin // Проверка заранее заданного уникального имени компонента. if (Item.Name <> '') and (Item.Tag <> ) then begin // Ищем по имени компонента путь, имя родителя и родителя. Path := Circumvent(FSO, Item.Name, ParentName); if Path = '' then Path := ProgramMenu; SOI := FSO.O[Path]; // Если метод нажатия не отработан, то обновляем список. if not Perform(Item as TListBoxItem, SOI) then Update(FMX as TListBox, SOI, ParentName); end; Exit; end; FMX := FMX.Parent; end; end; end; // Рекурсивный метод поиска пути для элементов супер объекта. function TAgent.Circumvent(SOI: ISuperObject; SOIName: string; var ParentName: string): string; var iter: TSuperObjectIter; begin Result := ''; try if SOI.AsObject.count > then begin if ObjectFindFirst(SOI, iter) then repeat if (iter.val = nil) or (not iter.val.Processing) then begin if iter.key = SOIName then begin Result := iter.key; Break; end else if Iter.val.DataType = stObject then begin // Обход вложений дерева из суперобъектов. Result := Circumvent(Iter.val, SOIName, ParentName); // Если результат получен, то выполняем каскадный сброс искателя. if Result <> '' then begin if ParentName = '' then ParentName := Iter.key; Result := Iter.key + '.' + Result; Break; end; end; end; until not ObjectFindNext(iter); ObjectFindClose(iter); end; finally if (SOI = FSO) and (Result = '') then Result := ProgramMenu; end; end; // Обновление списка суперобъектов. procedure TAgent.Update(ListBox: TListBox; SOI: ISuperObject; SOIName: string); var iHeader: TListBoxItem; begin ListBox.BeginUpdate; try ListBox.Clear; // Устанавливаем заголовок в список.. iHeader := TListBoxItem.Create(ListBox); iHeader.Parent := ListBox; ListBox.Tag := NativeInt(SOI); // Производим заполнение заголовка и подструктуры с глубиной вложения = 1. Serialization(iHeader, SOI, SOIName, 1); // Перегружаем стиль заголовка. if (SOI = FSO) or (SOIName = '') then iHeader.StyleLookup := Lookup[StyleType[TStyleType.Banner]] else iHeader.StyleLookup := Lookup[StyleType[TStyleType.Header]]; iHeader.TabOrder := ; // Выстаиваем правильную очередность элементов по TabOrder. ListBox.Sort( function (Left, Right: TFmxObject): Integer begin if TListBoxItem(Left).TabOrder xor TListBoxItem(Right).TabOrder >= then Result := TListBoxItem(Left).TabOrder - TListBoxItem(Right).TabOrder else Result := TListBoxItem(Left).TabOrder or 1; end); finally ListBox.EndUpdate; end; end; // Установка высоты элемента (по умолчанию). function TAgent.GetItemHeight(st: TStyleType; Value: Integer): Integer; begin if Value <> -1 then Exit(Value); case st of TStyleType.Header : Result := 50; TStyleType.GroupHeader : Result := 50; TStyleType.Edit : Result := 50; TStyleType.ComboBox : Result := 50; TStyleType.ComboEdit : Result := 50; TStyleType.ComboTrack : Result := 50; TStyleType.Memo : Result := 270; TStyleType.Switch : Result := 50; TStyleType.Progress : Result := 50; TStyleType.TrackBar : Result := 50; TStyleType.Glyph : Result := 50; TStyleType.CheckBox : Result := 50; TStyleType.Date : Result := 50; TStyleType.Time : Result := 50; TStyleType.NumberBox : Result := 50; TStyleType.SpinBox : Result := 50; TStyleType.AlphaTrackBar : Result := 50; TStyleType.BWTrackBar : Result := 50; TStyleType.Calendar : Result := 270; TStyleType.ColorBox : Result := 50; TStyleType.ColorButton : Result := 50; TStyleType.ColorComboBox : Result := 50; TStyleType.ColorPanel : Result := 270; TStyleType.HUETrackBar : Result := 50; TStyleType.Status : Result := 50; TStyleType.Banner : Result := 50; TStyleType.ArcDial : Result := 50; else Result := 50; end; end; // Установка ширины элемента (по умолчанию). function TAgent.GetItemWidth(st: TStyleType; Value: Integer): Integer; begin if Value <> -1 then Exit(Value); Exit(50); end; // Добавление суперобъекта и определение его окружения по шаблону. function TAgent.Add(SOI: ISuperObject; TabOrder: Integer; st: TStyleType; SOIName, Caption: string; const Template: array of Variant): ISuperObject; var ISO: ISuperObject; iStyleName: string; i: Integer; begin // Определен минимальный набор параметров для заполнения суперобъекта. // TODO. Хорошо было бы определить шаблон для стиля того или иного типа. // +++ Шаблоны необходимо свести к протоколам обмена стилями по сети. iStyleName := StyleType[st]; Result := TSuperObject.Create(stObject); Result.S['StyleLookup'] := Lookup[iStyleName]; Result.I['Height'] := GetItemHeight(st); Result.S['Text'] := Caption; Result.I['TabOrder'] := TabOrder; if SOI <> nil then begin SOI.O[SOIName] := Result; end; // Пример использования шаблона с параметрами для разных стилей. case st of TStyleType.Header: begin end; TStyleType.GroupHeader: begin end; TStyleType.Edit: begin end; TStyleType.ComboBox: begin ISO := TSuperObject.Create(stArray); if Length(Template) >= 3 then begin ISO.AsArray.S[] := VarToStr(Template[]); ISO.AsArray.I[1] := FindVarData(Template[1])^.VInteger; for i := 2 to Length(Template) - 1 do begin ISO.AsArray.S[i] := VarToStr(Template[i]); end; Result.O['ComboBoxItems'] := ISO; end; end; TStyleType.ComboEdit: begin end; TStyleType.ComboTrack: begin end; TStyleType.Memo: begin if (Length(Template) > ) and (Template[] <> '') then Result.S['Memo_Text'] := VarToStr(Template[]); end; TStyleType.Switch: begin end; TStyleType.Progress: begin end; TStyleType.TrackBar: begin end; TStyleType.Glyph: begin if Length(Template) > then Result.S['ImageName'] := VarToStr(Template[]); end; TStyleType.CheckBox: begin end; TStyleType.Date: begin end; TStyleType.Time: begin end; TStyleType.NumberBox: begin end; TStyleType.SpinBox: begin end; TStyleType.AlphaTrackBar: begin end; TStyleType.BWTrackBar: begin end; TStyleType.Calendar: begin end; TStyleType.ColorBox: begin end; TStyleType.ColorButton: begin end; TStyleType.ColorComboBox: begin end; TStyleType.ColorPanel: begin end; TStyleType.HUETrackBar: begin end; TStyleType.Status: begin end; TStyleType.Banner: begin end; TStyleType.ArcDial: begin end; end; end; // Сериализация суперобъекта в стиль элемента из списка. procedure TAgent.Serialization(ListItem: TListBoxItem; SOI: ISuperObject; SOIName: string; Deep: Integer); var iName, iText: string; iItem: TListBoxItem; ISO: ISuperObject; ite: TSuperAvlIterator; obj: TSuperAvlEntry; dt: TSuperType; i, id: Integer; bGlyph: Boolean; begin if SOI = nil then Exit; ListItem.Name := SOIName; ListItem.Tag := NativeInt(SOI); ListItem.StyleLookup := SOI.S['StyleLookup']; ListItem.OnApplyStyleLookup := ApplyStyle; ListItem.OnClick := Explorer; ite := TSuperAvlIterator.Create(SOI.AsObject); try ite.First; obj := ite.GetIter; while obj <> nil do begin iName := ReplaceText(obj.Name, '_', '.'); ISO := obj.Value; dt := ISO.DataType; case dt of stNull: ; stBoolean: begin if SameText('Enabled', iName) then ListItem.Enabled := ISO.AsBoolean else if SameText('Visible', iName) then ListItem.Visible := ISO.AsBoolean else if SameText('Selectable', iName) then ListItem.Selectable := ISO.AsBoolean else if SameText('IsChecked', iName) then ListItem.IsChecked := ISO.AsBoolean else if SameText('WordWrap', iName) then ListItem.WordWrap := ISO.AsBoolean else if SameText('IsSelected', iName) then ListItem.IsSelected := ISO.AsBoolean else ListItem.StylesData[iName] := ISO.AsBoolean; end; stDouble: begin if SameText('FontSize', iName) then ListItem.Font.Size := ISO.AsDouble else if SameText('TagFloat', iName) then ListItem.TagFloat := ISO.AsDouble else ListItem.StylesData[iName] := ISO.AsDouble; end; stCurrency: ; stInt: begin if SameText('Height', iName) then ListItem.Height := ISO.AsInteger else if SameText('Width', iName) then ListItem.Width := ISO.AsInteger else if SameText('FontColor', iName) then ListItem.FontColor := ISO.AsInteger else if SameText('TabOrder', iName) then ListItem.TabOrder := ISO.AsInteger else ListItem.StylesData[iName] := ISO.AsInteger; end; stObject: if Deep > then begin iItem := TListBoxItem.Create(ListItem.Parent); iItem.Parent := ListItem.Parent; Serialization(iItem, ISO, iName, Deep - 1); end; stArray: begin if SameText('ComboBoxItems' , iName) then begin iText := ''; for i := 2 to ISO.AsArray.Length - 1 do begin iText := iText + ISO.AsArray.S[i] + #10; end; ListItem.StylesData['ComboBox.Items.Text'] := iText; ListItem.StylesData['ComboBox.Tag'] := NativeInt(ISO); ListItem.StylesData['ComboBox.OnChange'] := TValue.From<TNotifyEvent>(GetEvent(ISO.AsArray.S[])); end; end; stString: begin if SameText('Text', iName) then ListItem.Text := ISO.AsString else if SameText('StyleLookup', iName) then begin end else if SameText('ImageName', iName) and SameText(ListItem.StyleLookup, Lookup[StyleType[TStyleType.Glyph]]) then begin id := Agent.Images.Source.IndexOf(ISO.AsString); if id >= then begin ListItem.StylesData['Glyph.Images'] := Agent.Images; ListItem.StylesData['Glyph.ImageIndex'] := id; end else begin ListItem.StylesData['Glyph.Images'] := Agent.Images; ListItem.StylesData['Glyph.ImageIndex'] := ; end; end else ListItem.StylesData[iName] := ISO.AsString; end; stMethod: ; end; ite.Next; obj := ite.GetIter; end; finally ite.Free; end; end; // Метод для передачи управления по пути следования суперобъекта. function TAgent.Perform(ListItem: TListBoxItem; SOI: ISuperObject): Boolean; var ISO: ISuperObject; begin // Для примера, метод осуществляет заполнение текстового поля данными из json. // Из примера следует, прототип можно применять для быстрого программирования. // От программиста при использовании такой подхода к архитектуре приложения, // потребуется: // + Много json // + Согласованная стили с разными скинами. // + Согласованный протокол обмена. // На выходе позитивный момент: // Легкость обмена данными между приложениями написанными на Delphi. // При этом от обзества потребуется // + OpenSource шаблон проектирования приложений. // Это его пример. // Моё мнение, он вполне жизнеспособный. // И может порадовать любого, меня же порадовал, а я искушенный. :) ISO := ISuperObject(ListItem.Tag); SampleMemo(ListItem.Name + #10#13 + SOI.AsJSon(True, False)); Result := False; end; // Метод применения стиля к объекту. procedure TAgent.ApplyStyle(Sender: TObject); var st: TStyledControl; ISO: ISuperObject; begin if not (Sender is TStyledControl) then Exit; st := Sender as TStyledControl; try // Пример получения доступа к суперобъекту и стилю для заполнения данных. ISO := ISuperObject(st.Tag); if ISO <> nil then begin if st.StyleLookup = 'W_ComboBox' then st.StylesData['ComboBox.ItemIndex'] := ; end; except on E: Exception do begin end; end; end; // Пример заполнения memo из списка в качестве detail поля. procedure TAgent.SampleMemo(Value: string); var ROOT, MAIN: ISuperObject; begin FOO.Clear(True); ROOT := Add(FOO, , TStyleType.Banner, 'Root', 'БОЛЬШОЙ СПИСОК', []); MAIN := Add(ROOT, , TStyleType.Banner, 'Main', 'JSON STYLE', []); Add(MAIN, 1, TStyleType.Memo, 'Memo', '', [Value]); Update(ListBox, FOO.ForcePath(ProgramMenu), 'Main'); end; // Пример изменения списочного значения. procedure TAgent.SampleChangeWithDynamicLink(Sender: TObject); var FMX: TFMXObject; cb: TComboBox; li: TListBoxItem; SOI: ISuperObject; Parent: TFMXObject; iState: string; begin iState := ''; if Sender is TComboBox then begin cb := Sender as TCombobox; li := cb.Parent.Parent as TListBoxItem; if cb.ItemIndex >= then iState := li.Text + ' ' + cb.Items.Strings[cb.ItemIndex] + ' '; end else iState := 'Not supported class: ' + Sender.ClassName; try try if Sender is TFMXObject then begin FMX := Sender as TFMXObject; Parent := FMX.Parent; while Parent <> nil do begin if Parent is TListBoxItem then begin SOI := ISuperObject(Parent.Tag); SampleMemo(IntToStr(TThread.GetTickCount) + #10#13 + iState + #10#13 + SOI.AsJSon(True, False)); SOI := nil; Exit; end; iState := Parent.ClassName + '.' + iState; Parent := Parent.Parent; end; iState := iState + Sender.ClassName; end; except end; finally end; end; procedure TAgent.FormCreate(Sender: TObject); begin // Загрузка суперобъекта. Init; // Левый слайдер со скрепкой. Drawer.MasterButton := DrawerButton; Drawer.Mode := TMultiViewMode.Drawer; Drawer.Width := 270; Drawer.DrawerOptions.Placement := TPanelPlacement.Left; Drawer.DrawerOptions.DurationSliding := 0.30; Drawer.DrawerOptions.TouchAreaSize := 20; Drawer.ShadowOptions.Opacity := 1.0; Drawer.ShadowOptions.Color := $FFFFFFFF; Drawer.ShadowOptions.Enabled := False; Drawer.DrawerOptions.Mode := TSlidingMode.PushingDetailView; Drawer.TargetControl := ListBox; Drawer.Visible := True; end; procedure TAgent.FormDestroy(Sender: TObject); begin Term; end; procedure TAgent.FormResize(Sender: TObject); begin // end; procedure TAgent.FormClose(Sender: TObject; var Action: TCloseAction); begin // end; procedure TAgent.Init(Recreate: Boolean); label Reinstall; var List: TStringList; ROOT: ISuperObject; MAIN, AXIOM, OPTIONS, AGENT: ISuperObject; USER: ISuperObject; SERVER, CLIENT, WC, PD, SAFECITY, SOI, ISO, IncidentMessage, IncidentReport, CallingCard: ISuperObject; iService1, iService2, iService3, iSomeType: ISuperObject; C: array[0..8] of ISuperObject; A: TArray<TVideoCaptureSetting>; M: array of Variant; S, FileName: string; i, ai: Integer; begin FileName := Files[SuperObjectName]; FSO := nil; FOO := TSuperObject.Create(TSuperType.stObject); if FileExists(FileName) and not Recreate then begin List := TStringList.Create; try List.LoadFromFile(FileName); FSO := SO(List.Text); finally List.Free; end; if FSO = nil then goto Reinstall; end else begin Reinstall: // Такую загрузку можно делать и из базы и из сети и с помощью опять таки сериализации. // TODO Переделать в threadsafe begin end chain with private cache. FSO := TSuperObject.Create(TSuperType.stObject); ROOT := Add(FSO, , TStyleType.Banner, 'Root', 'АКСИОМА', []); AXIOM := Add(ROOT, 1, TStyleType.Header, 'Axiom', 'ИНФОРМАЦИОНННОЕ ОБЩЕСТВО', []); MAIN := Add(ROOT, 2, TStyleType.Header, 'Main', 'НАЖМИ СЮДА', []); USER := Add(AXIOM, 11, TStyleType.Glyph, 'User', 'ПОЛЬЗОВАТЕЛЬ', []); PD := Add(USER, 111, TStyleType.Glyph, 'PD', 'ПЕРСОНАЛЬНЫЕ ДАННЫЕ', []); Add(PD, 1111, TStyleType.Edit, 'UserLastName', 'ФАМИЛИЯ', []); Add(PD, 1112, TStyleType.Edit, 'UserFirstName', 'ИМЯ', []); Add(PD, 1113, TStyleType.Edit, 'UserMiddleName', 'ОТЧЕСТВО', []); Add(PD, 1114, TStyleType.Date, 'UserBirthDay', 'ДЕНЬ РОЖДЕНИЯ', []); Add(PD, 1115, TStyleType.Time, 'UserBirthTime', 'ВРЕМЯ РОЖДЕНИЯ', []); Add(PD, 1116, TStyleType.Edit, 'UserPolicySerial', 'СЕРИЯ ПОЛИСА', []); Add(PD, 1117, TStyleType.Edit, 'UserPolicyNumber', 'НОМЕР ПОЛИСА', []); Add(PD, 1118, TStyleType.Date, 'UserPolicyRegisterDate', 'ДАТА СТРАХОВАНИЯ', []); Add(PD, 1119, TStyleType.ComboEdit, 'UserPolicyCompany', 'СТРАХОВАЯ КОМПАНИЯ', []); Add(PD, 1120, TStyleType.Edit, 'UserSNILS', 'СНИЛС', []); Add(PD, 1121, TStyleType.Edit, 'UserPassportSerial', 'СЕРИЯ ПАСПОРТА', []); Add(PD, 1122, TStyleType.Edit, 'UserPassportNumber', 'НОМЕР ПАСПОРТА', []); Add(PD, 1123, TStyleType.ComboEdit, 'UserPassportGoverment', 'КЕМ ВЫДАН', []); Add(PD, 1124, TStyleType.Date, 'UserPassportRegisterDate', 'ДАТА ВЫДАЧИ', []); Add(PD, 1125, TStyleType.ComboEdit, 'UserPassportGovermentCode', 'КОД ПОДРАЗДЕЛЕНИЯ', []); Add(PD, 1126, TStyleType.Glyph, 'UserElectronicSign', 'ОЦИФРОВАННАЯ ПОДПИСЬ', []); SAFECITY := Add(MAIN, 20, TStyleType.Glyph, 'SafeCity', 'БЕЗОПАСНЫЙ ГОРОД', ['Server']); iService1 := Add(SAFECITY, 21, TStyleType.Glyph, 'Service01', 'СЛУЖБА СПАСЕНИЯ', ['Server']); IncidentReport := Add(iService1, , TStyleType.Glyph, 'IncidentReport', 'Сообщение о происшествии', ['Server']); iService2 := Add(SAFECITY, 22, TStyleType.Glyph, 'Service02', 'ПОЛИЦИЯ', ['Server']); IncidentMessage := Add(iService2, , TStyleType.Glyph, 'IncidentMessage', 'Сообщение о происшествии', ['Server']); iService3 := Add(SAFECITY, 23, TStyleType.Glyph, 'Service03', 'СКОРАЯ ПОМОЩЬ', ['Server']); CallingCard := Add(iService3, 231, TStyleType.Glyph, 'CallingCard', 'Карта вызова', ['Server']); Add(iService3, 232, TStyleType.Glyph, 'CallingCardHistory', 'История вызов', []); Add(iService3, 233, TStyleType.Glyph, 'MedicalMap', '', []); OPTIONS := Add(ROOT, 3, TStyleType.Glyph, 'Options', 'Настройки', ['Server']); SERVER := Add(OPTIONS, 31, TStyleType.Glyph, 'Server', 'Локальный сервер', ['Server']); Add(SERVER, 311, TStyleType.Switch, 'ServerState', 'СОСТОЯНИЕ', []); Add(SERVER, 312, TStyleType.Edit, 'ServerPort', 'ПОРТ', []); Add(SERVER, 313, TStyleType.ComboEdit, 'ServerIP', 'IP-АДРЕС ДЛЯ ПОДКЛЮЧЕНИЙ', []); Add(SERVER, 314, TStyleType.Edit, 'ServerQueue', 'ОЧЕРЕДЬ НА ПОДКЛЮЧЕНИЕ', []); Add(SERVER, 315, TStyleType.Edit, 'ServerMax', 'МАКСИМУМ ПОДКЛЮЧЕНИЙ', []); Add(SERVER, 316, TStyleType.Edit, 'ServerCount', 'АКТИВНЫХ ПОДКЛЮЧЕНИЙ', []); Add(SERVER, 317, TStyleType.Edit, 'ServerDebug', 'ФАЙЛ ОТЛАДКИ', []); Add(SERVER, 318, TStyleType.Edit, 'Server1', '', []); Add(SERVER, 319, TStyleType.Edit, 'Server2', '', []); Add(SERVER, 320, TStyleType.Edit, 'Server3', '', []); CLIENT := Add(OPTIONS, 32, TStyleType.Glyph, 'Client', 'Точка подключения', []); Add(CLIENT, 321, TStyleType.Edit, 'ClientState', 'СОСТОЯНИЕ', []); Add(CLIENT, 322, TStyleType.ComboEdit, 'ClientIP', 'IP-АДРЕС', ['127.0.0.1']); Add(CLIENT, 323, TStyleType.Edit, 'ClientPort', 'ПОРТ', []); Add(CLIENT, 324, TStyleType.Edit, 'Client1', '', []); Add(CLIENT, 325, TStyleType.Edit, 'Client2', '', []); Add(CLIENT, 326, TStyleType.Edit, 'Client3', '', []); Add(CLIENT, 327, TStyleType.Edit, 'Client4', '', []); Add(CLIENT, 328, TStyleType.Edit, 'Client5', '', []); Add(CLIENT, 329, TStyleType.Edit, 'Client6', '', []); Add(OPTIONS, 33, TStyleType.Glyph, 'KeyMaster', 'Мастер ключей', ['Server']); AGENT := Add(ROOT, 4, TStyleType.Glyph, 'Agent', 'Агент', ['Server']); WC := Add(AGENT, 41, TStyleType.Glyph, 'WebCamera', 'Вебкамера', ['Server']); A := WebCamera.GetAvailableCaptureSettings; SetLength(M, Length(A) + 2); for i := 2 to Length(A) - 1 do begin ai := i - 2; S := A[ai].Width.ToString + ' x ' + A[ai].Height.ToString + ' x ' + A[ai].FrameRate.ToString; M[i] := S; end; M[] := 'SampleChangeWithDynamicLink'; M[] := ; C[] := Add(WC, 411, TStyleType.Switch, 'WebCameraActive', 'Включено', ['DoSwitch']); C[1] := Add(WC, 412, TStyleType.ComboBox, 'WebCameraKind', 'Расположение', ['SampleChangeWithDynamicLink', , 'Селфи', 'Съемка']); C[2] := Add(WC, 413, TStyleType.ComboBox, 'WebCameraTorch', 'Подсветка', ['SampleChangeWithDynamicLink', , 'Выключена', 'Включена', 'Автовыбор']); C[3] := Add(WC, 414, TStyleType.ComboBox, 'WebCameraFlash', 'Вспышка', ['SampleChangeWithDynamicLink', , 'Выключена', 'Включена', 'Автовыбор']); C[4] := Add(WC, 415, TStyleType.ComboBox, 'WebCameraQuality', 'Качество', ['SampleChangeWithDynamicLink', , 'Низкое', 'Нормальное', 'Высокое', 'Максимальное']); C[5] := Add(WC, 416, TStyleType.ComboBox, 'WebCameraFocus', 'Фокус', ['SampleChangeWithDynamicLink', , 'Автовыбор', 'В движении', 'Фиксированный']); C[6] := Add(WC, 417, TStyleType.ComboBox, 'WebCameraPriority', 'Приоритет', ['SampleChangeWithDynamicLink', 1, 'Качество', 'Скорость']); C[7] := Add(WC, 418, TStyleType.ComboBox, 'WebCameraSettings', 'Настройки', M); SOI := Add(ROOT, 42, TStyleType.Glyph, 'Templates', 'СТИЛИ', []); Add(SOI, 421, TStyleType.Header, 'Options1', 'W_Header', []); Add(SOI, 422, TStyleType.GroupHeader, 'Options2', 'W_GroupHeader', []); Add(SOI, 423, TStyleType.Edit, 'Options3', 'W_Edit', []); Add(SOI, 424, TStyleType.ComboBox, 'Options4', 'W_ComboBox', []); Add(SOI, 425, TStyleType.ComboEdit, 'Options5', 'W_ComboEdit', []); Add(SOI, 426, TStyleType.ComboTrack, 'Options6', 'W_ComboTrack', []); Add(SOI, 427, TStyleType.Memo, 'Options7', 'W_Memo', []); Add(SOI, 428, TStyleType.Switch, 'Options8', 'W_Switch', []); Add(SOI, 429, TStyleType.Progress, 'Options9', 'W_Progress', []); Add(SOI, 430, TStyleType.TrackBar, 'Options0', 'W_TrackBar', []); Add(SOI, 431, TStyleType.Glyph, 'OptionsA', 'W_Glyph', []); Add(SOI, 432, TStyleType.CheckBox, 'OptionsB', 'W_CheckBox', []); Add(SOI, 433, TStyleType.Date, 'OptionsC', 'W_Date', []); Add(SOI, 434, TStyleType.Time, 'OptionsD', 'W_Time', []); Add(SOI, 435, TStyleType.NumberBox, 'OptionsE', 'W_NumberBox', []); Add(SOI, 436, TStyleType.SpinBox, 'OptionsF', 'W_SpinBox', []); Add(SOI, 437, TStyleType.AlphaTrackBar, 'OptionsF', 'W_AlphaTrackBar', []); Add(SOI, 438, TStyleType.BWTrackBar, 'OptionsG', 'W_BWTrackBar', []); Add(SOI, 439, TStyleType.Calendar, 'OptionsH', 'W_Calendar', []); Add(SOI, 440, TStyleType.ColorBox, 'OptionsJ', 'W_ColorBox', []); Add(SOI, 441, TStyleType.ColorButton, 'OptionsK', 'W_ColorButton', []); Add(SOI, 442, TStyleType.ColorComboBox, 'OptionsL', 'W_ColorComboBox', []); Add(SOI, 443, TStyleType.ColorPanel, 'OptionsM', 'W_ColorPanel', []); Add(SOI, 444, TStyleType.HUETrackBar, 'OptionsN', 'W_HUETrackBar', []); Add(SOI, 445, TStyleType.Status, 'OptionsO', 'W_Status', []); Add(SOI, 446, TStyleType.Banner, 'OptionsP', 'W_MainHeader', []); Add(SOI, 447, TStyleType.ArcDial, 'OptionsR', 'W_ArcDial', []); end; Update(DrawerList, FSO.ForcePath(ProgramMenu), 'Main'); SampleMemo(FSO.AsJSon(True, False)); end; procedure TAgent.Term(AutoSave: Boolean); begin try if AutoSave and (FSO <> nil) then FSO.SaveTo(Files[SuperObjectName], True, False); finally FSO := nil; end; FOO := nil; end; end.
  8. Dion

    Давайте меняться

    Ой-ой-ой, Форум по Delphi, а форматирование кода Delphi движком форума не поддерживается. Как же так???
  9. Сарказм. Да, мы разрешили менять вам исходники IDE, поддержку ваших изменений ждите в новой версии среды и обязательно оформите подписку, иначе так и будете через очко делать. Может официальный разработчик хоть какой-нибудь может дать разъяснение в этой ситуации?
  10. Dion

    Давайте меняться

    Я предложил меняться. Вы можете предложить что-то своё или если понравится решение и примите решение его использовать и улучшите его, то можем поменяться на него-же но улучшенное.
  11. Dion

    Давайте меняться

    Добрый день, Господа. Давайте меняться. Предлагаю вам откуда-то взятый мною superobject, версии 1.2 из которой я выкинул разный хлам, допилил и сделал так, чтобы он собирался под Android, OS X и iOS. Протестировал. Дальше я написал вокруг него километр кода, создал набор стилей и сделал динамическую загрузку стилей для списка. В список в соответствии со стилями можно добавить порядка 20 разных компонентов. Идея моя была такой. Есть сервер, на него с клиента загружаются стили и дальше они разливаются от сервера к серверу и в конечном счете попадают на клиентов. Грубо говоря, должен получиться тонкий клиент. Надо кому?
  12. Я и так мог править и сохранять исходный код. Пробую запуститься от имени администратора. Ой... Так я и так админ. Нечего не произошло.
  13. На самом деле. Я когда был на конференции по DX10 в Москве, то там уважаемые выступающие обмолвились, что теперь можно родные исходники оставляемые вместе с IDE править. Если править можно, неужели нет нормального способа применить исправления?
  14. Ломал компонент в составе LockBox, enum расширил, поменял код, собрался запустился: ХЕ РАЗ-2. Все файлы локбокса под ногами, а на форме компонента, собранная из них и заинсталленная в панель инструментов. Потребовался реинсталл компонента для решения проблемы совместимости нового кода в исходнике компонентов и самого компонента из состава bpl. Нужно заставить среду пересобрать TListBox для Android.
  15. Едут в машине таксист, бизнесмен и программист. Вдруг машина ломается. Таксист говорит: Давайте мотор смотреть. Бизнесмен: Да ладно, давай тачку поймаем. Программист: А давайте все выйдем и снова войдем, может, она заработает? ХЕ РАЗ-2. Не помогло и не поможет. Клин у тебя гасит твой билд, а это системный сорс, считай компонент из коробки. Другие варианты есть?
×
×
  • Создать...