Использование Microsoft ScriptControl
Для перечисленных типов, за исключением Boolean, значение передается в виде символьной строки, а Boolean, как и раньше, обрабатывается отдельно.
// Проверяем на тип 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 и корректно установить свойство.
// Проверяем тип данных - должен быть интерфейс 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.
(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). Необходимо выделить из переданной символьной строки разделенные запятыми элементы, для каждого из них – проверить, является ли он допустимым для устанавливаемого свойства, и установить соответствующий бит в числе, которое будет установлено в качестве свойства.
// Проверяем тип данных, должна быть символьная строка
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 установить несложно.
// Проверяем тип данных аргумента
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 определен как:
['{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.
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.
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, если элементов не хватило.
TVCLEnumerator.(celt: LongWord; rgvar: OleVariant;
pceltFetched: PLongWord): HResult;
I: Cardinal;
Result := S_OK;
I := 0;
Для объекта TWinControl возвращаем интерфейсы IDispatch для компонентов из свойства Controls.
Отправить комментарий