ActionManager

how to implement action of MDIChild form auto hide/show in toolbar of MDI form, i.e. toolbar auto hide/show them?

解决方案 »

  1.   

    下面源码:
    首先要建立一个ActiveX Library。将其保存为MailIEBand.Dpr；然后建立一个COM Object，将其保存为BandUnit.pas；然后建立一个Form，这个窗口将作为子窗口显示在IE工具栏中，将窗口的BorderStyle属性改为bsNone，添加一个TButton组件和一个TComboBox组件，将TButton的Caption属性改为获取全部，然后将窗口文件其保存为IEForm.pas。在BandUnit中，需要建立一个实现上面提到的接口的TComObject对象。如下：TGetMailBand = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit)另外由于需要在COM服务器注册时添加一些注册表信息，所以还需要建立一个继承自TComObjectFactory类的对象，在对象的UpdateRegistry事件中编写代码添加附加的注册表信息。下面的程序清单1-6到1-8是实现COM服务器的全部程序代码：程序清单1-6 MailIEBand.dprlibrary MailIEBand;usesComServ,BandUnit in 'BandUnit.pas',IEForm in 'IEForm.pas' {Form1},MailIEBand_TLB in 'MailIEBand_TLB.pas';exportsDllGetClassObject,DllCanUnloadNow,DllRegisterServer,DllUnregisterServer;{$R *.TLB}{$R *.RES}beginend.程序清单1-7 BandUnit.pasunit BandUnit;interfaceusesWindows, Sysutils, Messages, Registry, Shellapi, ActiveX, Classes, ComObj,Shlobj, Dialogs, Commctrl,ShDocVW,IEForm;typeTGetMailBand = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit)privatefrmIE:TForm1;m_pSite:IInputObjectSite;m_hwndParent:HWND;m_hWnd:HWND;m_dwViewMode:Integer;m_dwBandID:Integer;protectedpublic{Declare IDeskBand methods here}function GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):HResult; stdcall;function ShowDW(fShow: BOOL): HResult; stdcall;function CloseDW(dwReserved: DWORD): HResult; stdcall;function ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;fReserved: BOOL): HResult; stdcall;function GetWindow(out wnd: HWnd): HResult; stdcall;function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;{Declare IObjectWithSite methods here}function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;function GetSite(const riid: TIID; out site: IUnknown):HResult;stdcall;{Declare IPersistStream methods here}function GetClassID(out classID: TCLSID): HResult; stdcall;function IsDirty: HResult; stdcall;function InitNew: 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;end;constClass_GetMailBand: TGUID = '{954F618B-0DEC-4D1A-9317-E0FC96F87865}';//以下是系统接口的IIDIID_IUnknown: TGUID = (D1:$00000000;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));IID_IOleObject: TGUID = (D1:$00000112;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));IID_IOleWindow: TGUID = (D1:$00000114;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));IID_IInputObjectSite : TGUID = (D1:$f1db8392;D2:$7331;D3:$11d0;D4:($8C,$99,$00,$A0,$C9,$2D,$BF,$E8));sSID_SInternetExplorer : TGUID = '{0002DF05-0000-0000-C000-000000000046}';sIID_IWebBrowserApp : TGUID= '{0002DF05-0000-0000-C000-000000000046}';//面板所允许的最小宽度和高度。MIN_SIZE_X = 54;MIN_SIZE_Y = 22;EB_CLASS_NAME = 'GetMailAddress';implementationuses ComServ;　function TGetMailBand.GetWindow(out wnd: HWnd): HResult; stdcall;beginwnd:=m_hWnd;Result:=S_OK;end;function TGetMailBand.ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;beginResult:=E_NOTIMPL;end;function TGetMailBand.ShowDW(fShow: BOOL): HResult; stdcall;beginif m_hWnd<>0 thenif fShow thenShowWindow(m_hWnd,SW_SHOW)elseShowWindow(m_hWnd,SW_HIDE);Result:=S_OK;end;function TGetMailBand.CloseDW(dwReserved: DWORD): HResult; stdcall;beginif frmIE<>nil thenfrmIE.Destroy;Result:= S_OK;end;function TGetMailBand.ResizeBorderDW(var prcBorder: TRect;punkToolbarSite: IUnknown;fReserved: BOOL): HResult; stdcall;beginResult:=E_NOTIMPL;end;function TGetMailBand.SetSite(const pUnkSite: IUnknown):HResult;stdcall;varpOleWindow:IOleWindow;pOLEcmd:IOleCommandTarget;pSP:IServiceProvider;rc:TRect;beginif Assigned(pUnkSite) then beginm_hwndParent := 0;m_pSite:=pUnkSite as IInputObjectSite;pOleWindow := PunkSIte as IOleWindow;//获得父窗口IE面板窗口的句柄pOleWindow.GetWindow(m_hwndParent);if(m_hwndParent=0)then beginResult := E_FAIL;exit;end;//获得父窗口区域GetClientRect(m_hwndParent, rc);if not Assigned(frmIE) then begin//建立TIEForm窗口，父窗口为m_hwndParentfrmIE:=TForm1.CreateParented(m_hwndParent);m_Hwnd:=frmIE.Handle;SetWindowLong(frmIE.Handle, GWL_STYLE, GetWindowLong(frmIE.Handle,GWL_STYLE) Or WS_CHILD);//根据父窗口区域设置窗口位置with frmIE do beginLeft :=rc.Left ;Top:=rc.top;Width:=rc.Right - rc.Left;Height:=rc.Bottom - rc.Top;end;frmIE.Visible := True;//获得与浏览器相关联的Webbrowser对象。pOLEcmd:=pUnkSite as IOleCommandTarget;pSP:=pOLEcmd as IServiceProvider;if Assigned(pSP)then beginpSP.QueryService(IWebbrowserApp, IWebbrowser2,frmIE.IEThis);end;end;end;Result := S_OK;end;function TGetMailBand.GetSite(const riid: TIID; out site: IUnknown):HResult;stdcall;beginif Assigned(m_pSite) then result:=m_pSite.QueryInterface(riid, site)elseResult:= E_FAIL;end;function TGetMailBand.GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):HResult; stdcall;beginResult:=E_INVALIDARG;if not Assigned(frmIE) then frmIE:=TForm1.CreateParented(m_hwndParent);if(@pdbi<>nil)then beginm_dwBandID := dwBandID;m_dwViewMode := dwViewMode;if(pdbi.dwMask and DBIM_MINSIZE)<>0 then beginpdbi.ptMinSize.x := MIN_SIZE_X;pdbi.ptMinSize.y := MIN_SIZE_Y;end;if(pdbi.dwMask and DBIM_MAXSIZE)<>0 then beginpdbi.ptMaxSize.x := -1;pdbi.ptMaxSize.y := -1;end;if(pdbi.dwMask and DBIM_INTEGRAL)<>0 then beginpdbi.ptIntegral.x := 1;pdbi.ptIntegral.y := 1;end;
    接下面
      

  2.   


    if(pdbi.dwMask and DBIM_ACTUAL)<>0 then beginpdbi.ptActual.x := 0;pdbi.ptActual.y := 0;end;if(pdbi.dwMask and DBIM_MODEFLAGS)<>0 thenpdbi.dwModeFlags := DBIMF_VARIABLEHEIGHT;if(pdbi.dwMask and DBIM_BKCOLOR)<>0 thenpdbi.dwMask := pdbi.dwMask and (not DBIM_BKCOLOR);end;end;　function TGetMailBand.GetClassID(out classID: TCLSID): HResult; stdcall;beginclassID:= Class_GetMailBand;Result:=S_OK;end;function TGetMailBand.IsDirty: HResult; stdcall;beginResult:=S_FALSE;end;function TGetMailBand.InitNew: HResult;beginResult := E_NOTIMPL;end;function TGetMailBand.Load(const stm: IStream): HResult; stdcall;beginResult:=S_OK;end;function TGetMailBand.Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;beginResult:=S_OK;end;function TGetMailBand.GetSizeMax(out cbSize: Largeint): HResult; stdcall;beginResult:=E_NOTIMPL;end;　//TIEClassFac类实现COM组件的注册typeTIEClassFac=class(TComObjectFactory) //publicprocedure UpdateRegistry(Register: Boolean); override;end;procedure TIEClassFac.UpdateRegistry(Register: Boolean);varClassID: string;a:Integer;begininherited UpdateRegistry(Register);if Register then beginClassID:=GUIDToString(Class_GetMailBand);with TRegistry.Create dotry//添加附加的注册表项RootKey:=HKEY_LOCAL_MACHINE;OpenKey('Explorer',False);a:=0;WriteBinaryData(GUIDToString(Class_GetMailBand),a,0);OpenKey('Extensions',True);WriteString (GUIDToString(Class_GetMailBand),EB_CLASS_NAME);RootKey:=HKEY_CLASSES_ROOT;OpenKey('+GUIDToString(Class_GetMailBand),False);WriteString('',EB_CLASS_NAME);finallyFree;end;endelse beginwith TRegistry.Create dotryRootKey:=HKEY_LOCAL_MACHINE;OpenKey('Explorer',False);DeleteValue(GUIDToString(Class_GetMailBand));OpenKey('Extensions',False);DeleteValue(GUIDToString(Class_GetMailBand));finallyFree;end;end;end;initializationTIEClassFac.Create(ComServer, TGetMailBand, Class_GetMailBand,'GetMailAddress', '', ciMultiInstance, tmApartment);end.程序清单1-8 IEForm.pasunit IEForm;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,SHDocVw,MSHTML, StdCtrls;typeTForm1 = class(TForm)Button1: TButton;ComboBox1: TComboBox;procedure FormResize(Sender: TObject);procedure Button1Click(Sender: TObject);private{ Private declarations }publicIEThis:IWebbrowser2;{ Public declarations }end;varForm1: TForm1;implementation{$R *.DFM}procedure TForm1.FormResize(Sender: TObject);beginWith Button1 do beginLeft := 0;Top := 0;Height:=Self.ClientHeight;end;With ComboBox1 do beginLeft := Button1.Width +3;Top := 0;Height:=Self.ClientHeight;Width:=Self.ClientWidth - Left;end;end;procedure TForm1.Button1Click(Sender: TObject);vardoc:IHTMLDocument2;all:IHTMLElementCollection;len,i,flag:integer;item:IHTMLElement;vAttri:Variant;beginif Assigned(IEThis)then beginComboBox1.Clear;//获得Webbrowser对象中的文档对象doc:=IEThis.Document as IHTMLDocument2;//获得文档中所有的HTML元素集合all:=doc.Get_all;len:=all.Get_length;//访问HTML元素集合中的每一个元素for i:=0 to len-1 do beginitem:=all.item(i,varempty) as IHTMLElement;//如果该元素是一个链接if item.Get_tagName = 'A'then beginflag:=0;vAttri:=item.getAttribute('protocol',flag); //获得链接属性//如果是mailto链接则将链接的目标地址添加到ComboBox1if vAttri = 'mailto:'then beginvAttri:=item.getAttribute('href',flag);ComboBox1.Items.Add(vAttri);end;end;end;end;end;end.编译工程，关闭所有的IE窗口，然后点击Delphi菜单的Run | Register ActiveX Server 项注册服务器。然后打开IE，点击菜单 察看 | 工具栏 项，可以看到子菜单中多了一个GetMailAddress项，选中改项，工具栏就出现在IE工具栏中
     
      

  3.   

    学习
    很多书上都介绍的
    包括程序员的合订本
    还有《delphi深度探索》都有的
    看看了
      

  4.   

    搞什么
    看看delphi安装目录下的demo文件夹下面
    有很详细的实例！