终于解决了让我头疼了很久的在IE工具条上backspace和tab键无效的问题，具体的解决方法如下：（这是个demo的文件）   

主要要实现接口：IInputObject;     

    {Declare IInputObject methods here}  

    function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall; 

    function HasFocusIO: HResult; stdcall;   

    function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;   

  以及方法：

    procedure FocusChange(bHasFocus: Boolean);   

    procedure BandWndProc(var Message: TMessage);    

具体请看以下demo代码：

 

delphi代码
  1. 终于解决了让我头疼了很久的在IE工具条上backspace和tab键无效的问题，具体的解决方法如下：（这是个demo的文件）   
  2. 主要要实现接口：IInputObject;   
  3.   
  4.     {Declare IInputObject methods here}  
  5.     function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall;   
  6.     function HasFocusIO: HResult; stdcall;   
  7.     function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;   
  8.   
  9. 以及方法：   
  10.   
  11.     procedure FocusChange(bHasFocus: Boolean);   
  12.     procedure BandWndProc(var Message: TMessage);    
  13. 具体请看以下demo代码：  
  14.    
  15.   
  16.     
  17.   
  18. 窗体文件：   
  19.   
  20. unit fmIEBar;   
  21.   
  22. interface  
  23.   
  24. uses  
  25.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   
  26.   Dialogs, StdCtrls, SHDocVw;   
  27.   
  28. type  
  29.   TfrmIEBar = class(TForm)   
  30.     TxtUrl: TEdit;   
  31.     procedure FormActivate(Sender: TObject);   
  32.     procedure FormShow(Sender: TObject);   
  33.   private  
  34.     { Private declarations }  
  35.   public  
  36.     { Public declarations }  
  37.     IEThis: IWebbrowser2;   
  38.   end;   
  39.   
  40. var  
  41.   frmIEBar: TfrmIEBar;   
  42.   
  43. implementation  
  44.   
  45. {$R *.dfm}  
  46.   
  47. { TfrmIEBar }  
  48.   
  49. procedure TfrmIEBar.FormActivate(Sender: TObject);   
  50. begin  
  51.   TxtUrl.SetFocus;   
  52. end;   
  53.   
  54. procedure TfrmIEBar.FormShow(Sender: TObject);   
  55. begin  
  56.   TxtUrl.SetFocus;   
  57. end;   
  58.   
  59. end.   
  60.   
  61.     
  62.   
  63. 具体实现文件：   
  64.   
  65.     
  66.   
  67. unit UTestTextBox;   
  68.   
  69. {$WARN SYMBOL_PLATFORM OFF}  
  70.   
  71. interface  
  72.   
  73. uses  
  74.   Windows, ActiveX, Classes, ComObj, MSHTML, SHDocVw, ShellAPI, TlHelp32, ShlObj, fmIEBar,   
  75.   Registry, Messages;   
  76.   
  77. type  
  78.   TTestTextBoxFactory = class(TComObjectFactory)   
  79.   public  
  80.     procedure UpdateRegistry(Register: Boolean); override;   
  81.   end;   
  82.   TTestTextBox = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit, IInputObject)   
  83.   private  
  84.     HasFocus: Boolean;   
  85.     frmIE: TfrmIEBar;   
  86.     m_pSite:IInputObjectSite;   
  87.     m_hwndParent:HWND;   
  88.     m_hWnd:HWND;   
  89.     m_dwViewMode:Integer;   
  90.     m_dwBandID:Integer;   
  91.     SavedWndProc: TWndMethod;   
  92.   protected  
  93.     procedure FocusChange(bHasFocus: Boolean);   
  94.     procedure BandWndProc(var Message: TMessage);   
  95.   public  
  96.     {Declare IDeskBand methods here}  
  97.     function GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):   
  98.          HResult; stdcall;   
  99.     function ShowDW(fShow: BOOL): HResult; stdcall;   
  100.     function CloseDW(dwReserved: DWORD): HResult; stdcall;   
  101.     function ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;   
  102.        fReserved: BOOL): HResult; stdcall;   
  103.     function GetWindow(out wnd: HWnd): HResult; stdcall;   
  104.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;   
  105.   
  106.     {Declare IObjectWithSite methods here}  
  107.     function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;   
  108.     function GetSite(const riid: TIID; out site: IUnknown):HResult;stdcall;   
  109.   
  110.     {Declare IPersistStream methods here}  
  111.     function GetClassID(out classID: TCLSID): HResult; stdcall;   
  112.     function IsDirty: HResult; stdcall;   
  113.     function InitNew: HResult; stdcall;   
  114.     function Load(const stm: IStream): HResult; stdcall;   
  115.     function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;   
  116.     function GetSizeMax(out cbSize: Largeint): HResult; stdcall;   
  117.     {Declare IInputObject methods here}  
  118.     function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall;   
  119.     function HasFocusIO: HResult; stdcall;   
  120.     function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;   
  121.   end;   
  122.   
  123. const  
  124.   Class_TestTextBox: TGUID = '{9FC0A716-35A4-4ACB-8565-EAA1C2D9E0A1}';   
  125.   //以下是系统接口的IID  
  126.   IID_IUnknown: TGUID = (   
  127.       D1:$00000000;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));   
  128.   IID_IOleObject: TGUID = (   
  129.       D1:$00000112;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));   
  130.   IID_IOleWindow: TGUID = (   
  131.       D1:$00000114;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));   
  132.   
  133.   IID_IInputObjectSite : TGUID = (   
  134.       D1:$f1db8392;D2:$7331;D3:$11d0;D4:($8C,$99,$00,$A0,$C9,$2D,$BF,$E8));   
  135.   sSID_SInternetExplorer : TGUID = '{0002DF05-0000-0000-C000-000000000046}';   
  136.   sIID_IWebBrowserApp : TGUID= '{0002DF05-0000-0000-C000-000000000046}';   
  137.   
  138.   //面板所允许的最小宽度和高度。  
  139.   MIN_SIZE_X = 54;   
  140.   MIN_SIZE_Y = 23;   
  141.   EB_CLASS_NAME = 'BackSpace有效性测试';   
  142. implementation  
  143.   
  144. uses ComServ;   
  145.   
  146. { TTestTextBoxFactory }  
  147.   
  148. procedure TTestTextBoxFactory.UpdateRegistry(Register: Boolean);   
  149. var  
  150.   ClassID: string;   
  151.   a:Integer;   
  152. begin  
  153.    inherited UpdateRegistry(Register);   
  154.    if Register then  
  155.    begin  
  156.      ClassID:=GUIDToString(Class_TestTextBox);   
  157.      with TRegistry.Create do  
  158.      begin  
  159.        try  
  160.          //添加附加的注册表项  
  161.          RootKey:=HKEY_LOCAL_MACHINE;   
  162.          OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar',False);   
  163.          a:=0;   
  164.          WriteBinaryData(GUIDToString(Class_TestTextBox),a,0);   
  165.          OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',True);   
  166.          WriteString (GUIDToString(Class_TestTextBox), EB_CLASS_NAME);   
  167.          RootKey:=HKEY_CLASSES_ROOT;   
  168.          OpenKey('\CLSID\'+GUIDToString(Class_TestTextBox),False); 
  169.          WriteString('',EB_CLASS_NAME); 
  170.        finally 
  171.          Free; 
  172.        end; 
  173.      end; 
  174.    end 
  175.    else 
  176.    begin 
  177.      with TRegistry.Create do 
  178.      begin 
  179.        try 
  180.          RootKey:=HKEY_LOCAL_MACHINE; 
  181.          OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar',False); 
  182.          DeleteValue(GUIDToString(Class_TestTextBox)); 
  183.          OpenKey('\Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',False); 
  184.          DeleteValue(GUIDToString(Class_TestTextBox)); 
  185.        finally 
  186.          Free; 
  187.        end; 
  188.      end; 
  189.    end; 
  190. end; 
  191.  
  192. { TTestTextBox } 
  193.  
  194. procedure TTestTextBox.BandWndProc(var Message: TMessage); 
  195. begin 
  196.   if (Message.Msg = WM_PARENTNOTIFY)  then 
  197.   begin 
  198.     HasFocus := True; 
  199.     FocusChange(HasFocus); 
  200.   end; 
  201.   SavedWndProc(Message); 
  202. end; 
  203.  
  204. function TTestTextBox.CloseDW(dwReserved: DWORD): HResult; 
  205. begin 
  206.   if Assigned(frmIE) then 
  207.   begin 
  208.     frmIE.Free; 
  209.     frmIE := nil; 
  210.   end; 
  211.   Result:= S_OK; 
  212. end; 
  213.  
  214. function TTestTextBox.ContextSensitiveHelp(fEnterMode: BOOL): HResult; 
  215. begin 
  216.   Result:= E_NOTIMPL; 
  217. end; 
  218.  
  219. procedure TTestTextBox.FocusChange(bHasFocus: Boolean); 
  220. begin 
  221.   if m_pSite <> nil then 
  222.     m_pSite.OnFocusChangeIS(Self, bHasFocus); 
  223. end; 
  224.  
  225. function TTestTextBox.GetBandInfo(dwBandID, dwViewMode: DWORD; 
  226.   var pdbi: TDeskBandInfo): HResult; 
  227. begin 
  228.   Result:=E_INVALIDARG; 
  229.   if not Assigned(frmIE) then 
  230.     frmIE:= TfrmIEBar.CreateParented(m_hwndParent); 
  231.   if(@pdbi<>nil)then 
  232.   begin 
  233.     m_dwBandID := dwBandID; 
  234.     m_dwViewMode := dwViewMode; 
  235.     if(pdbi.dwMask and DBIM_MINSIZE)<>0 then 
  236.     begin 
  237.       pdbi.ptMinSize.x := MIN_SIZE_X; 
  238.       pdbi.ptMinSize.y := MIN_SIZE_Y; 
  239.     end; 
  240.     if(pdbi.dwMask and DBIM_MAXSIZE)<>0 then 
  241.     begin 
  242.       pdbi.ptMaxSize.x := -1; 
  243.       pdbi.ptMaxSize.y := -1; 
  244.     end; 
  245.     if(pdbi.dwMask and DBIM_INTEGRAL)<>0 then 
  246.     begin 
  247.       pdbi.ptIntegral.x := 1; 
  248.       pdbi.ptIntegral.y := 1; 
  249.     end; 
  250.     if(pdbi.dwMask and DBIM_ACTUAL)<>0 then 
  251.     begin 
  252.       pdbi.ptActual.x := 0; 
  253.       pdbi.ptActual.y := 0; 
  254.     end; 
  255.     if(pdbi.dwMask and DBIM_MODEFLAGS)<>0 then 
  256.       pdbi.dwModeFlags := DBIMF_VARIABLEHEIGHT; 
  257.     if(pdbi.dwMask and DBIM_BKCOLOR)<>0 then 
  258.       pdbi.dwMask := pdbi.dwMask and (not DBIM_BKCOLOR); 
  259.   end; 
  260. end; 
  261.  
  262. function TTestTextBox.GetClassID(out classID: TCLSID): HResult; 
  263. begin 
  264.   ClassID:= Class_TestTextBox; 
  265.   Result:=S_OK; 
  266. end; 
  267.  
  268. function TTestTextBox.GetSite(const riid: TIID; 
  269.   out site: IInterface): HResult; 
  270. begin 
  271.   if Assigned(m_pSite) then 
  272.     Result := m_pSite.QueryInterface(riid, site) 
  273.   else 
  274.     Result := E_FAIL; 
  275. end; 
  276.  
  277. function TTestTextBox.GetSizeMax(out cbSize: Largeint): HResult; 
  278. begin 
  279.   Result := E_NOTIMPL; 
  280. end; 
  281.  
  282. function TTestTextBox.GetWindow(out wnd: HWnd): HResult; 
  283. begin 
  284.   Wnd := frmIE.Handle; 
  285.   SavedWndProc := frmIE.WindowProc; 
  286.   frmIE.WindowProc := BandWndProc; 
  287.   Result := S_OK; 
  288. end; 
  289.  
  290. function TTestTextBox.HasFocusIO: HResult; 
  291. begin 
  292.   if Assigned(frmIE) and (frmIE.Active) then 
  293.   begin 
  294.     Result := S_OK; 
  295.   end 
  296.   else 
  297.   begin 
  298.     Result := E_FAIL; 
  299.   end; 
  300. end; 
  301.  
  302. function TTestTextBox.InitNew: HResult; 
  303. begin 
  304.   Result := E_NOTIMPL; 
  305. end; 
  306.  
  307. function TTestTextBox.IsDirty: HResult; 
  308. begin 
  309.   Result:=S_FALSE; 
  310. end; 
  311.  
  312. function TTestTextBox.Load(const stm: IStream): HResult; 
  313. begin 
  314.   Result:=S_OK; 
  315. end; 
  316.  
  317. function TTestTextBox.ResizeBorderDW(var prcBorder: TRect; 
  318.   punkToolbarSite: IInterface; fReserved: BOOL): HResult; 
  319. begin 
  320.   Result:=E_NOTIMPL; 
  321. end; 
  322.  
  323. function TTestTextBox.Save(const stm: IStream; fClearDirty: BOOL): HResult; 
  324. begin 
  325.   Result:=S_OK; 
  326. end; 
  327.  
  328. function TTestTextBox.SetSite(const pUnkSite: IInterface): HResult; 
  329. var 
  330.   pOleWindow:IOleWindow; 
  331.   pOLEcmd:IOleCommandTarget; 
  332.   pSP:IServiceProvider; 
  333.   rc:TRect; 
  334. begin 
  335.   if Assigned(pUnkSite) then 
  336.   begin 
  337.     m_hwndParent := 0; 
  338.     m_pSite:=pUnkSite as IInputObjectSite; 
  339.     pOleWindow := PunkSIte as IOleWindow; 
  340.     //获得父窗口IE面板窗口的句柄 
  341.     pOleWindow.GetWindow(m_hwndParent); 
  342.     if(m_hwndParent=0)then 
  343.     begin 
  344.        Result := E_FAIL; 
  345.        exit; 
  346.     end; 
  347.     //获得父窗口区域 
  348.     GetClientRect(m_hwndParent, rc); 
  349.     if not Assigned(frmIE) then 
  350.     begin 
  351.        //建立TIEForm窗口，父窗口为m_hwndParent 
  352.        frmIE:= TfrmIEBar.CreateParented(m_hwndParent); 
  353.        m_Hwnd:= frmIE.Handle; 
  354.        SetWindowLong(frmIE.Handle, GWL_STYLE, GetWindowLong(frmIE.Handle, 
  355.           GWL_STYLE) Or WS_CHILD); 
  356.        //根据父窗口区域设置窗口位置 
  357.        with frmIE do 
  358.        begin 
  359.           Left :=rc.Left; 
  360.           Top:=rc.top; 
  361.           Width:=rc.Right - rc.Left; 
  362.           Height:=rc.Bottom - rc.Top; 
  363.        end; 
  364.        frmIE.Visible := True; 
  365.        //获得与浏览器相关联的Webbrowser对象。 
  366.        pOLEcmd:=pUnkSite as IOleCommandTarget; 
  367.        pSP:=pOLEcmd as  IServiceProvider; 
  368.        if Assigned(pSP)then 
  369.        begin 
  370.          pSP.QueryService(IWebbrowserApp, IWebbrowser2, frmIE.IEThis); 
  371.        end; 
  372.     end; 
  373.   end; 
  374.   Result := S_OK; 
  375. end; 
  376.  
  377. function TTestTextBox.ShowDW(fShow: BOOL): HResult; 
  378. begin 
  379.   HasFocus := fShow; 
  380.   FocusChange(HasFocus); 
  381.   Result := S_OK; 
  382. end; 
  383.  
  384. function TTestTextBox.TranslateAcceleratorIO(var lpMsg: TMsg): HResult; 
  385. begin 
  386.   if (lpMsg.wParam <> VK_TAB) then 
  387.   begin 
  388.     TranslateMessage(lpMsg); 
  389.     DispatchMessage(lpMsg); 
  390.     Result := S_OK; 
  391.   end 
  392.   else 
  393.   begin 
  394.     Result := S_FALSE; 
  395.   end; 
  396. end; 
  397.  
  398. function TTestTextBox.UIActivateIO(fActivate: BOOL; 
  399.   var lpMsg: TMsg): HResult; 
  400. begin 
  401.   HasFocus := fActivate; 
  402.   if HasFocus then 
  403.     frmIE.SetFocus; 
  404.   Result := S_OK; 
  405. end; 
  406.  
  407. initialization 
  408.   TTestTextBoxFactory.Create(ComServer, TTestTextBox, Class_TestTextBox, 
  409.     'BackSpace有效性测试', '测试输入框中的BackSpace', ciMultiInstance, tmApartment);   
  410. end.  

文章来源：http://mailysf.blog.zj.com/d-143742.html

最后修改：2009 年 08 月 16 日
© 允许规范转载
卧槽，全是白嫖客，服务器不要钱吗？