Волшебная сборка, часть 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.