Родители и дети

Продолжаю развивать концепцию настраиваемого хранилища данных, которое может лечь в основу проекта My Visual Multibase. Ниже описание реализации ещё трёх возможностей:

Наследование свойств класса
Отображение дочерних объектов вместе с родительскими
Расширение базовых типов данных: добавление типа “Дата”.

Наследование свойств

Напомню, что принцип наследования – это один их принципов объектно-ориентированного подхода в программировании (подробней о развитии данной концепции можно прочитать в статье “Эволюция абстракций“). И этот механизм действительно помогает при создании дочерних классов экономить время. Рассмотрим это на примере.

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

Уникальный идентификатор
Название

Уникальный идентификатор реализован как поле object.id, которое недоступно для редактирования. А вот название хранится в таблице cproperty, вместе с остальными свойствами объекта. Это необходимо, чтобы в дальнейшем не усложнять методы генерации табличного представления, форм редактирования и заполнение выпадающих списков для ссылочных значений.

Нужно отметить, что только у этого свойства установлена отметка “Отображаемое название объекта”. Вероятность, что у корневого объекта могут появиться другие свойства, отлична от нуля, поэтому пока пусть будет так.

При описании географического объекта свойство “Название” уже присутствует в списке свойств (1) и выделяется курсивом, что обозначает наследование данного свойства от предка. Остаётся добавить новое свойство – “Площадь”.

Класс “Страна” унаследовал два свойства: “Название” и “Площадь”, имеет своё свойство “Столица”, которое является ссылкой на объект класса “Город”.

Для того, чтобы заработал данный механизм, потребовались изменения в процедурах, отвечающих за отображение списка свойств: в табличной форме на вкладке “Свойства”; список колонок на вкладке “Объекты”; список компонентов редактирования на форме efmObject. Теперь вместо фильтрации свойств по конкретному классу применяется фильтрация по списку ID, который содержит ID отображаемого класса и ID всех его предков.

Также пришлось заменить динамическую форму dtfCProperty на статическую frmCProperty, отображение данных в которой осуществляется с помощью SQL-запроса

select
  cproperty.id,
  cproperty.id_class,
  cproperty.orderNum,
  cproperty.name,
  class.name as  className,
  ptype.name  as ptypeName,
  cproperty.description
from cproperty
left join class on class.id = cproperty.id_class1
left join ptype on ptype.id = cproperty.id_ptype
where id_class in ( {edtIDMaster} )
order by orderNum  Code language: SQL (Structured Query Language) (sql)

В компоненте frmCProperty.edtIDMaster помещается список ID. Текущая реализация дерева классов не позволяет формировать этот список с помощью SQL-запроса (что наводит на мысль о переходе на интервальное дерево), поэтому приходится формировать его с помощью скрипта, используя метод TdbTreeView.GetParent():

procedure frmCProperty_btnUpdate_OnClick (Sender: TObject; var Cancel: boolean);
var
  tmpTree: TdbTreeView;
  s: string;
  tmpIndex: integer;
  tmpForm: TForm;
  tmpLevel: integer;
begin
  tmpForm := GetFormByName('dtfClass_Tree');
  if tmpForm <> nil then
  begin
    tmpTree := TdbTreeView( Form_GetDataViewer( tmpForm ) );
    // собираем ID c узла и всех родительских узлов
    tmpIndex := tmpTree.SelectedRow;
    if tmpIndex = -1 then
      frmCProperty.edtIDMaster.Text := '-1'
    else
    begin
      s := '';
      repeat
        if s <> '' then
          s := s+','
        else
          frmCProperty.edtIDClass.Value := tmpTree.dbIndexToID( tmpIndex );
        s := s + IntToStr( tmpTree.dbIndexToID( tmpIndex ) );
        tmpIndex := tmpTree.GetParent( tmpIndex );
      until tmpIndex < 0;
      frmCProperty.edtIDMaster.Text := s;
    end;
    // собираем дочерние ID
    tmpIndex := tmpTree.SelectedRow;
    if tmpIndex = -1 then
      frmCProperty.edtIDChilds.Text := '-1'
    else
    begin
      tmpLevel := tmpTree.GetLevel( tmpIndex );
      s := '';
      repeat
        if s <> '' then
          s := s+',';
        s := s + IntToStr( tmpTree.dbIndexToID( tmpIndex ) );
        inc(tmpIndex);
      until (tmpIndex = tmpTree.RowCount) or ( tmpTree.GetLevel( tmpIndex ) <=  tmpLevel );
      frmCProperty.edtIDChilds.Text := s;
    end;
  end;
end;
Code language: JavaScript (javascript)

В этом же скрипте формируется список дочерних узлов, который использует метод TdbTreeView.GetLevel(). Этот список нам пригодится для отображения объектов.

Отображение дочерних объектов

Модифицируем frmObject_btnUpdate_OnClick() таким образом, чтобы в списке объектов отображались объекты как самого выбранного класса, так и всех его потомков:

procedure frmObject_btnUpdate_OnClick (Sender: TObject; var Cancel: boolean);
// обновить отображение
var
  tmpIDClass: integer;
  tmpDataSet: TDataSet;
  tmpSQL: string;
  tmpFields : string;
  tmpJoins: string;
  tmpCount: integer;
  tmpCaptions: string;
  tmpTableAlias: string;
  tmpButton: TdbButton;
  tmpIDClassList: string;
  tmpIDChildList: string;
begin
  frmObject.labIDClass.Caption := 'Change'; // блокируем срабатывание frmObject_tgrMain_OnColumnResize
  // строится запрос на выборку данных - все объекты указанного класса
  // получаем ID класса
  tmpIDClass := Form_GetDataViewer( GetFormByName('dtfClass_Tree') ).dbItemId;
  frmObject.labIDClass.Tag := tmpIDClass; // запоминаем класс
  tmpIDClassList := frmCProperty.edtIDMaster.Text; // список классов
  tmpIDChildList := frmCProperty.edtIDChilds.Text; // список классов
  tmpSQL := 'SELECT * FROM cproperty WHERE id_class in ('+tmpIDClassList+') ORDER BY orderNum ';
  SQLQuery(tmpSQL,tmpDataSet);
  tmpFields := 'object.id';
  tmpJoins := '';
  tmpCaptions := 'delete_col'; // не отображать
  tmpCount := 0;
  //
  while not tmpDataSet.EOF do
  begin
    if tmpDataSet.FieldByName('visible').asInteger = 1 then
    begin
      tmpTableAlias := 'OP_'+IntToStr(tmpCount);
      //
      if tmpFields <> '' then
        tmpFields := tmpFields + ', ';
      tmpFields := tmpFields + tmpTableAlias+'.value_s ';
      //
      tmpJoins := tmpJoins + 'LEFT JOIN oproperty '+tmpTableAlias+' ON '+tmpTableAlias+'.id_object = object.id AND '+tmpTableAlias+'.id_cproperty = '+tmpDataSet.FieldByName('id').asString+CR ;
      //
      if tmpCaptions <> '' then
        tmpCaptions := tmpCaptions + ', ';
      tmpCaptions := tmpCaptions + tmpDataSet.FieldByName('name').asString;
      //
      inc(tmpCount);
    end;
    tmpDataSet.Next;
  end;
  tmpDataSet.Free;
  tmpSQL := 'SELECT '+tmpFields+CR+' FROM object '+tmpJoins+CR+' WHERE object.id_class in ('+tmpIDChildList+')';
  tmpButton := TdbButton(Sender);
  tmpButton.dbSQL := tmpSQL;
  tmpButton.dbListFieldsNames := tmpCaptions;
end;Code language: Delphi (delphi)

Теперь в списке объектов можно увидеть как объекты выбранного класса…

…так и все объекты дочерних классов:

Тип данных “Дата”

Добавляем тип в справочник визуальных компонентов.

Затем добавляем новый класс для хранения данных о дате.

Теперь дописываем процедуру генерации компонентов на форме редактирования объекта, добавляем создание компонента для ввода даты.

Кстати, пришлось изменить концепцию построения формы, а именно – отказаться от удаления ненужных компонентов в пользу их повторного использования. Это связано с ошибкой внутри MVDB, из-за которой метод TdbComboBox.Free выдает Access Violation, если вы хоть раз открыли выпадающий список комбобокса. Впрочем, есть и плюс в этом подходе – форма открывается быстрее и уменьшается фрагментация памяти.

procedure efmObject_OnShow (Sender: TObject; Action: string);
// отображение формы редактирования
var
  i: integer;
  tmpSQL: string;
  tmpIDClass: integer;
  tmpCount: integer;
  tmpLabel: TdbLabel;
  tmpEdit: TdbEdit;
  tmpComboBox: TdbComboBox;
  tmpForm: TForm;
  tmpParent: TdbPanel;
  tmpDataSet: TDataSet;
  tmpID: string;
  tmpControlID: integer;
  tmpIDClassList: string;
  tmpDataEdit : TdbDateTimePicker;
begin
  tmpIDClassList := frmCProperty.edtIDMaster.Text; // список классов
  tmpForm := TForm(Sender);
  tmpParent := efmObject.panEdit;
  if Action = 'NewRecord' then
  begin
    efmObject.cmbClass.dbItemID := Form_GetDataViewer( GetFormByName('dtfClass_Tree') ).dbItemId;
  end;
  // скрыть все компоненты
  for i := tmpParent.ControlCount - 1 downto 0 do
  begin
    tmpParent.Controls[i].Visible := False;
  end;
  tmpIDClass := efmObject.cmbClass.dbItemID;
  tmpCount := 0;
  // создать компоненты, которые нужны для редактирования свойств текущего объекта
  tmpSQL := 'SELECT cproperty.id, cproperty.name, cproperty.is_name, class.name as cname, class.id_uicontrol, class.id as ClassID '+
    'FROM cproperty LEFT JOIN class ON class.id = cproperty.id_class1 WHERE id_class in ('+tmpIDClassList+') ORDER BY orderNum ';
  SQLQuery(tmpSQL,tmpDataSet);
  while not tmpDataSet.EOF do
  begin
    tmpControlID := tmpDataSet.FieldByName('id_uicontrol').asInteger;
    // метка
    FindC(tmpForm,'labData_'+intToStr(tmpCount),tmpLabel,False);
    if tmpLabel = nil then
      tmpLabel := TdbLabel.Create( tmpForm );
    with tmpLabel do
    begin
      visible := True;
      parent := tmpParent;
      Font.Size := 11;
      top := tmpCount * 50;
      left := 8;
      name := 'labData_'+intToStr(tmpCount);
      Caption := tmpDataSet.FieldByName('name').asString;
      if tmpDataSet.FieldByName('is_name').asInteger = 1 then
        Font.Style := fsBold
      else
        Font.Style :=0;
    end;
    // поле ввода
    FindC(tmpForm,'edtData_'+intToStr(tmpCount),tmpEdit,False);
    if tmpEdit = nil then
      tmpEdit := TdbEdit.Create( tmpForm );
    with tmpEdit do
    begin
      visible := True;
      name := 'edtData_'+intToStr(tmpCount);
      parent := tmpParent;
      Font.Size := 11;
      top := tmpCount * 50 + tmpLabel.Height;
      left := 8;
      width := 300;
      tag := tmpDataSet.FieldByName('id').asInteger; //
      tagString := VarToStr( SQLExecute('SELECT id FROM oproperty WHERE id_object = '+IntToStr( efmObject.btnSave.dbGeneralTableId  )+' AND id_cproperty = '+tmpDataSet.FieldByName('id').asString ) );
      text := VarToStr( SQLExecute('SELECT value_s FROM oproperty WHERE id_object = '+IntToStr( efmObject.btnSave.dbGeneralTableId  )+' AND id_cproperty = '+tmpDataSet.FieldByName('id').asString ) );
      dbCurrency := False;
      NumbersOnly := False;
      if tmpControlID = 3 then // целое число
      begin
        dbCurrency := True;
        dbAccuracy := 0;
        Alignment := taLeftJustify;
      end;
      if tmpControlID = 4 then // вещественное число
      begin
        NumbersOnly := True;
      end;
      onChange := 'efmObject_edtEdit_OnChange';
      Font.Style := 0;
    end;
    //
    if tmpControlID = 2 then // выпадающий список
    begin
      //
      FindC(tmpForm,'cmbData_'+intToStr(tmpCount),tmpComboBox,False);
      if tmpComboBox = nil then
        tmpComboBox := TdbComboBox.Create( tmpForm );
      with tmpComboBox do
      begin
        visible := True;
        name := 'cmbData_'+intToStr(tmpCount);
        parent := tmpParent;
        Font.Size := 11;
        top := tmpCount * 50 + tmpLabel.Height;
        left := 8;
        width := 300;
        tagString := VarToStr( SQLExecute('SELECT id_object1 FROM oproperty WHERE id_object = '+IntToStr( efmObject.btnSave.dbGeneralTableId  )+' AND id_cproperty = '+tmpDataSet.FieldByName('id').asString ) );
        dbSQL := 'SELECT object.id, oproperty.value_s FROM object LEFT JOIN oproperty ON oproperty.id_object = object.id WHERE oproperty.id_cproperty = ( SELECT id FROM cproperty WHERE cproperty.is_name = 1 ) AND object.id_class = '+tmpDataSet.FieldByName('ClassID').asString+' ORDER BY 2';
        dbUpdate;
        if tagString <> '' then // если есть ссылочное значение, то синхронизировать выпадающий список
          dbItemID := StrToInt(tagString);
        onChange := 'efmObject_cmbEdit_OnChange';
        Font.Style :=0;
      end;
    end;
    //
    if tmpControlID = 5 then // дата
    begin
      FindC(tmpForm,'dtpData_'+intToStr(tmpCount),tmpDataEdit,False);
      if tmpDataEdit = nil then
      begin
        tmpDataEdit := TdbDateTimePicker.Create( tmpForm );
        AssignEvents(tmpDataEdit);
      end;
      with tmpDataEdit do
      begin
        visible := True;
        name := 'dtpData_'+intToStr(tmpCount);
        parent := tmpParent;
        Font.Size := 11;
        top := tmpCount * 50 + tmpLabel.Height;
        left := 8;
        width := 300;
        ShowCheckBox := True;
        if ValidDate( tmpEdit.Text ) then
        begin
          DateTime := StrToDate( tmpEdit.Text );
          Checked := True;
        end
        else
          Checked := False;
        //
        dbOnChange := 'efmObject_dtpEdit_OnChange';
        Font.Style :=0;
      end;
    end;
    inc(tmpCount);
    tmpDataSet.Next;
  end;
  tmpDataSet.Free;
  tmpForm.ClientHeight := tmpCount * 50 + 48; // скорректировать высоту формы
end;
Code language: Delphi (delphi)

Дату можно вводить или не вводить – за это отвечает чекер компонента TdbDateTimePicker

Ширина колонок

Ширина колонки табличного представления класса больше не связана с каким-то конкретным свойством класса, так как у разных классов теперь могут быть одинаковые (унаследованные) свойства. Это обстоятельство привело к изменению структуры данных и алгоритму сохранения данных о настройке ширины колонок, которые теперь хранятся в поле class.col_widths.

Данные хранятся в виде строки, в которой целочисленные значения разделены запятыми. Модифицированные процедуры загрузки и сохранения настройки приведены ниже.

procedure frmObject_tgrMain_OnChange (Sender: TObject);
// обновление данных в таблице
var
  tmpIDClass: integer;
  tmpSQL: string;
  tmpColumn: integer;
  s: string;
  tmpColWidth: array of string;
begin
  // получаем ID
  tmpIDClass := frmObject.labIDClass.Tag;
  // считать ширины колонок из базы
  tmpSQL := 'SELECT COALESCE(col_widths,"") FROM class WHERE id = '+IntToStr(tmpIDClass);
  s := SQLExecute(tmpSQL);
  tmpColWidth := SplitString(s,',');
  for tmpColumn := 0 to frmObject.tgrMain.Columns.Count - 1 do
  begin
    if tmpColumn < length(tmpColWidth) then
      frmObject.tgrMain.Columns[tmpColumn].Width := StrToInt(tmpColWidth[tmpColumn] )
    else
      frmObject.tgrMain.Columns[tmpColumn].Width := 200;
  end;
  frmObject.labIDClass.Caption := ''; // разблокируем frmObject_tgrMain_OnColumnResize
end;

procedure frmObject_tgrMain_OnColumnResize (Sender: TObject; ACol: Integer);
// изменение ширины колонок
var
  tmpIDClass: integer;
  tmpSQL : string;
  i: integer;
  s: string;
begin
  if frmObject.labIDClass.Caption = '' then
  begin
    s := '';
    for i:=0 to frmObject.tgrMain.Columns.Count - 1 do
      s := s + IntToStr(frmObject.tgrMain.Columns[i].Width) + ',';
    delete(s,length(s),1);
    // запоминаем ширины всех колонок в БД
    tmpIDClass := frmObject.labIDClass.Tag; //  класс
    tmpSQL := 'UPDATE class SET col_widths = "'+s+'" WHERE id = '+IntToStr(tmpIDClass);
    SQLExecute(tmpSQL);
  end;
end;
Code language: Delphi (delphi)

Итоги

Проект Data Keeper развивается, уточняются алгоритмы генерации и выборки данных.

Что нужно сделать:

Поддержка свойств-множеств
Интервальное дерево классов
Поиск объектов по заданному значению свойства (нескольких свойств)
Отображение зависимых объектов (объектов, у которых данный объект является значением какого-либо свойства)
Создание произвольных представлений (использования аналога SQL для ООП).
Фильтрация (автоматическое построение панели фильтрации объектов заданного класса на основании списка свойств)
Флаг обязательности заполнения свойства объекта (аналог обязательного поля)
Флаг уникальности свойства объекта класса (аналог уникальности значения поля)
Флаг глобальной уникальности свойства объекта (или свойство с генерацией GUID)
Расширение базовых типов данных (время, да/нет, изображения/файлы и др.)
Добавление контроля для типов данных (аналог доменов) – диапазон значений для чисел и дат, длина текста для строк и т.д.
Ручная настройка положения и размера компонентов на форме редактирования классов.
Добавление новых ссылочных значений непосредственно из формы редактирования объекта.

Ссылки

Data Keeper 1.1 – исходники проекта

Родители и дети

Наследование свойств

Отображение дочерних объектов

Тип данных “Дата”

Ширина колонок

Итоги

Ссылки

➥

LAST BETA

Светлое фильтрованное

Имиджевая революция

Добавить комментарий Отменить ответ

Подпишитесь, чтобы получать уведомления о новых публикациях.

Архивы

➥

LAST BETA

Про странство

Светлое фильтрованное

Имиджевая революция