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