Создание ActiveX из компонентов VCL Delphi

Итак, одной из возможностей создания элемента управления ActiveX в Delphi - это превращение любого оконного компонента VCL Delphi в ActiveX.

Примечание
Несмотря на то, что мастер ActiveX Control не дает возможности автоматически создавать элементы управления ActiveX из компонентов, не являющихся потомками TWinControl, разработчик может создать такой элемент управления самостоятельно при помощи системы разработки Delphi ActiveX (DAX).

Вызовем мастера ActiveX Control. Появится окно мастера создания элемента ActiveX из оконного компонента Delphi (рис. 3.26).
В процессе использования данного мастера вам нужно выполнить следующее:
1. Выбрать компонент VCL из выпадающего списка VCL Class Name (Имя класса VCL).



Примечание
Как вы, вероятно, заметили, в выпадающем списке находятся далеко не все компоненты VCL. В данный список внесены только те компоненты, которые удовлетворяют следующим требованиям: находятся в текущем пакете, который используется в процессе разработки (следовательно, находятся в палитре компонентов); являются потомками компонента TWinControl; не исключаются из данного списка при помощи процедуры RegisterNonActiveX.

Многие из компонентов исключены из списка из-за того, что они либо не могут быть элементами управления ActiveX (например, компонент TDBGrid, т. к. для его работы нужен другой VCL-класс TDataSource), либо необходимо самостоятельно скорректировать их перед запуском мастера, чтобы они могли функционировать как элементы ActiveX (например, TTreeView, т. к. узлы компонента очень сложно представлять в ActiveX).
2. Выбрать новое имя ActiveX в поле для ввода New ActiveX Name (Новое имя ActiveX), если вас не устраивает имя, предлагаемое Delphi автоматически.
3. Выбрать имя модуля реализации создаваемого элемента ActiveX в поле для ввода Implementation Unit (Модуль реализации).
4. Выбрать имя проекта в поле для ввода Project Name (Имя проекта).
5. Выбрать потоковую модель в выпадающем списке Threading Model (Модель потока).
6. После этого вы можете установить три дополнительные опции:
Include About Box (Включить окно "О программе") - включить в проект диалоговое окно, которое будет содержать информацию о разработчике. Данное диалоговое окно представляет собой обычную форму Delphi;
Include Version Information (Включить информацию о версии) - включить в проект информацию о версии элемента управления ActiveX (данный пункт требуется для некоторых контейнеров, например, созданных в Visual Basic 4.0);
Make Control Licensed (Включить лицензионную информацию) - включить в проект лицензионную информацию (в случае коммерческого распространения элемента управления). В результате использовать данный элемент управления смогут только те разработчики, которые имеют лицензионный ключ, причем данное ограничение будет работать во всех средах разработки (Delphi, Visual Basic и др.). При установке данного флажка вместе с проектом элемента управления должен быть сгенерирован файл лицензии, имеющий расширение LIC. Чтобы дать возможность другим разработчикам использовать этот ActiveX, вам придется передавать лицензионным пользователям файл лицензии вместе с элементом управления ActiveX (имеющим расширение OCX).


Рис. 3.26. Мастер преобразования компонентов VCL Delphi в ActiveX
После внесения необходимых значений в поля, мастер автоматически создаст все файлы, которые нужны для поддержания данного элемента управления. В число таких файлов входят: сам проект, библиотека типов и файл реализации. Обратите внимание на то, что все элементы ActiveX являются либо библиотеками DLL, либо файлами OCX (что, в принципе, одно и то же).
Рассмотрим действия, которые выполняет мастер в процессе создания элемента управления ActiveX из компонента:
- мастер определяет, в каком модуле содержится элемент управления VCL. Данный модуль передается компилятору, который создает специальную символьную информацию для описания свойств, событий и методов элемента управления VCL;
- генерируется библиотека типов для проекта;
- мастер анализирует всю символьную информацию об элементе управления VCL и добавляет подходящие свойства и методы к интерфейсу и в библиотеку типов;

Примечание
Для определения, подходит ли данное свойство, метод или событие для включения в библиотеку типов, мастер проверяет, совместим ли с автоматизацией тип свойства, его параметры, а также возвращаемые значения событий и методов. С автоматизацией совместимы следующие типы: Byte, Smallint, Integer, Single, Double, Currency, TDateTime, WideString, WordBool, PSafeArray, TDecimal, OleVariant, lUnknown, IDispatch. Кроме перечисленных, разрешены параметры типов TStrings, TPicture и TFont. Для данных типов мастер создаст промежуточные объекты, которые позволят им быть инкапсулированными в IDispatch или Dispinterface.

- редактор библиотеки типов генерирует файл преобразованной библиотеки типов в соответствии с добавленными свойствами, событиями и методами;
- мастер создает файл реализации элемента управления ActiveX. Данный файл содержит элемент управления TActivexcontroi. Кроме того, мастер автоматически создает так называемые пересылки (forwarders) свойств и методов интерфейса. Пересылки направляют вызовы метода из элемента управления ActiveX в элемент управления VCL, а события - из элемента управления VCL в элемент ActiveX.
Листинг 3.7 содержит код файла проекта элемента управления ActiveX, созданного на основе компонента TRichEdit.

Листинг 3.7
library RichEditXControll;
uses
ComServ,
RichEditXControllJTLB in 'RichEditXControllJTLB.pas',
RichEditlmpll in 'RichEditlmpll.pas' {RichEditX: CoClass};
{$E ocx}
exports
DllGetClassObject, DllCanUnloadNow, DllRegisterServer, DllUnregisterServer;
{$R *.TLB}
{$R *.RES}
begin
end.

Описывать данный листинг не имеет особого смысла, т. к. его содержание достаточно очевидно.
Листинг 3.8 содержит код реализации элемента ActiveX.

Листинг 3.8
unit RichEditlmpll;
interface
uses
Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls, ComServ, StdVCL, AXCtrls, RichEditXControllJTLB, ComCtrls;
type
TRichEditX = class(TActiveXControl, IRichEditX)
private
{ Private declarations }
FDelphiControl: TRichEdit;
FEvents: IRicnEditXEvents;
procedure ChangeEvent(Sender: TObject);
procedure KeyPressEvent(Sender: TObject; var Key: Char);
procedure ProtectChangeEvent(Sender: TObject; StartPos, EndPos:
Integer;
var AllowChange: Boolean);
procedure SaveClipboardEvent(Sender: TObject; NumObjects, NumChars: Integer; var SaveClipboard: Boolean);
procedure SelectionChangeEvent(Sender: TObject);
protected
{ Protected declarations }
procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
procedure EventSinkChanged(const EventSink: lUnknown); override;
procedure InitializeControl; override;
function Get_Alignment: TxAlignment; safecall;
function Get_BorderStyle: TxBorderStyle; safecall;
function Get_CanUndo: WordBool; safecall;
function Get_Color: OLE_COLOR; safecall;
function Get_Ctl3D: WordBool; safecall;
function Get_Cursor: Smallint; safecall;
function Get_DoubleBuffered: WordBool; safecall;
function Get_DragCursor: Smallint; safecall;
function Get_DragMode: TxDragMode; safecall;
function Get_Enabled: WordBool; safecall;
function Get_Font: IFontDisp; safecall;
function Get_HideScrollBars: WordBool; safecall;
function Get_HideSelection: WordBool; safecall;
function Get_ImeMode: TxImeMode; safecall;
function Get_ImeName: WideString; safecall;
function Get_Lines: IStrings; safecall;
function Get_MaxLength: Integer; safecall;
function Get_Modified: WordBool; safecall;
function Get_ParentColor: WordBool; safecall;
function Get_ParentCtl3D: WordBool; safecall;
function Get_PlainText: WordBool; safecall;
function Get_ReadOnly: WordBool; safecall;
function Get_ScrollBars: TxScrollStyle; safecall;
function Get_SelLength: Integer; safecall;
function Get_SelStart: Integer; safecall;
function Get_SelText: WideString; safecall;
function Get_Text: WideString; safecall;
function Get_Visible: WordBool; safecall;
function Get_VisibleDockClientCount: Integer; safecall;
function Get_WantReturns: WordBool; safecall;
function Get_WantTabs: WordBool; safecall;
function Get_WordWrap: WordBool; safecall;
procedure _Set_Font(const Value: IFontDisp); safecall;
procedure Set_Alignment(Value: TxAlignment); safecall;
procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
procedure Set_Color(Value: OLE_COLOR); safecall;
procedure Set_Ctl3D(Value: WordBool); safecall;
procedure Set_Cursor(Value: Smallint); safecall;
procedure Set_DoubleBuffered(Value: WordBool); safecall;
procedure Set_DragCursor(Value: Smallint); safecall;
procedure Set_DragMode(Value: TxDragMode); safecall;
procedure Set_Enabled(Value: WordBool); safecall;
procedure Set_Font(var Value: IFontDisp); safecall;
procedure Set_HideScrollBars(Value: WordBool); safecall;
procedure Set_HideSelection(Value: WordBool); safecall;
procedure Set_ImeMode(Value: TxImeMode); safecall;
procedure Set_ImeName(const Value: WideString); safecall;
procedure Set_Lines(const Value: IStrings); safecall;
procedure Set_MaxLength(Value: Integer); safecall;
procedure Set_Modified (Value: WordBool); safecall;
procedure Set_ParentColor(Value: WordBool); safecall;
procedure Set_ParentCtl3D(Value: WordBool); safecall;
procedure Set_PlainText(Value: WordBool); safecall;
procedure Set_ReadOnly(Value: WordBool); safecall;
procedure Set_ScrollBars(Value: TxScrollStyle); safecall;
procedure Set_SelLength(Value: Integer); safecall;
procedure Set_SelStart(Value: Integer); safecall;
procedure Set_SelText(const Value: WideString); safecall;
procedure Set_Text(const Value: WideString); safecall;
procedure Set_Visible(Value: WordBool); safecall;
procedure Set_WantReturns(Value: WordBool); safecall;
procedure Set_WantTabs(Value: WordBool); safecall;
procedure Set_WordWrap(Value: WordBool); safecall;
end;
implementation
uses ComObj;
{ TRichEditX }
procedure TRichEditX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
{TODO: Определите здесь страницы свойств. Они определяются путем вызова метода DefinePropertyPage с идентификатором класса.
Например, DefinePropertyPage(Class_RichEditXPage); }
end;
procedure TRichEditX.EventSinkChanged(const EventSink: lUnknown);
begin
FEvents := EventSink as IRichEditXEvents;
end;
procedure TRichEditX.InitialiZeControl;
begin
FDelphiControl :=* Control as TRichEdit;
FDelphiControl.OnChange := ChangeEvent;
FDelphiControl.OnKeyPress := KeyPressEvent;
FDelphiControl.OnProtectChange := ProtectChangeEvent;
FDelphiControl.OnSaveClipboard := SaveClipboardEvent;
FDelphiControl.OnSelectionChange := SelectionChangeEvent;
end;
function TRichEditX.Get_Alignment: TxAlignment;
begin
Result := Ord(FDelphiControl.Alignment);
end;
function TRichEditX.Get_BorderStyle: TxBorderStyle;
begin
Result := Ord(FDelphiControl.BorderStyle);
end;
function TRichEditX.Get_CanUndo: WordBool;
begin
Result := FDelphiControl.CanUndo;
end;
function TRichEditX.Get_Color: OLE_COLOR;
begin
Result := OLE_COLOR(FDelphiControl.Color);
end;
function TRichEditX.Get_Ctl3D: WordBool;
begin
Result := FDelphiControl.Ctl3D;
end;
function TRichEditX.Get_Cursor: Smallint;
begin
Result := Smallint(FDelphiControl.Cursor);
end;
function TRichEditX.Get_DoubleBuffered: WordBool;
begin
Result := FDelphiControl.DoubleBuffered;
end;
function TRichEditX.Get_DragCursor: Smallint;
begin
Result := Smallint(FDelphiControl.DragCursor);
end;
function TRichEditX.Get_DragMode: TxDragMode;
begin
Result := Ord(FDelphiControl.DragMode);
end;
function TRichEditX.Get_Enabled: WordBool;
begin
Result := FDelphiControl.Enabled;
end;
function TRichEditX.Get_Font: IFontDisp;
begin
GetOleFont(FDelphiControl.Font, Result) ;
end;
function TRichEditX.Get_HideScrollBars: WordBool;
begin
Result := FDelphiControl.HideScrollBars;
end;
function TRichEditX.Get_HideSelection: WordBool;
begin
Result := FDelphiControl.HideSelection;
end;
function TRichEditX.Get_ImeMode: TxImeMode;
begin
Result := Ord(FDelphiControl.ImeMode);
end;
function TRichEditX.Get_ImeName: WideString;
begin
Result := WideString(FDelphiControl.ImeName);
end;
function TRichEditX.Get_Lines: IStrings;
begin
GetOleStrings(FDelphiControl.Lines, Result);
end;
function TRichEditX.Get_MaxLength: Integer;
begin
Result := FDelphiControl.MaxLength;
end;
function TRichEditX.Get_Modified: WordBool;
begin
Result := FDelphiControl.Modified;
end;
function TRichEditX.Get_ParentColor: WordBool;
begin
Result := FDelphiControl.ParentColor;
end;
function TRichEditX.Get_ParentCtl3D: WordBool;
begin
Result := FDelphiControl.ParentCtlSD;
end;
function TRichEditX.Get_PlainText: WordBool;
begin
Result := FDelphiControl.Plaintext;
end;
function TRichEditX.Get_ReadOnly: WordBool;
begin
Result := FDelphiControl.Readonly;
end;
function TRichEditX.Get_ScrollBars: TxScrollStyle;
begin
Result := Ord(FDelphiControl.ScrollBars);
end;
function TRichEditX.Get_SelLength: Integer;
begin
Result := FDelphiControl.SelLength;
end;
function TRichEditX,Get_SelStart: Integer;
begin
Result := FDelphiControl.SelStart;
end;
function TRichEditX.Get_SelText: WideString;
begin
Result := WideString(FDelphiControl.SelText);
end;
function TRichEditX.Get_Text: WideString;
begin
Result := WideString(FDelphiControl.Text);
end;
function TRichEditX.Get_Visible: WordBool;
begin
Result := FDelphiControl.Visible;
end;
function TRichEditX.Get_VisibleDockClientCount: Integer;
begin
Result := FDelphiControl.VisibleDockClientCount;
end;
function TRichEditX.Get_WantReturns: WordBool;
begin
Result := FDelphiControl.WantReturns;
end;
function TRichEditX.Get_WantTabs: WordBool;
begin
Result := FDelphiControl.WantTabs;
end;
function TRichEditX.Get_WordWrap: WordBool;
begin
Result := FDelphiControl.Wordwrap;
end;
procedure TRichEditX._Set_Font(const Value: IFontDisp);
begin
SetOleFont(FDelphiControl.Font, Value);
end;
procedure TRichEditX.ChangeEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnChange;
end;
procedure TRichEditX.KeyPressEvent(Sender: TObject; var Key: Char);
var
TempKey: Smallint;
begin
TempKey := Smallint(Key);
if FEvents <> nil then FEvents.OnKeyPress(TempKey);
Key := Char(TempKey);
end;
procedure TRichEditX.ProtectChangeEvent(Sender: TObject; StartPos, EndPos: Integer; var AllowChange: Boolean);
var
TempAllowChange: WordBool;
begin
TempAllowChange := WordBool(AllowChange);
if FEvents <> nil then FEvents.OnProtectChange(StartPos, EndPos, TempAllowChange);
AllowChange := Boolean(TempAllowChange);
end;
procedure TRichEditX.SaveClipboardEvent(Sender: TObject; NumObjects, NumChars: Integer; var SaveClipboard: Boolean);
var
TempSaveClipboard: WordBool;
begin
TempSaveClipboard := WordBool(SaveClipboard);
if FEvents <> nil then FEvents.OnSaveClipboard(NumObjects, NumChars, TempSaveClipboard); SaveClipboard := Boolean(TempSaveClipboard);
end;
procedure TRichEditX.SelectionChangeEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnSelectionChange;
end;
procedure TRichEditX.Set_Alignment(Value: TxAlignment);
begin
FDelphiControl.Alignment := TAlignment(Value) ;
end;
procedure TRichEditX.Set_BorderStyle(Value: TxBorderStyle);
begin
FDelphiControl.BorderStyle := TBorderStyle(Value);
end;
procedure TRichEditX.Set_Color(Value: OLE_COLOR);
begin
FDelphiControl.Color := TColor(Value);
end;
procedure TRichEditX.Set_Ctl3D(Value: WordBool);
begin
FDelphiControl.Ctl3D := Value;
end;
procedure TRichEditX.Set_Cursor(Value: Smallint);
begin
FDelphiControl.Cursor := TCursor(Value);
end;
procedure TRichEditX.Set_DoubleBuffered(Value: WordBool);
begin
FDelphiControl.DoubleBuffered := Value;
end;
procedure TRichEditX.Set_DragCursor(Value: Smallint);
begin
FDelphiControl.DragCursor := TCursor(Value);
end;
procedure TRichEditX.Set_DragMode(Value: TxDragMode);
begin
FDelphiControl.DragMode := TDragMode(Value);
end;
procedure TRichEditX.Set_Enabled(Value: WordBool);
begin
FDelphiControl.Enabled := Value;
end;
procedure TRichEditX.Set_Font(var Value: IFontDisp);
begin
SetOleFont(FDelphiControl.Font, Value);
end;
procedure TRichEditX.SetJHideScrollBars(Value: WordBool);
begin
FDelphiControl.HideScrollBars := Value;
end;
procedure TRichEditX.Set_HideSelection(Value: WordBool);
begin
FDelphiControl.HideSelection := Value;
end;
procedure TRichEditX.Set_ImeMode(Value: TxImeMode);
begin
FDelphiControl.ImeMode := TImeMode(Value);
end;
procedure TRichEditX.Set_ImeName(const Value: WideString);
begin
FDelphiControl.ImeName := TImeName(Value);
end;
procedure TRichEditX.Set_Lines(const Value: IStrings);
begin
SetOleStrings(FDelphiControl.Lines, Value);
end;
procedure TRichEditX.Set_MaxLength(Value: Integer);
begin
FDelphiControl.MaxLength := Value;
end;
procedure TRichEditX.Set_Modified(Value: WordBool);
begin
FDelphiControl.Modified := Value;
end;
procedure TRichEditX.Set_ParentColor(Value: WordBool);
begin
FDelphiControl.ParentColor := Value;
end;
procedure TRichEditX.Set_ParentCtl3D(Value: WordBool);
begin
FDelphiControl.ParentCtl3D := Value;
end;
procedure TRichEditX.Set_PlainText(Value: WordBool);
begin
FDelphiControl.PlainText := Value;
end;
procedure TRichEditX.Set_ReadOnly(Value: WordBool);
begin
FDelphiControl.Readonly := Value;
end;
procedure TRichEditX.Set_ScrollBars(Value: TxScrollStyle);
begin
FDelphiControl.ScrollBars := TScrollStyle(Value);
end;
procedure TRichEditX.Set_SelLength(Value: Integer);
begin
FDelphiControl.SelLength := Value;
end;
procedure TRichEditX.Set_SelStart(Value: Integer);
begin
FDelphiControl.SelStart := Value;
end;
procedure TRichEditX.Set_SelText(const Value: WideString);
begin
FDelphiControl.SelText := String(Value);
end;
procedure TRichEditX.Set_Text(const Value: WideString};
begin
FDelphiControl.Text := TCaption(Value);
end;
procedure TRichEditX.Set_Visible(Value: WordBool);
begin
FDelphiControl.Visible := Value;
end;
procedure TRichEditX.Set_WantReturns(Value: WordBool);
begin
FDelphiControl.WantReturns := Value;
end;
procedure TRichEditX.Set_WantTabs(Value: WordBool);
begin
FDelphiControl.WantTabs := Value;
end;
procedure TRichEditX.Set_WordWrap(Value: WordBool);
begin
FDelphiControl.Wordwrap := Value;
end;
initialization
TActiveXControlFactory.Create (ComServer, TRichEditX,TRichEdit,Class_RichEditX,
1,
''
0,
tmApartment);
end.

Описанный в данном файле класс TRichEditx является потомком TActivexcontrol. Этот класс применяется для установки соответствия между бывшим компонентом Delphi TRichEdit и контейнерами, в которых будет размещаться созданный элемент управления.
На рис. 3.27 показано окно редактора библиотеки типов для данного элемента управления ActiveX. Листинг 3.9 содержит код файла библиотеки типов.


Рис. 3.27. Элемент управления RichEdit в редакторе библиотеки типов

Листинг 3.9
unit RichEditXControllJTLB;
// Внимание
// Типы, объявленные в этом файле, были сгенерированы из данных
// библиотеки типов. Если библиотека типов явно или неявно (ссылается
// на эту библиотеку через другую) реимпортирована или с помощью команды
// 'Refresh' в окне Type Library Editor активизирована во время
// редактирования библиотеки типов, содержимое данного файла должно быть
// регенерировано, а все внесенные вручную изменения могут быть утеряны.
*****************************************************
// PASTLWTR : $Revision: 1.88 $
// Файл создан 15.02.2001 18:30:46 из библиотеки типов, описанной ниже.
*****************************************************
// Type Lib: C:\Program
Files\Borland\Delphi5\Projects\!!!\RichEditXControll.tlb (1)
// IIDXLCID: {B1F514E7-E8BO-49B5-A6C3-F7F4910CFF9D}\0
// Helpfile:
// DepndLst:
// (1) v2.0 stdole, (C:\WINDOWS\SYSTEM\stdole2.tlb)
// (2) v4.0 StdVCL, (C:\WINDOWS\SYSTEM\STDVCL40.DLL)
*****************************************************
{$TYPEDADDRESS OFF} // Модуль должен быть откомпилирован без проверки
// типов указателей,
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;
//***********************************************
// GUIDS объявлены в TypeLibrary. Используются следующие префиксы:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
//***********************************************
const
RichEditXControllMajorVersion = 1; RichEditXControllMinorVersion =0; '
LIBID_RichEditXControll: TGUID = '{B1F514E7-E8BO-49B5-A6C3-F7F4910CFF9D}';
IID_IRichEditX: TGUID = '{86F5C46C-CDA6-4279-8BF4-F69F1A051ED7}';
DIID_IRichEditXEvents: TGUID = '{21AB5F94-7D87-4FCO-AB5A-9BCE1D05AF8B} ' ;
CLASS_RichEditX: TGUID = '{7C731EEO-D98D-4040-8FE1-EOCB9E54C58B}';
//***********************************************
// Объявление перечислений, определенных в библиотеке типов
//***********************************************
// Константы для TxAlignment
type
TxAlignment = TOleEnum;
const
taLeftJustify = $00000000;
taRightJustify = $00000001;
taCenter = $00000002;
// Константы для TxBorderStyle
type
TxBorderStyle = TOleEnum;
const
bsNone = $00000000;
bsSingle = $00000001;
// Константы для TxDragMode
type
TxDragMode = TOleEnum;
const
dmManual = $00000000;
dmAutomatic = $00000001;
// Константы для TxImeMode
type
TxImeMode = TOleEnum;
const
imDisable = $00000000;
imClose = $00000001;
imOpen = $00000002;
imDontCare = $00000003;
imSAlpha = $00000004;
imAlpha = $00000005;
imHira = $00000006;
imSKata = $00000007;
imKata = $00000008;
imChinese = $00000009;
imSHanguel = $OOOOOOOA;
imHanguel = $OOOOOOOB;
// Константы для TxScrollStyle
type
TxScrollStyle = TOleEnum;
const
ssNone = $00000000;
ssHorizontal = $00000001;
ssVertical = $00000002;
ssBoth = $00000003;
// Константы для TxMouseButton
type
TxMouseButton = TOleEnum;
const
mbLeft = $00000000;
mbRight = $00000001;
mbMiddle = $00000002;
type
// Предварительное объявление типов, определенных в библиотеке типов
//***********************************************
IRichEditX = interface;
IRichEditXDisp = dispinterface;
IRichEditXEvents = dispinterface;
//***********************************************
// Объявление CoClasses, определенных в библиотеке типов
//***********************************************
RichEditX = IRichEditX;
//***********************************************
// Объявление структур, союзов и альянсов.
//***********************************************
PPUserTypel = AIFontDisp; {*}
//***********************************************
// Interface: IRichEditX
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {86F5C46C-CDA6-4279-8BF4-F69F1A051ED7}
//***********************************************
IRichEditX = interface(IDispatch)
['{86F5C46C-CDA6-4279-8BF4-F69F1A051ED7}']
function Get_Alignment: TxAlignment; safecall;
procedure Set_Alignment(Value: TxAlignment); safecall;
function Get_BorderStyle: TxBorderStyle; safecall;
procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
function Get_Color: OLE_COLOR; safecall;
procedure Set_Color(Value: OLE_COLOR); safecall;
function Get_Ctl3D: WordBool; safecall;
procedure Set_Ctl3D(Value: WordBool); safecall;
function Get_DragCursor: Smallint; safecall;
procedure Set__DragCursor'(Value: Smallint); safecall;
function Get_DragMode: TxDragMode; safecall;
procedure Set_DragMode(Value: TxDragMode); safecall;
function Get_Enabled: WordBool; safecall;
procedure Set_Enabled(Value: WordBool); safecall;
function Get_Font: .IFontDisp; safecall;
procedure _Set_Font(const Value: IFontDisp); safecall;
procedure Set_Font(var Value: IFontDisp); safecall;
function Get_HideSelection: WordBool; safecall;
procedure Set_HideSelection(Value: WordBool); safecall;
function Get_HideScrollBars: WordBool; safecall;
procedure Set_HideScrollBars(Value: WordBool); safecall;
function Get_ImeMode: TxImeMode; safecall;
procedure Set_ImeMode(Value: TxImeMode); safecall;
function Get_ImeName: WideString; safecall;
procedure Set_ImeName(const Value: WideString}; safecall;
function Get_Lines: IStririgs; safecall;
procedure Set_Lines(const Value: IStrings); safecall;
function Get_MaxLength: Integer; safecall;
procedure Set_MaxLength(Value: Integer); safecall;
function Get_ParentColor: WordBool; safecall;
procedure Set_ParentColor(Value: WordBool); safecall;
function Get_ParentCtl3D: WordBool; safecall;
procedure Set_ParentCtl3D(Value: WordBool); safecall;
function Get_PlainText: WordBool; safecall;
procedure Set_PlainText(Value: WordBool); safecall;
function Get_ReadOnly: WordBool; safecall;
procedure Set_ReadOnly(Value: WordBool); safecall;
function Get_ScrollBars: TxScrollStyle; safecall;
procedure Set_ScrollBars(Value: TxScrollStyle); safecall;
function Get_Visible: WordBool; safecall;
procedure Set_Visible(Value: WordBool); safecall;
function Get_WantTabs: WordBool; safecall;
procedure Set_WantTabs(Value: WordBool); safecall;
function Get_WantReturns: WordBool; safecall;
procedure Set_WantReturns(Value: WordBool); safecall;
function Get_WordWrap: WordBool; safecall;
procedure Set_WordWrap(Value: WordBool); safecall;
function Get_CanUndo: WordBool; safecall;
function Get_Modified: WordBool; safecall;
procedure Set_Modifled(Value: WordBool); safecall;
function Get_SelLength: Integer; safecall;
procedure Set_SelLength(Value: Integer); safecall;
function Get_SelStart: Integer; safecall;
procedure Set_SelStart(Value: Integer); safecall;
function Get_SelText: WideString; safecall;
procedure Set_SelText(const Value: WideString); safecall;
function GetJText: WideString; safecall;
procedure Set_Text(const Value:.WideString); safecall;
function Get_DoubleBuffered: WordBool; safecall;
procedure Set_DoubleBuffered(Value: WordBool); safecall;
function Get_VisibleDockClientCount: Integer; safecall;
function Get_Cursor: Smallint; safecall;
procedure Set_Cursor(Value: Smallint); safecall;
property Alignment: TxAlignment read Get_Alignment write Set_Alignment ;
property BorderStyle: TxBorderStyle read Get_BorderStyle write Set_BorderStyle;
property Color: OLE_COLOR read Get_Color write Set_Color,;
property CtlSD: WordBool read Get_Ctl3D write Set_Ctl3D;
property DragCursor: Smallint read Get_DragCursor write Set_DragCursor;
property DragMode: TxDragMode read Get_DragMode write Set_DragMode;
property Enabled: WordBool read Get_Enabled write Set_Enabled;
property Font: IFontDisp read Get_Font write _Set_Font;
property HideSelection: WordBool read Get_HideSelection write Set_HideSelection;
property HideScrollBars: WordBool read Get_HideScrollBars write Set_HideScrollBars;
property ImeMode: TxImeMode read Get_ImeMode write Set_ImeMode;
property ImeName: WideString read Get_ImeName write Set_ImeName;
property Lines: IStrings read Get_Lines write Set_Lines;
property MaxLength: Integer read Get_MaxLength write Set_MaxLength;
property ParentColor: WordBool read Get_ParentColor write Set_ParentColor;
property ParentCtlSD: WordBool read Get_ParentCtl3D write Set_ParentCtl3D;
property PlainText: WordBool read Get_PlainText write Set_PlainText;
property Readonly: WordBool read Get_ReadOnly write Set_ReadOnly;
property ScrollBars: TxScrollStyle read Get_ScrollBars write Set_ScrollBars;
property Visible: WordBool read Get_Visible write Set_Visible;
property WantTabs: WordBool read Get_WantTabs write Set_WantTabs;
property WantReturns: WordBool read Get_WantReturns write SetJWantReturns;
property Wordwrap: WordBool read Get_WordWrap write Set_WordWrap;
property CanUndo: WordBool read Get_CanUndo;
property Modified: WordBool read Get__Modified write Set_Modified;
property SelLength: Integer read Get_SelLength write Set_SelLength;
property SelStart: Integer read Get_SelStart write Set_SelStart;
property SelText: WideString read Get_SelText write Set_SelText;
property Text: WideString read Get_Text write Set_Text;
property DoubleBuffered: WordBool read Get_DoubleBuffered write Set_DoubleBuffered;
property VisibleDockClientCount: Integer read Get_VisibleDockClientCoxint;
property Cursor: Smallint read Get_Cursor write Set_Cursor;
end;
//***********************************************
// Displntf: IRichEditXDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {86F5C46C-CDA6-4279-8BF4-F69F1A051ED7}
//***********************************************
IRichEditXDisp = dispinterface
['{86F5C46C-CDA6-4279-8BF4-F69F1A051ED7}']
property Alignment: TxAlignment dispid 1;
property BorderStyle: TxBorderStyle dispid 2;
property Color: OLE_COLOR dispid -501;
property Ctl3D: WordBool dispid 3;
property DragCursor: Smallint dispid 4;
property DragMode: TxDragMode dispid 5;
property Enabled: WordBool dispid -514;
property Font: IFontDisp dispid -512;
property HideSelection: WordBool dispid 6;
property HideScrollBars: WordBool dispid 7;
property ImeMode: TxImeMode dispid 8;
property ImeName: WideString dispid 9;
property Lines: IStrings dispid 10;
property MaxLength: Integer dispid 11;
property ParentColor: WordBool dispid 12;
property ParentCtl3D: WordBool dispid 13;
property PlainText: WordBool dispid 14;
property Readonly: WordBool dispid 15;
property ScrollBars: TxScrollStyle dispid 16;
property Visible: WordBool dispid 17;
property WantTabs: WordBool dispid 18;
property WantReturns: WordBool dispid 19;
property Wordwrap: WordBool dispid 20;
property CanUndo: WordBool readonly dispid 34;
property Modified: WordBool dispid 35;
property SelLength: Integer dispid 36;
property SelStart: Integer dispid 37;
property SelText: WideString dispid 38;
property Text: WideString dispid -517;
property DoubleBuffered: WordBool dispid 39;
property VisibleDockClientCount: Integer readonly dispid 40;
property Cursor: Smallint dispid 49;
end;
//***********************************************
// Displntf: IRichEditXEvents
// Flags: (0)
// QUID: {21AB5F94-7D87-4FCO-AB5A-9BCE1D05AF8B}
//***********************************************
IRichEditXEvents = dispinterface
['{21AB5F94-7D87-4FCO-AB5A-9BCE1D05AF8B}']
procedure OnChange; dispid 1;
procedure OnKeyPress(var Key: Smallint); dispid 8;
procedure OnProtectChange(StartPos: Integer; EndPos: Integer; var AllowChange: WordBool); dispid 16;
procedure OnSaveClipboardfNumObjects: Integer; NumChars: Integer; var SaveClipboard: WordBool); dispid 18;
procedure OnSelectionChange; dispid 19;
end;

// Объявление класса OLE Control Proxy
// Control Name TRichEditX
// Help String RichEditX Control
// Default Interface IRichEditX
// Def. Intf. DISP? No
// Event Interface IRichEditXEvents
// TypeFlags (34) CanCreate Control
//***********************************************
TRichEditXOnKeyPress = procedure(Sender: TObject; var Key: Smallint) of object;
TRichEditXOnProtectChange = procedure(Sender: TObject; StartPos: Integer; EndPos: Integer;
var AllowChange: WordBool) of object;
TRichEditXOnSaveClipboard = procedure(Sender: TObject; NumObjects: Integer; NumChars-: Integer;
var SaveClipboard: WordBool) of object;
TRichEditX = class(Telecontrol)
private
FOnChange: TNotifyEvent;
FOnKeyPress: TRichEditXOnKeyPress;
FOnProtectChange: TRichEditXOnProtectChange;
FOnSaveClipboard: TRichEditXOnSaveClipboard;
FOnSelectionChange: TNotifyEvent;
FIntf: IRichEditX;
function GetControlInterface: IRichEditX;
protected
procedure CreateControl;
procedure InitControlData; override/function Get_Lines: IStrings;
procedure Set_Lines(const Value: IStrings);
public
property Controllnterface: IRichEditX read GetControlInterface;
property Defaultlnterface: IRichEditX read GetControlInterface;
property CanUndo: WordBool index 34 read GetWordBoolProp;
property Modified: WordBool index 35 read GetWordBoolProp write SetWordBoolProp;
property SelLength: Integer index 36 read GetlntegerProp write SetlntegerProp;
property SelStart: Integer index 37 read GetlntegerProp write SetlntegerProp;
property SelText: WideString index 38 read GetWideStringProp write SetWideStringProp;
property Text: WideString index -517 read GetWideStringProp write SetWideStringProp;
property DoubleBuffered: WordBool index 39 read GetWordBoolProp write SetWordBoolProp;
property VisibleDockClientCount: Integer index 40 read GetlntegerProp;
published
property Alignment: TOleEnum index 1 read GetTOleEnumProp write SetTOleEnumProp stored False;
property BorderStyle: TOleEnum index 2 read GetTOleEnumProp write SetTOleEnumProp stored False;
property Color: TColor index -501 read GetTColorProp write SetTColorProp stored False;
property Ctl3D: WordBool index 3 read GetWordBoolProp write SetWordBoolProp stored False;
property DragCursor: Smallint index 4 read GetSmallintProp write SetSmallintProp stored False property DragMode: TOleEnum index 5 read GetTOleEnumProp write SetTOleEnumProp stored False;
property Enabled: WordBool index -514 read GetWordBoolProp write SetWordBoolProp stored False;
property Font: TFont index -512 read GetTFontProp write SetTFontProp stored False;
property HideSelection; WordBool index 6 read GetWordBoolProp write SetWordBoolProp stored False;
property HideScrollBars: WordBool index 7 read GetWordBoolProp write SetWordBoolProp stored False;
property ImeMode: TOleEnum index 8 read GetTOleEnumProp write SetTOleEnumProp stored False;
property ImeName: WideString index 9 read GetWideStringProp write SetWideStringProp stored False;
property Lines: IStrings read Get_Lines write Set_Lines stored False property MaxLength: Integer index 11 read GetlntegerProp write SetlntegerProp stored False
property ParentColor: WordBool index 12 read GetWordBoolProp write SetWordBoolProp stored False;
property ParentCtlSD: WordBool index 13 read GetWordBoolProp write SetWordBoolProp stored False;
property PlainText: WordBool index 14 read GetWordBoolProp write SetWordBoolProp stored False;
property Readonly: WordBool index 15 read GetWordBoolProp write SetWordBoolProp stored False;
property ScrollBars: TOleEnum index 16 read GetTOleEnumProp write SetTOleEnumProp stored False;
property Visible: WordBool index 17 read GetWordBoolProp write SetWordBoolProp stored False;
property WantTabs: WordBool index 18 read GetWordBoolProp write SetWordBoolProp stored False;
property WantReturns: WordBool index 19 read GetWordBoolProp write SetWordBoolProp stored False;
property Wordwrap: WordBool index 20 read GetWordBoolProp write SetWordBoolProp stored False;
property Cursor: Smallint index 49 read GetSmallintProp write SetSmallintProp stored False;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnKeyPress: TRichEditXOnKeyPress read FOnKeyPress write FOnKeyPress;
property OnProtectChange: TRichEditXOnProtectChange read FOnProtectChange write FOnProtectChange;
property OnSaveClipboard: TRichEditXOnSaveClipboard read FOnSaveClipboard write FOnSaveClipboard;
property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
end;
procedure Register; implementation uses ComObj;
procedure TRichEditX.InitControlData; const
CEventDispIDs: array [0..4] of DWORD = (
$00000001, $00000008, $00000010, $00000012, $00000013); CTFontlDs: array [0..0] of DWORD = (
$FFFFFEOO); CControlData: TControlData2 = (
ClassID: '{7C731EEO-D98D-4040-8FE1-EOCB9E54C58B}';
EventHD: '{21AB5F94-7D87-4FCO-AB5A-9BCE1D05AF8B}';
EventCount: 5;
EventDispIDs: @CEventDispIDs;
LicenseKey: nil (*HR:$80040154*);
Flags: $00000020;
Version: 401;
FontCount: 1;
FontlDs: @CTFontIDs);
begin
ControlData := @CControlData;
TControlData2(CControlData).FirstEventOfs := Cardinal(SSFOnChange) - Cardinal(Self);
end;
procedure TRichEditX.CreateControl;
procedure DoCreate;
begin
FIntf := lUnknown(OleObject) as IRichEditX;
end;
begin
if FIntf = nil then DoCreate;
end;
function TRichEditX.GetControlInterface: IRichEditX;
begin
CreateControl;
Result := FIntf;
end;
function TRichEditX.Get_Lines: IStrings;
begin
Result := DefaultInterface.Get_Lines;
end;
procedure TRichEditX.Set_Lines(const Value: IStrings);
begin
Defaultlnterface.Set_Lines(Value);
end;
procedure Register;
begin
RegisterComponents('ActiveX',[TRichEditX]);
end;
end.

Как вы можете видеть, приведенные выше листинги имеют достаточно большой размер. Но тот факт, что Delphi берет на себя такую большую работу, позволяет даже непрофессионалу в разработке элементов управления ActiveX создавать свои ActiveX при помощи мастера. Мастер в данном случае генерирует полностью функциональный элемент управления ActiveX с интерфейсами, библиотекой типов и событиями, при этом разработчику не нужно вводить собственный код!
Для установки данного элемента управления в палитру компонентов Delphi нужно сделать следующее:
1. Откомпилировать проект с помощью пункта главного меню Project/Compile <имя проекта> (Проект/Компилировать <имя проекта>), при этом будет создана библиотека OCX.
2. С помощью пункта главного меню Component/Import ActiveX Control (Компонент/Импорт элемента управления ActiveX) открыть окно импорта нового элемента ActiveX.
3. В диалоговом окне импорта ActiveX нажать кнопку Add (Добавить), перейти в каталог, содержащий созданный файл OCX, и выбрать его двойным щелчком, элемент управления появится в списке диалогового окна импорта ActiveX.
4. Выбрать данный элемент управления в списке и нажать кнопку Install (Установить).
5. Выбрать файл пакета и нажать кнопку ОК.
После выполнения данной последовательности шагов в палитре компонентов Delphi появится ваш элемент управления ActiveX.
Следует заметить, что создание элементов управления ActiveX из стандартных компонентов Delphi применяется очень редко. Вы можете использовать данную процедуру преобразования компонента в ActiveX к самостоятельно созданному компоненту, что значительно расширит его функциональность и позволит использовать ваш компонент разработчиками в других средах программирования.



Содержание раздела

---