终于解决了让我头疼了很久的在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

Last modification:August 16th, 2009 at 12:30 pm
如果觉得我的文章对你有用,请随意赞赏