unit SortIntf;

 

interface

 

type

  ISortIntf = interface

  ['{BE229ED0-BA7B-11DA-B665-00508B0973BE}']

    procedure Sort(var A: Variant); stdcall;

  end;

 

implementation

 

end.

type

  TBubbleSort = class(TComObject, ISortIntf)

  protected

    procedure Sort(var A: Variant); stdcall;

  end;

uses ComServ, Variants;

 

{ TBubbleSort }

 

procedure TBubbleSort.Sort(var A: Variant);

var

  I, J, T: Integer;

  HighBound, LowBound: integer;

begin

  HighBound := VarArrayHighBound(A, 1);

  LowBound := VarArrayLowBound(A, 1);

  for I := HighBound downto LowBound do

    for J := LowBound to HighBound - 1 do

      if A[J] > A[J + 1] then

      begin

        T := A[J];

        A[J] := A[J + 1];

        A[J + 1] := T;

      end;

end;

const

  Class_BubbleSort: TGUID = '{CFB8F671-BA45-11DA-B665-00508B0973BE}';

  Class_SelectionSort: TGUID = '{BE229ED3-BA7B-11DA-B665-00508B0973BE}';

  Class_QuickSort: TGUID = '{BE229ED4-BA7B-11DA-B665-00508B0973BE}';

 

implementation

 

uses COMObj, SortIntf;

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

var

  Bubble: ISortIntf;

  i: integer;

  A: Variant;

  HighBound, LowBound: integer;

  Class_ID: TGUID;

  ElemCount: integer;

begin

  //Получаем нужный CLSID

  Class_ID := StringToGUID(ListBox1.Items[ListBox1.ItemIndex]);

  //Создаем класс по этому CLSID и сразу просим у него интерфейс ISortIntf

  Bubble := CreateCOMObject(Class_ID) as ISortIntf;

  ElemCount := SpinEdit1.Value;

  //Массив создаем и записываем в мемо

  A := VarArrayCreate([0,ElemCount-1], varInteger);

  Memo1.Lines.Clear;

  HighBound := VarArrayHighBound(A, 1);

  LowBound := VarArrayLowBound(A, 1);

  for i := LowBound to HighBound do

  begin

    A[i] := random(300);

    Memo1.Lines.Add(IntToStr(A[i]));

  end;

  //А вот, собственно, и вызов метода плагина

  Bubble.Sort(A);

  //Остается показать результат

  Memo1.Lines.Add('Sorted');

  HighBound := VarArrayHighBound(A, 1);

  LowBound := VarArrayLowBound(A, 1);

  for i := LowBound to HighBound do

  begin

    Memo1.Lines.Add(IntToStr(A[i]));

  end;

end;

 

procedure TForm1.FormShow(Sender: TObject);

begin

  with ListBox1.Items do

  begin

    Clear;

    Add(GUIDToString(Class_BubbleSort));

    Add(GUIDToString(Class_SelectionSort));

    Add(GUIDToString(Class_QuickSort));

  end;

  ListBox1.ItemIndex := 0;

end;

unit CVector;

 

{$WARN SYMBOL_PLATFORM OFF}

 

interface

 

uses

  ComObj, ActiveX, VectorLib_TLB, StdVcl, SortIntf_TLB;

 

type

  TVector = class(TAutoObject, IVector)

  private

    FArray: array of integer;

  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 }

  end;

 

implementation

 

uses ComServ;

 

function TVector.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 TVector.Get_Count: Integer;

begin

  Result := Length(FArray);

end;

 

function TVector.Get_Elem(Index: Integer): OleVariant;

begin

  Result := FArray[Index];

end;

 

procedure TVector.Exchange(Index1, Index2: Integer);

var

  T: integer;

begin

  T := FArray[Index1];

  FArray[Index1] := FArray[Index2];

  FArray[Index2] := T;

end;

 

procedure TVector.Set_Count(Value: Integer);

begin

  if Value <> Length(FArray) then

    SetLength(FArray, Value);

end;

 

procedure TVector.Set_Elem(Index: Integer; Value: OleVariant);

begin

  FArray[Index] := Value;

end;

 

initialization

  TAutoObjectFactory.Create(ComServer, TVector, Class_Vector,

    ciMultiInstance, tmApartment);

end.

unit CSort;

 

{$WARN SYMBOL_PLATFORM OFF}

 

interface

 

uses

  ComObj, ActiveX, SortLib_TLB, StdVcl, SortIntf_TLB;

 

type

  TSort = class(TAutoObject, ISort)

  protected

    procedure Sort(const Vector: IVector); safecall;

    { Protected declarations }

  end;

 

implementation

 

uses ComServ;

 

procedure TSort.Sort(const Vector: IVector);

var

  I, J: Integer;

begin

  for I := Vector.Count - 1 downto 0 do

    for J := 0 to Vector.Count - 2 do

      if Vector.Compare(J, J + 1) = crGreater then

        Vector.Exchange(J, J + 1);

end;

 

initialization

  TAutoObjectFactory.Create(ComServer, TSort, Class_Sort,

    ciMultiInstance, tmApartment);

end.

unit SortFactory;

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 := 19;

    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.

unit SortConsts;

interface

 

const

  CATID_SortServer: TGUID = '{782D841E-BB21-11DA-B666-00508B0973BE}';

  Sort_CatDesc = 'Библиотеки сортировки. Тестовый пример';

 

implementation

 

end.

initialization

  TSortAutoObjectFactory.Create(ComServer, TSort, Class_Sort,

    ciMultiInstance, tmApartment);

end.

procedure TSort.Sort(const Vector: IVector);

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;

unit CDVector;

 

{$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.

unit FSort;

 

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.Next(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.

  //Нужна библиотека типов, в которой описан IVector

  OleCheck(LoadRegTypeLib(LIBID_SortIntf, 1, 0, 0, TypeLib));

  VecObj := TDVector.Create(TypeLib, IVector);

  VecObj.FillRandom(SpinEdit1.Value);

  Vector := VecObj as IVector;

  VecObj := nil; //От греха

procedure TForm1.btnInt2Click(Sender: TObject);

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;