Интерфейсы и плагины
Как можно догадаться, это своеобразная реализация метода пузырька, несмотря на то, что модуль называется CSort. Так получилось, а переименовывать достаточно тяжело.И тут же возникает мысль, а дальше? Ну сделаем мы еще пару классов Sort, но понадобится же их как-то опознавать. А при подключении библиотеки можно было видеть, сколько всего есть библиотек типов в системе, не перебирать же их. Разумеется, способ выделить свои классы есть, и называется он Component Categories, то есть категории компонентов. Фактически, это просто способ записи группы интерфейсов в реестр, для которого есть встроенный механизм. И, разумеется, этот механизм основан на интерфейсах. Остается его только задействовать, и лучше всего регистрировать класс в категории одновременно с регистрацией сервера. На самом деле, это даже проще: при регистрации сервера ActiveX в системе вызываются методы UpdateRegistry всех имеющихся фабрик классов. Фабрика, разумеется, у нас создается, обратите внимание на секцию initialization выше. Нужно создать потомок этой фабрики, перекрыв метод UpdateRegistry:
interface
uses COMObj;
type
TSortAutoObjectFactory = class(TAutoObjectFactory)
public
procedure UpdateRegistry(Register: boolean); override;
end;
implementation
uses ActiveX, SysUtils, SortConsts;
{ TSortAutoObjectFactory }
procedure TSortAutoObjectFactory.UpdateRegistry(Register: boolean);
var
CatReg: ICatRegister;
CatInfo: TCATEGORYINFO;
begin
inherited;
OleCheck(CoCreateInstance(CLSID_StdComponentCategoryMgr, nil,
CLSCTX_INPROC_SERVER, ICatRegister, CatReg));
if Register then
begin
CatInfo.catid := CATID_SortServer;
CatInfo.lcid := $0419;
StringToWideChar(Sort_CatDesc, CatInfo.szDescription,
Length(Sort_CatDesc) + 1);
OleCheck(CatReg.RegisterCategories(1, @CatInfo));
OleCheck(CatReg.RegisterClassImplCategories(ClassID, 1, @CATID_SortServer));
end else
begin
OleCheck(CatReg.UnRegisterClassImplCategories(ClassID, 1, @CATID_SortServer));
DeleteRegKey(Format('CLSID\%s\Implemented Categories', [GUIDToString(ClassID)]));
end;
end;
end.
interface
const
CATID_SortServer: TGUID = '{782D841E-BB21-11DA-B666-00508B0973BE}';
Sort_CatDesc = 'Библиотеки сортировки. Тестовый пример';
implementation
end.
TSortAutoObjectFactory.Create(ComServer, TSort, Class_Sort,
ciMultiInstance, tmApartment);
end.
var
I, J: Integer;
begin
for I := 0 to Vector.Count - 2 do
for J := Vector.Count - 1 downto I + 1 do
if Vector.Compare(I,J) = crGreater then
Vector.Exchange(I,J);
end;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, StdVcl, SortIntf_TLB;
type
TDVector = class(TAutoIntfObject, IVector)
private
FArray: array of Double;
protected
function Compare(Index1, Index2: Integer): CompareResult; safecall;
function Get_Count: Integer; safecall;
function Get_Elem(Index: Integer): OleVariant; safecall;
procedure Exchange(Index1, Index2: Integer); safecall;
procedure Set_Count(Value: Integer); safecall;
procedure Set_Elem(Index: Integer; Value: OleVariant); safecall;
{ Protected declarations }
public
procedure FillRandom(Size: integer);
end;
implementation
function TDVector.Compare(Index1, Index2: Integer): CompareResult;
begin
Result := crLower;
if FArray[Index1] > FArray[Index2] then
Result := crGreater;
if FArray[Index1] = FArray[Index2] then
Result := crEqual;
end;
function TDVector.Get_Count: Integer;
begin
Result := Length(FArray);
end;
function TDVector.Get_Elem(Index: Integer): OleVariant;
begin
Result := FArray[Index];
end;
procedure TDVector.Exchange(Index1, Index2: Integer);
var
T: Double;
begin
T := FArray[Index1];
FArray[Index1] := FArray[Index2];
FArray[Index2] := T;
end;
procedure TDVector.Set_Count(Value: Integer);
begin
if Value <> Length(FArray) then
SetLength(FArray, Value);
end;
procedure TDVector.Set_Elem(Index: Integer; Value: OleVariant);
begin
FArray[Index] := Value;
end;
procedure TDVector.FillRandom(Size: integer);
var
i: integer;
begin
SetLength(FArray, Size);
for i := Low(FArray) to High(FArray) do
FArray[i] := Random;
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin, SortIntf_TLB;
type
TForm1 = class(TForm)
Memo1: TMemo;
ListBox1: TListBox;
btnInt: TButton;
btnDouble: TButton;
SpinEdit1: TSpinEdit;
procedure FormCreate(Sender: TObject);
procedure btnDoubleClick(Sender: TObject);
procedure btnIntClick(Sender: TObject);
private
procedure ShowSort(Vector: IVector);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses SortConsts, CDVector, COMObj, ActiveX, VectorLib_TLB;
procedure ListSortServers(List: TStrings);
var
EnumGUID: IEnumGUID;
Fetched: Cardinal;
Guid: TGUID;
CatInfo: ICatInformation;
begin
List.Clear;
OleCheck(CoCreateInstance(CLSID_StdComponentCategoryMgr, nil,
CLSCTX_INPROC_SERVER, ICatInformation, CatInfo));
OleCheck(CatInfo.EnumClassesOfCategories(1, @CATID_SortServer, 0, nil, EnumGUID));
while EnumGUID.(1, Guid, Fetched) = S_OK do
begin
//Переводим CLSID в более понятный вид
List.Add(ClassIDToProgID(Guid));
end;
end;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ListSortServers(ListBox1.Items);
if ListBox1.Items.Count > 0 then
ListBox1.ItemIndex := 0;
end;
procedure TForm1.btnDoubleClick(Sender: TObject);
var
TypeLib: ITypeLib;
Vector: IVector;
VecObj: TDVector;
i: integer;
begin
//Нужна библиотека типов, в которой описан IVector
OleCheck(LoadRegTypeLib(LIBID_SortIntf, 1, 0, 0, TypeLib));
VecObj := TDVector.Create(TypeLib, IVector);
VecObj.FillRandom(SpinEdit1.Value);
Vector := VecObj as IVector;
VecObj := nil; //От греха
ShowSort(Vector);
end;
procedure TForm1.btnIntClick(Sender: TObject);
var
Vector: IVector;
i: integer;
begin
Vector := CoVector.Create;
Vector.Count := SpinEdit1.Value;
for i := 0 to Vector.Count - 1 do
Vector.Elem[i] := Random(300);
ShowSort(Vector);
end;
procedure TForm1.ShowSort(Vector: IVector);
var
i: integer;
SortObj: ISort;
ProgID: string;
begin
Memo1.Lines.Clear;
for i := 0 to Vector.Count - 1 do
Memo1.Lines.Add(FormatFloat('##0.#####', Vector.Elem[i]));
//Создаем выбранный класс сортировки и сортируем
ProgID := ListBox1.Items[ListBox1.ItemIndex];
SortObj := CreateComObject(ProgIDToClassId(ProgID)) as ISort;
SortObj.Sort(Vector);
Memo1.Lines.Add('Sorted');
for i := 0 to Vector.Count - 1 do
Memo1.Lines.Add(FormatFloat('##0.#####', Vector.Elem[i]));
end;
end.
var
V: variant;
Sort: Variant;
i: integer;
begin
V := CreateOleObject('VectorLib.Vector');
V.Count := SpinEdit1.Value;
for i := 0 to V.Count - 1 do
V.Elem[i] := Random(300);
Memo1.Lines.Clear;
for i := 0 to V.Count - 1 do
Memo1.Lines.Add(FormatFloat('##0.#####', V.Elem[i]));
Sort := CreateOleObject(ListBox1.Items[ListBox1.ItemIndex]);
Sort.Sort(V);
Memo1.Lines.Add('Sorted');
for i := 0 to V.Count - 1 do
Memo1.Lines.Add(FormatFloat('##0.#####', V.Elem[i]));
end;
Отправить комментарий