Практическое использование RTTI-атрибутов (RTTI #10)

Последнее время что-то нет времени на статьи, да и идей особо нет. Но вот вчера на работе появилась интересная идея, которая теперь здесь и будет изложена. Возникла интересная задача. В проекте на формах присутствует большое число диаграмм в TeeChart и различных таблиц с использованием TMS. Практчиески все эти графики и таблицы имеют контекстное меню, которое позволяет сохранять их в файлы. В принципе код сохранения любой таблицы или любой диаграммы всегда одинаков. Поэтому собственно, различия будут только в имени файла куда это все сохранять.
Смысл идеи заключается в том, чтобы с помощью RTTI-атрибутов задать имена файлов для экспорта каждой диаграммы или таблицы. А потом при клике в пункт меню "Сохранить в файл", будет извлечено значение атрибута, и из него получено имя файла для сохранения. В принципе тут все просто, но иногда необходимо динамически генерировать название имени файла, например, в зависимости от каких-либо выбранных параметров на форме. Как ни крути, в конечном счете, только сама форма знает, каким образом нужно сформировать название файла. Поэтому класс формы на которой расположены таблицы или диаграммы будет расширен следующим образом: поля, соответствующие таблицам/диаграммам, будут снабжены атрибутами [ExportToFile], указывающими имя файла для сохранения. В случае, если имя файла будет формироваться динамически, то указывается соответствующий флаг, и добавляется соответствующий метод, который собственно и будет формировать имя. Метод такой должен иметь определенную сигнатуру, и также будет маркироваться атриубутом, но уже другим - [ExportToFileCallback]. Для разделения методов генерации имен для графиков, таблиц и мб других элементов, для данного атрибута указыватся имя класса для экспортируемого элемента.
В общем, описание формы изменится следующим образом (на форме 2 экземпляра TChart и таблица TStringGrid):
 

  TMainForm = class(TForm)
    [ExportToFile('qwe.bmp')]
    Chart1: TChart;
    [ExportToFile('File %d.bmp', true)]
    Chart2: TChart;
    [ExportToFile('Grid %d.txt', true)]
    StringGrid1: TStringGrid;
  private
  public
    [ExportToFileCallback(TChart)]
    function getChartFileName(sender : TObject; mask :string = ''):string;
    [ExportToFileCallback(TStringGrid)]
    function getGridFileName(sender : TObject; mask : string = ''):string;
  end;

Это означет, что имя файла для графика Chart1 всегда будет 'qwe.bmp'. Для графика Chart2 будет использоваться маска имени "File %d.bmp", при этом будет использоваться метод для генерации имени файла по этой маске. Данным методом станет функция getChartFileName, поскольку именно она помечена атриубутом ExportToFileCallback, с отметкой для класса TChart. Таблица StringGrid1 будет сохраняться в файл с маской имени "Grid %d.txt", а для генерации имени будет использован метод getGridFileName().

В дата-модуль вынесены два контекстных меню - ChartPopupMenu & GridPopupMenu. Каждое из этих меню содержит элементы SaveChartMenuItem и SaveGridMenuItem. Собственно обработчики событий этих элементов умеют сохранять соответствующе элементы в файлы, пусть для графиков это будет формат BMP, а для таблицы напишем заглушку. Все что им требуется - получить имя файла для сохранения. Поэтому код обработчиков будет, например, такой:

procedure TUtilsDataModule.SaveChartMenuItemClick(Sender: TObject);
var mi : TMenuItem;
    FileName : string;
    chart : TChart;
begin
    mi := Sender as TMenuItem;
    FileName := getExportMenuFileName(mi);

    chart := (mi.GetParentMenu() as TPopupMenu).PopupComponent as TChart;

    Chart.SaveToBitmapFile(FileName);
end;


procedure TUtilsDataModule.SaveGridMenuItemClick(Sender: TObject);
var mi : TMenuItem;
    FileName : string;
begin
    mi := Sender as TMenuItem;
    FileName := getExportMenuFileName(mi);

    //export grid
    ShowMessage(FileName);
end;

 все интересности конечно же будут заключены в методе getExportMenuFileName(). Но саначала неспосредственно используемые атрибуты. Для определения имени файла будет использован атрибут ExportToFileAttribute, параметрами конструктора которого будет имя или маска файла, а также флаг, указывающие на использование метода динамического формирвоания имени:

  ExportToFileAttribute = class(TCustomAttribute)
    strict private
      FFileName : string;
      FUseCB : boolean;
    public
      constructor Create(aFileName : string = ''; useCallback : boolean = false); overload;
      property FileName : string read FFileName;
      property UseFileNameCallback : boolean read FUseCB;
  end;

Здесь все просто и понятно. А вот для маркировки методов генерации имени предварительно опишем два вспомогательных типа. Во-первых нам нужен метакласс для маркировки связи метода и типа компонента. А во вторых нам необходимо определить сигнатуру callback-методоа для генерации имени файла:

  TObjectClass = class of TObject;
  TGetExportFileNameCallback = function(sender : TObject; mask : string):string of object;

Для метакласса, конечно, лучше использовать что-нибудь другое, например, class of TComponent. Обратный метод (события получения имений файла), очевидно, возвращает имя файла, а его параметрами являются экземпляр экспортируемого компонента, и маска файла.

  ExportToFileCallback = class(TCustomAttribute)
    strict private
      FClassType : TObjectClass;
    public
      constructor Create(aClassType : TObjectClass);
      property ClassType : TObjectClass read FClassType;
  end;

 Теперь можно описать алгоритм метода getExportMenuFileName():

1. Параметром метода является элемент меню. Мы должны получить компонент экспорта, для кторого он был вызван. Поэтому необходимо получить ссылку на само родительское контекстное меню, и затем определить PopupComponent.
2. После того как сохраняемый компонент установлен, необходимо узнать его имя (свойство Name). Владельцем (свойство Owner) компонента всегда будет форма. Имя поля формы и имя компонента в идеологии VCL совпадают. Поэтому нам необходимо получить список полей родительской формы, используя RTTI, и найти поле, соответствующее компоненту, сравнив имя поля и имя нашего компонента.
3. Далее необходимо определить, содержит ли поле атрибут экспорта. Если не содержит, то имя экспорта будет пустым, и мы предложим пользователю его задать в диалоге сохранения. Если же атрибут имеется, то нам необходимо получить статическое имя экспорта (FileName), либо маску имени + флаг использования события получения имени (свойство атрибута UseFileNameCallback) .
4. Если используется динамическая генерация имен, то среди методов формы необходимо найти методы имеющие атрибут ExportToFileCallback, при этом удостовериться, что свойство ClassType атрибута совпадает с классом экспортируемого компонента.
5. Если метод найден, то его необходимо вызвать. Адрес кода получаем из RTTI информации, адрес данных - форма-владелец.

Ниже представлен код, реализующий данный алгоритм:

function TUtilsDataModule.getExportMenuFileName(sender: TMenuItem): string;
var menu : TPopupMenu;
    ctx : TRttiContext;
    t : TRttiType;
    a : TCustomAttribute;
    m, cbMethod : TRttiMethod;
    expAttr : ExportToFileAttribute;
    f : TRttiField;
    filename : string;
    exportComponent : TComponent;
    expCB : TGetExportFileNameCallback;
begin
    menu := sender.GetParentMenu() as TPopupMenu;
    exportComponent := menu.PopupComponent;

    expCB  := nil;
    expAttr := nil;
    cbMethod := nil;

    ctx := TRttiContext.Create();
    try
        t := ctx.GetType(ExportComponent.Owner.ClassType);
        f := t.GetField(ExportComponent.Name);
        for a in f.GetAttributes() do begin
            if a is ExportToFileAttribute then begin
                 expAttr := a as ExportToFileAttribute;
                 break;
            end;
        end;

        if not Assigned(expAttr) then exit;

        FileName := expAttr.FileName;

        if expAttr.UseFileNameCallback then begin
            for m in t.GetMethods() do begin
                for a in m.GetAttributes() do begin
                    if not (a is ExportToFileCallback) then
                        continue;

                     if ExportToFileCallback(a).ClassType <> ExportComponent.ClassType then
                        continue;

                     cbMethod := m;
                     break;
                end;

                if Assigned(cbMethod) then
                    break;
            end;

            if not Assigned(cbMethod) then exit;

            //call method
            TMethod(expCB).Code := cbMethod.CodeAddress;
            TMethod(expCB).Data := ExportComponent.Owner;
            FileName := ExpCB(ExportComponent, FileName);
        end;
    finally
        ctx.Free();
    end;
end;

Конечно, эстетически было бы гораздо красивей сразу при указании атрибута ExportToFile для диаграммы указыавть не флаг, что должен быть использован метод для генерации имени, а сразу наименование этого метода. Как то так: [ExportToFile('qwe %d.txt', getChartFileName)], но к сожалению это запрещено.

Вот в общем то и все о чем хотел поведать в этой статье.  Изначально вобще идея немного другая была: хотелось, чтобы такое контекстное меню назначалось каждой диаграмме или таблице автоматически при создании формы. Но идей как такое сделать так и не нашлось (без изменения имеющихся классов). Обычное такие моменты можно пробовать отлавливать на событии изменения активной формы экрана, а затем просматривать все ее компоненты и назначать меню куда следует. Среди компонентов будут перечислены те, для которых форма является владельцем. Но вот в случае, когда таблица/график находятся на фрейме, а фрейм создается динамически, то форма не будет владельцем, и не все компоненты будут обработаны.

Исходный код в Delphi XE4 прилагается.

Исходный код