Использование Microsoft ScriptControl

Для перечисленных типов, за исключением Boolean, значение передается в виде символьной строки, а Boolean, как и раньше, обрабатывается отдельно.

tkEnumeration:
  // Проверяем на тип Boolean - для него в VBScript есть
  // отдельный тип данных
  CompareText(PropInfo^.PropType^.Name, 'BOOLEAN') = 0
  // Проверяем тип данных аргумента
  ValidType(Argument, VT_BOOL, TRUE);
  // Это свойство Boolean - получаем значение и значение
  SetOrdProp(FOwner, PropInfo, Integer(Argument.vBool));
  // Перечисленный тип передается в виде символьной строки
  // Проверяем тип данных аргумента
  ValidType(Argument, VT_BSTR, TRUE);
  // Получаем значение
  S := Trim(Argument.bstrVal);
  // Переводим в Integer
  I := GetEnumValue(PropInfo^.PropType^, S);
  // Если успешно - устанавливаем свойство
  I >= 0
  SetOrdProp(FOwner, PropInfo, I)
  EInvalidParamType.Create('');
  ;
  ;

При установке объектного свойства необходимо получить ссылку на класс Delphi, представителем которого является переданный интерфейс IDispatch. Для этой цели служит ранее определенный нами интерфейс IQueryPersistent. Запросив его у объекта-представителя, мы можем получить ссылку на объект VCL и корректно установить свойство.

 tkClass:

  // Проверяем тип данных - должен быть интерфейс IDispatch

  ValidType(Argument, VT_DISPATCH, TRUE);

  Assigned(Argument.dispVal)

  // Передано непустое значение

  // Получаем интерфейс IQueryPersistent

  IP := IDispatch(Argument.dispVal) IQueryPersistent;

  // Получаем ссылку на класс, представителем которого

  // является интерфейс

  I := Integer(IP.GetPersistent);

  // Иначе - очищаем свойство

  I := 0;

  // Устанавливаем значение

  SetOrdProp(FOwner, PropInfo, I);

  ;

Для чисел с плавающей точкой основной проблемой является отработка свойства типа TDateTime. Дополнительно обеспечим возможность установить это свойство в виде символьной строки. При установке свойства типа TDateTime необходимо обеспечить трансляцию его из формата TOleDate в TDateTime.

 tkFloat:

  (PropInfo^.PropType^ = System.TypeInfo(TDateTime))

  (PropInfo^.PropType^ = System.TypeInfo(TDate))

  // Проверяем тип данных аргумента

  Argument.vt = VT_BSTR

  DT := StrToDate(Argument.bstrVal);

  ValidType(Argument, VT_DATE, TRUE);

  VariantTimeToSystemTime(Argument.date, ST) <> 0

  DT := SystemTimeToDateTime(ST)

  Result := DISP_E_BADVARTYPE;

  Exit;

  ;

  ;

  SetFloatProp(FOwner, PropInfo, DT);

  // Проверяем тип данных аргумента

  ValidType(Argument, VT_R8, TRUE);

  // Устанавливаем значение

  SetFloatProp(FOwner, PropInfo, Argument.dblVal);

  ;

  ;

Наиболее сложным случаем является установка данных типа «набор» (Set). Необходимо выделить из переданной символьной строки разделенные запятыми элементы, для каждого из них – проверить, является ли он допустимым для устанавливаемого свойства, и установить соответствующий бит в числе, которое будет установлено в качестве свойства.

tkSet:

  // Проверяем тип данных, должна быть символьная строка

  ValidType(Argument, VT_BSTR, TRUE);

  // Получаем данные

  S := Trim(Argument.bstrVal);

  // Получаем информацию RTTI

  Data := GetTypeData(PropInfo^.PropType^);

  TypeInfo := Data^.CompType^;

  TypeData := GetTypeData(TypeInfo);

  I := 0;

  Length(S) > 0

  // Проходим по строке, выбирая разделенные запятыми

  // значения идентификаторов

  CommaPos := Pos(',', S);

  CommaPos = 0

  CommaPos := Length(S) + 1;

  S1 := Trim(System.Copy(S, 1, CommaPos - 1));

  System.Delete(S, 1, CommaPos);

  Length(S1) > 0

  // Поверяем, какому из допустимых значений соответствует

  // полученный идентификатор

  K := 1;

  GoodToken := FALSE;

  J := TypeData^.MinValue TypeData^.MaxValue

  CompareText(S1, GetEnumName(TypeInfo , J)) = 0

  // Идентификатор найден, добавляем его в маску

  I := I K;

  GoodToken := TRUE;

  ;

  K := K 1;

  ;

  GoodToken

  // Идентификатор не найдет

  Result := DISP_E_BADVARTYPE;

  Exit;

  ;

  ;

  ;

  // Устанавливаем значение свойства

  SetOrdProp(FOwner, PropInfo, I);

  ;

Свойство типа Variant установить несложно.

 tkVariant:

  // Проверяем тип данных аргумента

  ValidType(Argument, VT_VARIANT, TRUE);

  // Устанавливаем значение

  SetVariantProp(FOwner, PropInfo, Argument.pvarVal^);

  ;

  // Остальные типы данных OLE не поддерживаются

  Result := DISP_E_MEMBERNOTFOUND;

  ;

 ;

Таким образом, мы реализовали полную функциональность по трансляции вызовов OLE в обращения к свойствам VCL. Наш компонент может динамически создавать другие компоненты на форме, обращаться к их свойствам и даже обрабатывать возникающие в них события.
Оператор For Each
Удобным средством, предоставляемым VBScript, является оператор For Each, организующий цикл по всем элементам заданной коллекции. Добавим поддержку этого оператора в наш компонент.
Интерфейс IEnumVariant
Реализация For Each предусматривает следующее: ·Исполняющее ядро ScriptControl вызывает метод Invoke объекта, по элементам которого должен производиться цикл с DispID = DISPID_NEWENUM (-4). ·Объект должен вернуть интерфейс IenumVariant. ·Далее ядро использует методы IEnumVariant для получения элементов коллекции.
Интерфейс IEnumVariant определен как:

IEnumVariant = (IUnknown)

  ['{00020404-0000-0000-C000-000000000046}']

  (celt: LongWord; rgvar: OleVariant;

  pceltFetched: PLongWord): HResult; ;

  Skip(celt: LongWord): HResult; ;

  Reset: HResult; ;

  Clone(out Enum: IEnumVariant): HResult; ;

  ;

В модуле ActiveX.pas в оригинальной поставке Delphi5 ошибочно определен метод
(celt: LongWord; rgvar: OleVariant;
pceltFetched: LongWord): HResult; ;
поэтому для корректной реализации интерфейс должен быть переопределен.
Класс TVCLEnumerator
Создадим класс, инкапсулирующий функциональность IEnumVariant.

TVCLEnumerator = (TInterfacedObject, IEnumVariant)

  FEnumPosition: Integer;

  FOwner: TPersistent;

  FScriptControl: TVCLScriptControl;

  { IEnumVariant }

  (celt: LongWord; rgvar: OleVariant;

  pceltFetched: PLongWord): HResult; ;

  Skip(celt: LongWord): HResult; ;

  Reset: HResult; ;

  Clone(Enum: IEnumVariant): HResult; ;

  Create(AOwner: TPersistent;

  AScriptControl: TVCLScriptControl);

  ;

Конструктор устанавливает свойства FOwner и FScriptControl.

TVCLEnumerator.Create(AOwner: TPersistent;

  AScriptControl: TVCLScriptControl);

  Create;

  FOwner := AOwner;

  FScriptControl := AScriptControl;

  FEnumPosition := 0;

 ;

Метод Reset подготавливает реализацию интерфейса к началу перебора.
TVCLEnumerator.Reset: HResult;
FEnumPosition := 0;
Result := S_OK;
;
Главная функциональность сосредоточена в методе , который получает следующие переменные: ·celt – количество запрашиваемых элементов; ·rgvar – адрес первого элемента массива переменных типа OleVariant; ·pceltFetched – адрес переменной, в которую должно быть записано количество реально переданных элементов. Этот адрес может быть равен NIL, в этом случае не потребуется ничего записывать.
Метод должен заполнить запрошенное количество элементов rgvar и вернуть S_OK, если это удалось, и S_FALSE, если элементов не хватило.

TVariantList = [0..0] OleVariant;



 TVCLEnumerator.(celt: LongWord; rgvar: OleVariant;

  pceltFetched: PLongWord): HResult;

  I: Cardinal;

  Result := S_OK;

  I := 0;

Для объекта TWinControl возвращаем интерфейсы IDispatch для компонентов из свойства Controls.

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

Проверка
Антиспам проверка
Image CAPTCHA
...