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

Dion · 12 апреля, 2016

Добрый день, Господа.

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

Предлагаю вам откуда-то взятый мною superobject, версии 1.2 из которой я выкинул разный хлам, допилил и сделал так, чтобы он собирался под Android, OS X и iOS. Протестировал.
Дальше я написал вокруг него километр кода, создал набор стилей и сделал динамическую загрузку стилей для списка. В список в соответствии со стилями можно добавить порядка 20 разных компонентов.
Идея моя была такой.
Есть сервер, на него с клиента загружаются стили и дальше они разливаются от сервера к серверу и в конечном счете попадают на клиентов. Грубо говоря, должен получиться тонкий клиент.

Надо кому?

Rusland · 12 апреля, 2016

12 минуты назад, Dion сказал:

Надо кому?

Выкладывай )

Dion · 12 апреля, 2016

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

TrueCrypt · 12 апреля, 2016

Внимание, вопрос: на кой нужен этот уберобжект? (J/B)SON есть «искаропки», для xml есть гора разных реализаций, под разные задачи.

В чем преимущество вашей реализации (кроме компиляции под кучу платформ)?

Не понял фразу « Дальше я написал вокруг него километр кода, создал набор стилей и сделал динамическую загрузку стилей для списка. В список в соответствии со стилями можно добавить порядка 20 разных компонентов», через уберобжект грузятся стили для listbox?

Равиль Зарипов (ZuBy) · 12 апреля, 2016

Хм, сомнительное предложение. Так то XSuperObject со всеми плюшками собирается для всех платформ. Если кого родной не устраивает. Что за стили и при чем тут суперобжект не ясно. А вообще у нас на форуме не принято меняться, есть что полезного показывайте. Велком в нужный раздел

Изменено 12 апреля, 2016 пользователем ZuBy

rareMax · 12 апреля, 2016

Вы за этот суперОбжект?

Цитата

Автор: Onur YILDIZ <onryldz10@gmail.com>

Если да - то он компилится везде.

Цитата

создал набор стилей и сделал динамическую загрузку стилей для списка. В список в соответствии со стилями можно добавить порядка 20 разных компонентов.
Идея моя была такой.
Есть сервер, на него с клиента загружаются стили и дальше они разливаются от сервера к серверу и в конечном счете попадают на клиентов. Грубо говоря, должен получиться тонкий клиент.

А вот тут можно подробнее? что за стили такие? Что за добавление компонентов?

Dion · 13 апреля, 2016

Ой-ой-ой, Форум по Delphi, а форматирование кода Delphi движком форума не поддерживается. Как же так???

Dion · 13 апреля, 2016

{
  Здравствуйте.
  Предлагаю вам исходный код для ознакомления.
  Когда на винде он взлетел, я был счастлив.
  Надеюсь у вас хватит зрелости его понять.
  Если будут вопросы, обращайтесь на форум.
  Чтобы он заработал на других платформах, 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.

Dion · 13 апреля, 2016

Сори за флуд.

Вот код в прищепке.

Alienware.zip

Равиль Зарипов (ZuBy) · 13 апреля, 2016

я бы не сказал что это стиль, это надстройки для отображения определенных компонентов.

да такое можно отправлять с сервера и перестраивать визуальное представление приложения, но это очень редко нужно

т.к. мало визуально изменить приложение, нужно еще поведение и обработчики назначить.

но у каждого свои тараканы, возможно вам такое нужно было. вполне имеет место быть, может еще кому понадобится

master webs · 13 апреля, 2016

согласен универсальное приложение которым можно управлять сервера штука интересная (по сути оболочка) и развивать есть куда но писать всю структуру приложения в json будет трудновато, без отладчиков и всего прочего так даже не будешь знать откуда ноги у ошибок.

но есть большой плюс имея лицензию и сделать такое приложение конструктор бесплатным можно пользоваться лицензий бесплатно как вариант так как приложение собрано по лицензии ))

Dion · 13 апреля, 2016

1 час назад, ZuBy сказал:

я бы не сказал что это стиль, это надстройки для отображения определенных компонентов.

да такое можно отправлять с сервера и перестраивать визуальное представление приложения, но это очень редко нужно

т.к. мало визуально изменить приложение, нужно еще поведение и обработчики назначить.

но у каждого свои тараканы, возможно вам такое нужно было. вполне имеет место быть, может еще кому понадобится

C[6]  := Add(WC, 417, TStyleType.ComboBox, 'WebCameraPriority', 'Приоритет', ['SampleChangeWithDynamicLink', 1, 'Качество', 'Скорость']);

Динамическое связывание с обработчиком события.
Сорри, в этой инструкции должен быть ноль. Не совсем я понял, почему его там не оказалось при вставке.
Получается, что имя метода лежит в json. Присваивается как обработчик через RTTI в стиль комбобокса.
В принципе и разные другие обработчики тоже доступны.

ListItem.StylesData['ComboBox.OnChange'] := TValue.From<TNotifyEvent>(GetEvent(ISO.AsArray.S[0]));

Так, что я не совсем понимаю ваши опасения по поводу того, что нужно менять поведение.

Dion · 13 апреля, 2016

2 часа назад, master webs сказал:

согласен универсальное приложение которым можно управлять сервера штука интересная (по сути оболочка) и развивать есть куда но писать всю структуру приложения в json будет трудновато, без отладчиков и всего прочего так даже не будешь знать откуда ноги у ошибок.

но есть большой плюс имея лицензию и сделать такое приложение конструктор бесплатным можно пользоваться лицензий бесплатно как вариант так как приложение собрано по лицензии ))

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

Говоришь о фреймворке?

Равиль Зарипов (ZuBy) · 13 апреля, 2016

9 минут назад, 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]));
Так, что я не совсем понимаю ваши опасения по поводу того, что нужно менять поведение.

это все прекрасно конечно, но имя метода должно прописано уже в программе.

приведу пример: допустим есть список меню, его имена можно отредактировать и послать с сервера. Это можно сделать и не прибегая к таким сложным конструкциям.

А вот расширить меню новым функционалом невозможно, т.к. событие не прописано в приложении. Все равно придётся перекомпилировать.

и если память не подводит присваивать можно только события TNotifyEvent, а что-то более сложней уже проблема

Dion · 13 апреля, 2016

4 часа назад, ZuBy сказал:

А вот расширить меню новым функционалом невозможно, т.к. событие не прописано в приложении. Все равно придётся перекомпилировать.

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

noisy · 13 апреля, 2016

тогда уж лучше сделать адаптивный сайт

Равиль Зарипов (ZuBy) · 14 апреля, 2016

17 часов назад, Dion сказал:

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

Не все так просто, как кажется. Для простых приложении это еще куда не шло при наличии хорошего интернета!! Пользователю не охота ждать пока его интерфейс ответит, ему глубоко пофиг что и как устроено в приложении, ему главное чтобы интерфейс отвечал мгновенно. Да и такой подход не подойдет для больших проектов, собственные стили, отрисовки ListView, работа с картой и сенсорами, с записью аудио, да и вообще кучей всего. А так конструктор для одной формочки которая выводит новости и разные справочники в самый раз, хотя для таких приложении не нужны такие затраты времени в разработке.

Изменено 14 апреля, 2016 пользователем ZuBy

Dion · 14 апреля, 2016

У меня есть совершенно четкое ощущение, что можно сделать удобный для программиста способ обработки данных в json формате при использовании локального кэша сохранённого при первой загрузке или уже вошедшего в состав версии приложения.
Полностью согласен с тем, что приложение должно отрабатывать мгновенно и этого можно достигнуть.

Равиль Зарипов (ZuBy) · 14 апреля, 2016

Ну чтож, покажите нам свое творение в деле как будете готовы. С удовольствием посмотрим на результат, только проект не демо, а боевой. Удачи вам

Uncle Ti · 17 октября, 2019

Скачал и тестировал проект на Delphi 10.3.1. Оболочка при компиляции выдала 2 ошибки : unit superobject - не знает DecimalSeparator, для запуска по быстрому вписал в коснтанты, и unit SuperForm - строка где A := WebCamera.GetAvailableCaptureSettings там нужно передать TCanvasClass, я закоментировал временно. После этого приложение запустилось. Target windows 32-bit

Войти

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

Вопрос

19 ответов на этот вопрос

Рекомендуемые сообщения

Присоединяйтесь к обсуждению

Похожий контент

Последние посетители 0 пользователей онлайн