Визуальное программирование

Воплощение желаемого в реальности

My Visual Database My Visual Multibase

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

Окт 20, 2023

Продолжаю развивать концепцию настраиваемого хранилища данных, которое может лечь в основу проекта 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)
  • Расширение базовых типов данных (время, да/нет, изображения/файлы и др.)
  • Добавление контроля для типов данных (аналог доменов) – диапазон значений для чисел и дат, длина текста для строк и т.д.
  • Ручная настройка положения и размера компонентов на форме редактирования классов.
  • Добавление новых ссылочных значений непосредственно из формы редактирования объекта.

Ссылки

➥

My Visual Database

SQLite. Подведение итогов

Апр 15, 2024
My Visual Database

Модификация данных

Апр 15, 2024
My Visual Database

Группировка данных в SQLite

Апр 11, 2024

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

Ваш адрес email не будет опубликован. Обязательные поля помечены *