Использование Microsoft ScriptControl
В методе DoCreateControl, который вызывается из DoInvoke при обработке метода «Add», реализуем подключение соответствующих обработчиков событий создаваемого компонента к созданным методам.
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');
;
Примером использования данной функциональности может служить следующий код:
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.
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 имеется подходящий тип данных, и этот случай необходимо обрабатывать отдельно.
// Проверяем, не 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.
// Получаем значение свойства
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 результатом будет не интерфейс, а строка, выбранная по имени или по индексу.
// Запрошен элемент из 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.
(PropInfo^.PropType^ = System.TypeInfo(TDateTime))
(PropInfo^.PropType^ = System.TypeInfo(TDate))
//Помещаем значение свойства в промежуточную
// переменную типа TDateTime DT := GetFloatProp(FOwner, PropInfo);
Value := DT;
Value := GetFloatProp(FOwner, PropInfo);
;
В случае свойства типа «набор» (Set), не имеющего аналогов в OLE, будем возвращать строку с установленными значениями набора, перечисленными через запятую.
// Получаем значение свойства (битовая маска)
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 не возникает никаких сложностей.
Value := GetVariantProp(FOwner, PropInfo);
// Остальные типы не поддерживаются
Result := DISP_E_MEMBERNOTFOUND;
;
;
Установка свойств
Для установки свойств классов VCL служит метод SetVCLProperty. В нем осуществляется обратная трансляция типов данных OLE в типы данных Object Pascal.
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 является необходимость проверки типа данных передаваемого параметра.
// Проверяем тип параметра
ValidType(Argument, VT_BSTR, TRUE);
// И устанавливаем свойство
SetStrProp(FOwner, PropInfo, Argument.bstrVal);
;
Для целочисленных свойств добавим еще один сервис (если свойство имеет тип TCursor или Tcolor) — обеспечим трансляцию символьной строки с соответствующим названием константы в целочисленный идентификатор.
// Проверяем тип свойства на 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);
;
Отправить комментарий