среда, 11 августа 2010 г.

Волшебная сборка, часть 2

Это перевод A Magical Gathering – Part 2. Автор: Uwe Raabe.

Из части 1:
возьмите энумератор, подмешайте к нему класс-хэлпер и полейте этим invokeable custom вариант
Вот, снова. О чём это он говорит?

Ну, найти эту штуку заняло у меня немало времени, потому что она не часто упоминается. Но она оказалась именно тем, что мне было нужно. Поэтому я закопался в исходники, чтобы разобраться что такое TInvokeableCustomVariant и как его использовать. И даже справка была в этом случае, эм, полезна: RAD Studio Help.

Как оказалось, вы можете использовать такие варианты как обычные классы с методами и свойствами. Осознав это, оно вскочило прямо ко мне в голову: если наш энумератор сможет возвращать такой вариант вместо малополезного индекса записи, то мы сможем получать доступ к полям записи как к обычным свойствам:
Data.First_Name
Это и был код, который я искал!

Поскольку классовый хэлпер, кажется, может выдержать немного больше, я сделал его ответственным за возвращение необходимого варианта. Изменения были сделаны быстро: свойство Current энумератора должно быть типа Variant, а классовый хэлпер должен иметь дополнительное свойство CurrentRec также типа Variant, которое используется в методе энумератора GetCurrent.

Чтобы заставить работать вашего наследника TInvokeableVariantType, вам нужно сделать несколько вещей. Очевидно, нам нужен сам наследник:
type
  TVarDataRecordType = class(TInvokeableVariantType)
  public
    procedure Clear(var V: TVarData); override;
    procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override;
    function GetProperty(var Dest: TVarData; const V: TVarData; const Name: string): Boolean; override;
    function SetProperty(const V: TVarData; const Name: string; const Value: TVarData): Boolean; override;
  end;
У нас будет только один экземпляр этого класса, поэтому нам нужна запись для хранения данных нашего варианта:
type
  TVarDataRecordData = packed record
    VType: TVarType;
    Reserved1, Reserved2, Reserved3: Word;
    DataSet: TDataSet;
    Reserved4: LongInt;
  end;
Это упрощённая форма записи TVarData из System.pas, потому что нам нужно хранить только ссылку на набор данных, поэтому мы можем сделать её очень простой.

Наконец, нам нужна глобальная переменная, хранящая ссылку на экземпляр TVarDataRecordType, функция, возвращающая VarType этого экземпляра, и ещё функция, создающая вариант этого типа.
var
  VarDataRecordType: TVarDataRecordType = nil;
 
function VarDataRecord: TVarType;
begin
  result := VarDataRecordType.VarType;
end;
 
function VarDataRecordCreate(ADataSet: TDataSet): Variant;
begin
  VarClear(result);
  TVarDataRecordData(result).VType := VarDataRecord;
  TVarDataRecordData(result).DataSet := ADataSet;
end;
Методы Clear и Copy класса TVarDataRecordType весьма просты и просто вызывают готовые методы из TCustomVariantType. GetProperty и SetProperty содержат всю работу:
function TVarDataRecordType.GetProperty(var Dest: TVarData; const V: TVarData; const Name: string): Boolean;
var
  fld: TField;
begin
  { Найти поле с именем свойства. Если нашли - вернуть его значение. }
  fld := TVarDataRecordData(V).DataSet.FindField(Name);
  Result := (fld <> nil);
  if Result then
    Variant(dest) := fld.Value;
end;
 
function TVarDataRecordType.SetProperty(const V: TVarData; const Name: string; const Value: TVarData): Boolean;
var
  fld: TField;
begin
  { Найти поле с именем свойства. Если нашли - установить его значение. }
  fld := TVarDataRecordData(V).DataSet.FindField(Name);
  Result := (fld <> nil);
  if Result then 
  begin
    { Ну, нам надо быть в режиме редактирования, чтобы сделать это, не так ли? }
    TVarDataRecordData(V).DataSet.Edit;
    fld.Value := Variant(Value);
  end;
end;
И последняя вещь, которая осталась: реализация GetCurrentRec у классового хэлпера:
function TDataSetHelper.GetCurrentRec: Variant;
begin
  Result := VarDataRecordCreate(Self);
end;
Вот и всё! Теперь мы можем писать код так:
for Employee in QuEmployee do 
begin
  S := Trim(Format('%s %s', [Employee.First_Name, Employee.Last_Name]));
  if Employee.Hire_Date < EncodeDate(1991, 1, 1) then
    S := '*' + S;
  MemOutput.Lines.Add(S);
end;

// или:

for Employee in QuEmployee do 
begin
  s := Employee.First_Name;
  Employee.First_Name := Employee.Last_Name;
  Employee.Last_Name := s;
end;
Волшебно, не так ли? Вы можете скачать полный исходный код с CodeCentral: 25386.

7 комментариев:

  1. Вот это реально необычно! Спасибо.

    ОтветитьУдалить
  2. Красиво, напомнило использование DBIx::Class в Perl.
    Интересно, подводные камни есть?

    ОтветитьУдалить
  3. И правда отличный подход, спасибо за перевод :)

    ОтветитьУдалить
  4. Первая часть заметно понятнее... Пока не понял, как работает, но звучит здорово. Большое спасибо за перевод!

    ОтветитьУдалить
  5. Вопросы из 2021 :)
    В function TDataSetHelper.GetCurrentRec: Variant;
    begin
    Result := VarDataRecordCreate(Self);
    end;
    или все же Result := VarDataRecordCreate(Self.FDataSet);
    В function VarDataRecordCreate(ADataSet: TDataSet): Variant;
    begin
    VarClear(result);
    TVarDataRecordData(result).VType := VarDataRecord;
    TVarDataRecordData(result).DataSet := ADataSet;
    end;
    VarClear(result); //result=undefined
    В TVarDataRecordData(result).VType := VarDataRecord; не вылезет AV ?




    ОтветитьУдалить
    Ответы
    1. Разобрался )))).... Спасибо за необычную реализацию

      Удалить

Можно использовать некоторые HTML-теги, например:

<b>Жирный</b>
<i>Курсив</i>
<a href="http://www.example.com/">Ссылка</a>

Вам необязательно регистрироваться для комментирования - для этого просто выберите из списка "Анонимный" (для анонимного комментария) или "Имя/URL" (для указания вашего имени и ссылки на сайт). Все прочие варианты потребуют от вас входа в вашу учётку.

Пожалуйста, по возможности используйте "Имя/URL" вместо "Анонимный". URL можно просто не указывать.

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

Примечание. Отправлять комментарии могут только участники этого блога.