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

Falk0ner, вс, 06/07/2008 - 15:35.

MS Script Control

В методе DoCreateControl, который вызывается из DoInvoke при обработке метода «Add», реализуем подключение соответствующих обработчиков событий создаваемого компонента к созданным методам.

TVCLProxy.DoCreateControl(AName, AClassName: WideString;
WithEvents: Boolean);
SetHandler(Control: TPersistent; Owner: TObject;
Name: String);
// Функция устанавливает обработчик события Name на метод формы
// с именем Name + 'Handler'
Method: TMethod;
PropInfo: PPropInfo;
// Получаем информацию RTTI
PropInfo := GetPropInfo(Control.ClassInfo, Name);
Assigned(PropInfo)
// Получаем адрес обработчика
Method.Code := FScriptControl.MethodAddress(Name + 'Handler');
Assigned(Method.Code)
// Обработчик есть
Method.Data := FScriptControl;
// Устанавливаем обработчик
SetMethodProp(Control, PropInfo, Method);
;
;
;

ThisClass: TControlClass;
C: TComponent;
NewOwner: TCustomForm;
// Назначаем свойство Owner на форму
(FOwner TCustomForm)
NewOwner := GetParentForm(FOwner TControl)
NewOwner := FOwner TCustomForm;
// Получаем класс создаваемого компонента
ThisClass := TControlClass(GetClass(AClassName));
// Создаем компонент
C := ThisClass.Create(NewOwner);
// Назначаем имя
C.Name := AName;
C TControl
// Назначаем свойство Parent
TControl(C).Parent := FOwner TWinControl;
WithEvents
// Устанавливаем обработчики
SetHandler(C, NewOwner, 'OnClick');
SetHandler(C, NewOwner, 'OnChange');
SetHandler(C, NewOwner, 'OnEnter');
SetHandler(C, NewOwner, 'OnExit');
SetHandler(C, NewOwner, 'OnTimer');
;
// Создаем класс, реализующий интерфейс Idispatch, и добавляем его
// в пространство имен TScriptControl
FScriptControl.RegisterClass(AName, C);
;
Таким образом, если третьим параметром метода «Add» будет задано True, то TVCLScriptControl установит обработчики событий OnClick, OnChange, OnEnter, OnExit и OnTimer на свои методы, реализованные следующим образом:
TVCLScriptControl.OnClickHandler(Sender: TObject);
RunProc((Sender TComponent).Name + '_' + 'OnClick');
;

Примером использования данной функциональности может служить следующий код:

Sub Main()

Self.Add "Timer1", "TTimer", TRUE

With Timer1

.Interval = 1000

.Enabled = True

End With

End Sub

Sub Timer1_OnTimer()

Self.Caption = CStr(Time)

End Sub

Если требуется назначить обработчики событий, имеющихся на форме компонентов, это может быть сделано в коде
Button1.OnClick := ScriptControl1.OnClickHandler;
или путем реализации соответствующего метода в GetIdsOfNames и Invoke.
Получение свойств
Для получения свойств классов VCL служит метод GetVCLProperty. В нем осуществляется трансляция типов данных Object Pascal в типы данных OLE.

TVCLProxy.GetVCLProperty(PropInfo: PPropInfo;

dps: TDispParams; PDispIds: PDispIdList; Value: OleVariant

): HResult;

I, J, K: Integer;

S: String;

P, P1: TPersistent;

Data: PTypeData;

DT: TDateTime;

TypeInfo: PTypeInfo;

Result := S_OK;

PropInfo^.PropType^.Kind

Для данных строкового и целого типа Delphi осуществляет автоматическую трансляцию.

tkString, tkLString, tkWChar, tkWString:

// Символьная строка

Value := GetStrProp(FOwner, PropInfo);

tkChar, tkInteger:

// Целое число

Value := GetOrdProp(FOwner, PropInfo);

Для перечисленных типов OLE не имеет прямых аналогов. Поэтому для всех типов, кроме Boolean, будем передавать символьную строку с именем соответствующей константы. Для Boolean имеется подходящий тип данных, и этот случай необходимо обрабатывать отдельно.

tkEnumeration:

// Проверяем, не Boolean ли это

CompareText(PropInfo^.PropType^.Name, 'BOOLEAN') = 0

// Передаем как Boolean

Value := Boolean(GetOrdProp(FOwner, PropInfo));

// Остальные - передаем как строку

I := GetOrdProp(FOwner, PropInfo);

Value := GetEnumName(PropInfo^.PropType^, I);

;

;

Самым сложным случаем является свойство объектного типа. Нормальным поведением будет возврат интерфейса IDispatch, позволяющего OLE обращаться к методам класса, на который ссылается свойство. Однако для некоторых классов, имеющих свойства «по умолчанию», таких как TStrings и TСollection, свойство может быть запрошено с индексом. В этом случае следует выдать соответствующий индексу элемент. В то же время, будучи запрошенным без индекса, свойство должно выдать интерфейс IDispatch для работы с экземпляром TCollection или TStrings.

tkClass:

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

P := TPersistent(GetOrdProp(FOwner, PropInfo));

Assigned(P) (P TCollection)

(dps.cArgs = 1)

// Запрошен элемент коллекции с индексом (есть параметр)

ValidType(dps.rgvarg^[pDispIds^[0]], VT_BSTR,

FALSE)

// Параметр строковый, ищем элемент по свойству

// DisplayName

S := dps.rgvarg^[pDispIds^[0]].bstrVal;

P1 := ;

I := 0 Pred(TCollection(P).Count)

CompareText(S,

TCollection(P).Items[I].DisplayName) = 0

P1 := TCollection(P).Items[I];

Break;

;

Assigned(P1)

// Найден - возвращаем интерфейс IDispatch

Value := FScriptControl.GetProxy(P1)

// Не найден

Result := DISP_E_MEMBERNOTFOUND;

// Параметр целый, возвращаем элемент по индексу

I := IntValue(dps.rgvarg^[pDispIds^[0]]);

(I >= 0) and (I < TCollection(P).Count)

P := TCollection(P).Items[I];

Value := FScriptControl.GetProxy(P);

Result := DISP_E_MEMBERNOTFOUND;

;

Для класса TStrings результатом будет не интерфейс, а строка, выбранная по имени или по индексу.

Assigned(P) (P TStrings) (dps.cArgs = 1)

// Запрошен элемент из Strings с индексом (есть параметр)

ValidType(dps.rgvarg^[pDispIds^[0]], VT_BSTR,

FALSE)

// Параметр строковый - возвращаем значение свойства

// Values

S := dps.rgvarg^[pDispIds^[0]].bstrVal;

Value := TStrings(P).Values[S];

// Параметр целый, возвращаем строку по индексу

I := IntValue(dps.rgvarg^[pDispIds^[0]]);

(I >= 0) (I < TStrings(P).Count) Value := TStrings(P)[I]

Result := DISP_E_MEMBERNOTFOUND;

;

// Общий случай, возвращаем интерфейс IDispatch свойства

Assigned(P)

Value := FScriptControl.GetProxy(P)

// Или Unassigned, если оно = NIL

Value := Unassigned;

;

У чисел с плавающей точкой также есть особенный тип данных – TDateTime. Его необходимо обрабатывать иначе, чем остальные числа с плавающей точкой, поскольку у него в OLE есть отдельный тип данных — OleDate.

tkFloat:

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

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

//Помещаем значение свойства в промежуточную

// переменную типа TDateTime DT := GetFloatProp(FOwner, PropInfo);

Value := DT;

Value := GetFloatProp(FOwner, PropInfo);

;

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

tkSet:

// Получаем значение свойства (битовая маска)

I := GetOrdProp(FOwner, PropInfo);

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

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

TypeInfo := Data^.CompType^;

// Формируем строку с набором значений

S := '';

I <> 0

K := 0 31

J := 1 K;

(J I) = J

S := S + GetEnumName(TypeInfo, K) + ',';

;

// Удаляем запятую в конце

System.Delete(S, Length(S), 1);

;

Value := S;

;

И наконец, с типом Variant не возникает никаких сложностей.

tkVariant:

Value := GetVariantProp(FOwner, PropInfo);

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

Result := DISP_E_MEMBERNOTFOUND;

;

;

Установка свойств
Для установки свойств классов VCL служит метод SetVCLProperty. В нем осуществляется обратная трансляция типов данных OLE в типы данных Object Pascal.

TVCLProxy.SetVCLProperty(PropInfo: PPropInfo;

Argument: TVariantArg): HResult;

I, J, K, CommaPos: Integer;

GoodToken: Boolean;

S, S1: ;

DT: TDateTime;

ST: TSystemTime;

IP: IQueryPersistent;

Data, TypeData: PTypeData;

TypeInfo: PTypeInfo;

Result := S_OK;

PropInfo^.PropType^.Kind

Главным отличием этого метода от SetVCLProperty является необходимость проверки типа данных передаваемого параметра.

tkChar, tkString, tkLString, tkWChar, tkWString:

// Проверяем тип параметра

ValidType(Argument, VT_BSTR, TRUE);

// И устанавливаем свойство

SetStrProp(FOwner, PropInfo, Argument.bstrVal);

;

Для целочисленных свойств добавим еще один сервис (если свойство имеет тип TCursor или Tcolor) — обеспечим трансляцию символьной строки с соответствующим названием константы в целочисленный идентификатор.

tkInteger:

// Проверяем тип свойства на TCursor, TColor,

// если он совпадает и передано символьное значение,

// пытаемся получить его идентификатор

(CompareText(PropInfo^.PropType^.Name, 'TCURSOR') = 0)

(Argument.vt = VT_BSTR)

IdentToCursor(Argument.bstrVal, I)

Result := DISP_E_BADVARTYPE;

Exit;

;

(CompareText(PropInfo^.PropType^.Name, 'TCOLOR') = 0)

(Argument.vt = VT_BSTR)

IdentToColor(Argument.bstrVal, I)

Result := DISP_E_BADVARTYPE;

Exit;

;

// Просто цифра

I := IntValue(Argument);

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

SetOrdProp(FOwner, PropInfo, I);

;

DelphiSite

Наиболее читаемое

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

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

Быстрая навигация в FAQ

Новые файлы