unit MainUnit;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, Windows, IEButtonExample_TLB, StdVcl, ShlObj, SHDocVw,
  DeskBandForm,graphics;

type
  TIEBtnExample = class(TAutoObject, IIEBtnExample,
    IObjectWithSite, IPersistStream, IDeskBand)
  private
    FDeskBand: TDeskBandForm;
    FSite: IInputObjectSite;
  protected
    { IObjectWithSite }
    function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;
    function GetSite(const riid: TIID; out site: IUnknown):HResult; stdcall;
    { IPersistStream }
    function IsDirty: HResult; stdcall;
    function Load(const stm: IStream): HResult; stdcall;
    function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
    function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
    function GetClassID(out classID: TCLSID): HResult; stdcall;
    { IDeskBand }
    property DeskBand: TDeskBandForm read FDeskBand
      implements IDeskBand;
   public
     procedure AfterConstruction; override;
     procedure BeforeDestruction; override;
 end;

implementation

uses ComServ, SysUtils, OleCtnrs, Forms, Registry, MainFormUnit;

{ TIEBtnExample }

procedure TIEBtnExample.AfterConstruction;
begin
  FDeskBand:= TDeskBandForm.Create(Self);
end;

procedure TIEBtnExample.BeforeDestruction;
begin
  FDeskBand.Free;
end;

{ TIEBtnExample.IObjectWithSite }

function TIEBtnExample.GetSite(const riid: TIID;
  out site: IInterface): HResult;
begin
  Result:= E_NOTIMPL;
  if Assigned(FSite) then
    Result:= FSite.QueryInterface(riid, site);
end;

function TIEBtnExample.SetSite(const pUnkSite: IInterface): HResult;
var
  OleWindow: IOleWindow;
  ParentWnd: HWND;
begin
  Result:= E_FAIL;
  try
    // did we get a site??
    if Assigned(punkSite) then
    begin
      if Supports(punkSite, IOleWindow, OleWindow) then
      begin
        OleWindow.GetWindow(ParentWnd);
        if ParentWnd > 0 then
        begin
          FDeskBand.Form:= TMyForm.CreateParented(ParentWnd);
          FDeskBand.Form.height:=15;
          FDeskBand.Form.Visible:=True;
          FDeskBand.Form.Color:=clMenu;
//          FDeskBand.Form.Color:=clred;
          FDeskBand.Form.Repaint;
          if Supports(punkSite, IInputObjectSite, FSite) then
            Result:= S_OK;
        end;
      end
    end
    else
    begin
      FDeskBand.Form:= nil;
      FSite:= nil;
      Result:= S_OK;
    end;
  except
  end;
end;

{ TIEBtnExample.IPersistStream }

function TIEBtnExample.GetClassID(out classID: TCLSID): HResult;
begin
  ClassID:= CLASS_IEBtnExample;
  Result:= S_OK;
end;

function TIEBtnExample.GetSizeMax(out cbSize: Largeint): HResult;
begin
  Result:= E_NOTIMPL;
end;

function TIEBtnExample.IsDirty: HResult;
begin
  Result:= S_FALSE;
end;

function TIEBtnExample.Load(const stm: IStream): HResult;
begin
  Result:= S_OK;
end;

function TIEBtnExample.Save(const stm: IStream;
  fClearDirty: BOOL): HResult;
begin
  Result:= S_OK;
end;

type
  TDemoObjectFactory = class(TAutoObjectFactory)
  protected
    procedure UpdateRegistry(Register: Boolean); override;
  end;

{ TDemoObjectFactory }

procedure TDemoObjectFactory.UpdateRegistry(Register: Boolean);
var
  strClassID: string;
const
  ToolBarKey = 'Software\Microsoft\Internet Explorer\Toolbar';
begin
  inherited;
  strClassID := GUIDToString(ClassID);
  with TRegistry.Create do
  try
    RootKey:=HKEY_LOCAL_MACHINE;
    OpenKey(ToolBarKey, TRUE);
    if Register then begin
      WriteString(strClassID, Description);
    end else begin
      DeleteValue(strClassID);
    end;
  finally
    Free;
  end;

  strClassID := GUIDToString(CLASS_IEBtnExample);
  with TRegistry.Create do
  try
    RootKey:=HKEY_CLASSES_ROOT;
    OpenKey('CLSID\', TRUE);
    if Register then begin
      WriteString(strClassID, 'green test ');
    end else begin
      DeleteValue(strClassID);
    end;
  finally
    Free;
  end;
//  HKEY_CLASSES_ROOT\CLSID\{798E002B-F108-41D7-B726-8A136E1D8449}
end;

initialization
  TDemoObjectFactory.Create(ComServer, TIEBtnExample, Class_IEBtnExample,
    ciMultiInstance, tmApartment);
end.
