高分求教，我的窗口嵌入到IE的工具栏中，

Question

不好意思，go.163.com连接不上，我就把程序放到这里吧(两个文件)
1.main.pas
==========================================================================
unit main;interfaceuses
Windows, ActiveX, ComObj, ShlObj, Bar, SHDocVw;Type
TBarType=(btInfo,btDesk,btComm,btToolbar);const
BarName='测试工具栏';
BarType=btToolbar;
MIN_SIZE_X=80;
MIN_SIZE_Y=24;
Class_IEBar: TGUID = '{222CCD87-2240-11D4-97C2-0000E8974CF6}';
IID_IOleWindow:TGUID='{00000114-0000-0000-C000-000000000046}';
IID_IInputObjectSite:TGUID=SID_IInputObjectSite;
SID_Extension='{7C4A7901-224E-11D4-97C2-0000E8974CF6}';
CATID_DeskBand:TGUID=(D1:$00021492; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
CATID_InfoBand:TGUID=(D1:$00021493; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
CATID_CommBand:TGUID=(D1:$00021494; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));type
TIEBar = Class(TComObject,IDeskBand,IObjectWithSite,IPersistStream)
private
FBandID:DWORD;
FViewMode:DWORD;
    Site: IInputObjectSite;
    cmdTarget: IOleCommandTarget; IE:IWebBrowser2;
ParentWnd:HWnd;
frmBar: TfrmBar;
protected
//IDeskBand = interface(IDockingWindow)[SID_IDeskBand]
function GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):HResult; stdcall; //IDockingWindow = interface(IOleWindow)[SID_IDockingWindow]
function ShowDW(fShow: BOOL): HResult; stdcall;
function CloseDW(dwReserved: DWORD): HResult; stdcall;
function ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;fReserved: BOOL): HResult; stdcall; //IOleWindow = interface(IUnknown)['{00000114-0000-0000-C000-000000000046}']
function GetWindow(out wnd: HWnd): HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall; //IObjectWithSite = interface ['{FC4801A3-2BA9-11CF-A229-00AA003D7352}']
function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;
function GetSite(const riid: TIID; out site: IUnknown):HResult; stdcall; //IPersistStream = interface(IPersist) ['{00000109-0000-0000-C000-000000000046}']
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; //IPersist = interface(IUnknown)['{0000010C-0000-0000-C000-000000000046}']
function GetClassID(out classID: TCLSID): HResult; stdcall; //IInputObject = interface(IUnknown) [SID_IInputObject]
function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall;
function HasFocusIO: HResult; stdcall;
function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;
public
//TComObject
procedure Initialize; Override;
end;implementationuses ComServ, SysUtils, ShellApi, registry;{$R BarIcon.res}
{ TIEBar }function TIEBar.CloseDW(dwReserved: DWORD): HResult;
begin
if Assigned(frmBar) then
begin
frmBar.Free;
frmBar := nil;
end;
Result := S_OK;
end;function TIEBar.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
Result := S_OK;
end;function TIEBar.GetBandInfo(dwBandID, dwViewMode: DWORD;
var pdbi: TDeskBandInfo): HResult;
begin
FBandID := dwBandID;
FViewMode := dwViewMode; if (pdbi.dwMask and DBIM_MINSIZE)>0 then
begin
pdbi.ptMinSize.x := MIN_SIZE_X;
pdbi.ptMinSize.y := MIN_SIZE_Y;
end; if(pdbi.dwMask and DBIM_MAXSIZE)>0 then
begin
pdbi.ptMaxSize.x := -1;
pdbi.ptMaxSize.y := -1;
end;
//如果设置了这个就可以调整大小
{if (pdbi.dwMask and DBIM_INTEGRAL)>0 then
begin
pdbi.ptIntegral.x := 1;
pdbi.ptIntegral.y := 1;
end;} if (pdbi.dwMask and DBIM_ACTUAL)>0 then
begin
pdbi.ptActual.x := 0;
pdbi.ptActual.y := 0;
end; if (pdbi.dwMask and DBIM_MODEFLAGS)>0 then
pdbi.dwModeFlags := DBIMF_VARIABLEHEIGHT; Result := S_OK;
end;function TIEBar.GetClassID(out classID: TCLSID): HResult;
begin
classID := Class_IEBar;
Result := S_OK;
end;function TIEBar.GetSite(const riid: TIID; out site: IUnknown): HResult;
begin
if Assigned(Site) then
Result := Site.QueryInterface(riid, site)
else
Result := E_FAIL;
end;function TIEBar.GetSizeMax(out cbSize: Largeint): HResult;
begin
cbSize := 0;
Result := E_NOTIMPL;
end;function TIEBar.GetWindow(out wnd: HWnd): HResult;
begin
if not Assigned(frmBar) then
  begin
   frmBar := TfrmBar.CreateParented(ParentWnd);
    frmBar.WebBrow := IE;
  end;
  wnd := frmBar.Handle;
Result := S_OK;
end;function TIEBar.HasFocusIO: HResult;
begin
if Assigned(frmBar) and (frmBar.Active) then
Result := S_OK
else
Result := E_FAIL;
end;procedure TIEBar.Initialize;
begin
inherited;
Site := nil;
IE := nil;
ParentWnd := 0;
frmBar := nil;
end;function TIEBar.IsDirty: HResult;
begin
Result := E_NOTIMPL;
end;function TIEBar.Load(const stm: IStream): HResult;
begin
Result := E_NOTIMPL;
end;function TIEBar.ResizeBorderDW(var prcBorder: TRect;
punkToolbarSite: IUnknown; fReserved: BOOL): HResult;
var
rc:TRect;
begin
if Assigned(frmBar) then
begin
GetClientRect(ParentWnd, rc);
frmBar.SetBounds(rc.Left,rc.Top,rc.Right-rc.Left,rc.Bottom-rc.Top);
end;
Result := S_OK;
end;function TIEBar.Save(const stm: IStream; fClearDirty: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;function TIEBar.SetSite(const pUnkSite: IUnknown): HResult;
begin
  if Assigned(pUnkSite) then begin
    Site := pUnkSite as IInputObjectSite;
    (pUnkSite as IOleWindow).GetWindow(ParentWnd);
    cmdTarget := pUnkSite as IOleCommandTarget;
    (CmdTarget as IServiceProvider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
  end;
  Result := S_OK;
end;function TIEBar.ShowDW(fShow: BOOL): HResult;
begin
if Assigned(frmBar) then frmBar.Visible := fShow;
Result := S_OK;
end;{TIEBarFactory}
type
TIEBarFactory = class(TComObjectFactory)
public
 procedure UpdateRegistry(Register: Boolean); override;
end;function GetModuleFileName: string;
var
Buffer: array[0..261] of Char;
begin
SetString(Result, Buffer, Windows.GetModuleFileName(HInstance,
Buffer, SizeOf(Buffer)));
end;procedure TIEBarFactory.UpdateRegistry(Register: Boolean);
var
ClassID,CatClassID: string;
begin
ClassID := GUIDToString(Class_IEBar);
case BarType of
btInfo:CatClassID:=GUIDToString(CATID_InfoBand);
btComm:CatClassID:=GUIDToString(CATID_CommBand);
btDesk:CatClassID:=GUIDToString(CATID_DeskBand);
btToolbar:CatClassID:=GUIDToString(CATID_CommBand);
end;
if Register then begin
inherited UpdateRegistry(Register);
CreateRegKey('CLSID\'+ClassID+'\Implemented Categories','','');
CreateRegKey('CLSID\'+ClassID+'\Implemented Categories\'+CatClassID,'','');
if BarType=btToolbar then begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if not OpenKey('SOFTWARE\Microsoft\Internet Explorer',False) then Exit;
CloseKey;
OpenKey('SOFTWARE\Microsoft\Internet Explorer\Toolbar',True);
WriteString(ClassID,'');
CloseKey;
finally
Free;
end;
end;
end else begin
DeleteRegKey('CLSID\'+ClassID+'\Implemented Categories\'+CatClassID);
DeleteRegKey('CLSID\'+ClassID+'\Implemented Categories');
if BarType=btToolbar then begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\Microsoft\Internet Explorer\Toolbar',False);
DeleteValue(ClassID);
CloseKey;
finally
Free;
end;
end;
inherited UpdateRegistry(Register);
end;
end;
function TIEBar.TranslateAcceleratorIO(var lpMsg: TMsg): HResult;
begin
  if (lpMsg.WParam <> VK_TAB) then begin
    TranslateMessage(lpMSg);
    DispatchMessage(lpMsg);
    Result := S_OK;
  end
  else Result := S_FALSE;
end;function TIEBar.UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult;
begin
if Assigned(frmBar) and fActivate then SetFocus(frmBar.Handle);
Result := S_OK;
end;initialization
TIEBarFactory.Create(ComServer, TIEBar, Class_IEBar,'', BarName,
ciMultiInstance,tmApartment);
end.2.bar.pas
===============================================================================
unit Bar;interfaceuses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons, graphics, OleCtrls, SHDocVw, fcImage,
  fcImageForm, Menus;type
TfrmBar = class(TForm)
btnStart: TSpeedButton;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    procedure btnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
img:TImage;
procedure NavigateFromBand(const URL: string);
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
public
{ Public declarations }
WebBrow:IWebBrowser2;
end;
implementation{$R *.DFM}{ TfrmBar }procedure TfrmBar.btnStartClick(Sender: TObject);
begin
NavigateFromBand(edit1.text);
end;procedure TfrmBar.NavigateFromBand(const URL: string);
var
  _url: OleVariant;
  X: OleVariant;
begin
  _Url := Url;
  X := 0;
  WebBrow.Navigate(Url, X, X, X, X);
end;
procedure TfrmBar.WMEraseBkgnd(var Message: TWmEraseBkgnd);
var
  Rec,Rec1:TRect;
begin
  img.Picture.Bitmap.Width := Left + Width;
  img.Picture.Bitmap.Height := Top + Height;
  img.Visible := True;
  SendMessage(ParentWindow,WM_ERASEBKGND,img.Canvas.Handle,0);
GetUpdateRect(Handle,Rec,True);
  Rec1.Left := Rec.Left + Left;
  Rec1.Top  := Rec.Top  + Top;
  Rec1.Right  := Rec.Right  + Left;
  Rec1.Bottom := Rec.Bottom + Top;
  Canvas.CopyRect(Rec,img.Canvas,Rec1);
  Message.Result := 0;
end;procedure TfrmBar.FormCreate(Sender: TObject);
begin
img := TImage.Create(Self);
end;procedure TfrmBar.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  img.Picture.Bitmap.Free;
  img.Picture.Bitmap := nil;
img.Free;
end;
end.

Answer 1

我也连不上，go.163.com上的东西都是这样的，你应考虑放在其它地方，不知你问题解决了没有。

Answer 2

背景图片的问题解决了，是这样处理的(让父窗口为我去绘)
if (Message.Msg = WM_ERASEBKGND) then
begin
  SetWindowOrgEx(frmBar.Canvas.Handle,frmBar.Left,frmBar.Top,nil);
  SendMessage(ParentWnd,Message.Msg,frmBar.Canvas.Handle,Message.lParam);
end else
  OldWndProc(Message);
但是键盘焦点的问题还是没有办法。请各位在看一看

Answer 3

键盘焦点的问题也解决了，原来我少实现了一个接口IInputObject,这个接口就是负责处理这件事情的。关于Tab键，还是不太好。现在我是这么处理的，在IInputObject的TranslateAcceleratorIO方法里处理除TAB以外的键，如果有我处理TAB就不能用TAB键把焦点转移出去，下面的代码可以转移除焦点，但是去不能从其他地方转移回来。我看了网易的那个工具栏也有这个问题。不知到哪里还不对。
function TIEBar.TranslateAcceleratorIO(var lpMsg: TMsg): HResult;
begin
  if (lpMsg.WParam <> VK_TAB) then begin
    TranslateMessage(lpMSg);
    DispatchMessage(lpMsg);
    Result := S_OK;
  end else
    Result := S_FALSE;
end;