返回列表 发帖

[交流] 无法把DELPHI的IE插件移植到TW中,请高手帮忙!!!

源码如下:
library DelphiBand;
uses
  ComServ,
  _DelphiBand in '_DelphiBand.pas',
  DelphiBand_TLB in 'DelphiBand_TLB.pas',
  DelphiBandForm in 'delphibandform.pas' {BandForm};
exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;
{$R *.TLB}
{$R *.RES}
begin
end.



unit DelphiBand_TLB;
// ************************************************************************ //
// WARNING                                                                    
// -------                                                                    
// The types declared in this file were generated from data read from a      
// Type Library. If this type library is explicitly or indirectly (via        
// another type library referring to this type library) re-imported, or the   
// 'Refresh' command of the Type Library Editor activated while editing the   
// Type Library, the contents of this file will be regenerated and all        
// manual modifications will be lost.                                         
// ************************************************************************ //
// PASTLWTR : 1.2
// File generated on 2009-3-30 22:46:46 from Type Library described below.
// ************************************************************************  //
// Type Lib: E:\BROWSER\DelphiBand102\Vertical\DelphiBand.tlb (1)
// LIBID: {AF0AC969-3E1E-453C-8F5A-0D3830E1C252}
// LCID: 0
// Helpfile:
// HelpString: DelphiBand Library
// DepndLst:
//   (1) v2.0 stdole, (C:\WINDOWS\system32\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
  
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:        
//   Type Libraries     : LIBID_xxxx                                      
//   CoClasses          : CLASS_xxxx                                      
//   DISPInterfaces     : DIID_xxxx                                       
//   Non-DISP interfaces: IID_xxxx                                       
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  DelphiBandMajorVersion = 1;
  DelphiBandMinorVersion = 0;
  LIBID_DelphiBand: TGUID = '{AF0AC969-3E1E-453C-8F5A-0D3830E1C252}';

implementation
uses ComObj;
end.



//***********************************************************
//               Band Objects  (Oct 15, 2001)               *
//                                                          *
//                         ver. 1.2                         *
//                                                          *
//                       For Delphi 5 & 6                   *
//                                                          *
//                            by                            *
//                     Per Linds?Larsen                    *
//                   per.lindsoe@larsen.mail.dk             *
//                                                          *
//                                                          *
//                                                          *
//        Updated versions:                                 *
//                                                          *
//               http://www.euromind.com/iedelphi           *
//***********************************************************

unit _DelphiBand;
interface
uses
  Windows, Classes, ActiveX, ShlObj, ComServ, ComObj,
  controls, SysUtils, messages, Forms, Shdocvw,mshtml,DelphiBandForm,Variants;

const
  DeskBand =       '{00021492-0000-0000-C000-000000000046}';
  VerticalBand =   '{00021493-0000-0000-C000-000000000046}';
  HorizontalBand = '{00021494-0000-0000-C000-000000000046}';
(* Getting started:
1. Create the BandForm. Place your components on Coolbar if you
   plan to create a Toolband or a resizable band (see demo). Set form.height
   to the prefered band-height. In vertical bands set the form.width
   to the prefered band-width.
2. Choose Title and Bandtype. Use Horizontalband or Deskband if you
   plan to create a toolband.
   Set ToolBand=TRUE if you want to create a ToolBand.
   Create a unique identifier.
3. Set values in GetBandInfo for minimum size, maximum size etc. You
   can use Bandform.Width and Bandform.Height as variables. Remember that
   y represents the width of your form in Vertical bands.
   Typical values for Toolbands:
        set modeflags to DBIMF_NORMAL
        set minSize.y:=Bandform.height;
        set MixSize.x:=0;
4. Insert menu-items in QueryContextMenu and InvokeCommand.
5. Register your DLL. (Run -> Register ActiveX Server, or from commandline:
'regsvr32 delphiband.dll'):
*)

// ******************************************************************
  Caption = 'Delphi Band'; //Bands title
  BandType = VerticalBand;
  ToolBand = FALSE; // Create toolband
  CLSID_DelphiBand: TGUID = '{3F5A62E2-51F2-11D3-A075-CC7364CAE42B}';
// ******** Create your own unique identifier for each Band ********
// In Delphi-IDE : Ctrl-Shift-G
// ******************************************************************


type
  TDelphiBandFactory = class(TComObjectFactory)
  private
    procedure AddKeys;
    procedure RemoveKeys;
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;
  TDelphiBand = class(TComObject, IDeskBand, IPersist, IPersistStreamInit, IObjectWithSite, IContextMenu, IInputObject)
  private
    MenuItems : Integer;
    HasFocus: Boolean;
    BandID: DWORD;
    SavedWndProc: twndmethod;
    ParentWnd: HWND;
    Site: IInputObjectSite;
    cmdTarget: IOleCommandTarget;
    BandForm: TBandform;
    IE : IWebbrowser2;
  public
   // IDeskBand methods
    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;
   // IPersistStreamInit methods
    function InitNew: HResult; stdcall;
    function GetClassID(out classID: TCLSID): HResult; stdcall;
    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;
   // IObjectWithSite methods
    function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
    function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
    // IContextMenu methods
    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult; stdcall;
    /// IInputObject methods
    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 UpdateBandInfo;
    procedure BandWndProc(var Message: TMessage);
  end;

implementation
uses dialogs, Registry;
procedure TDelphiBand.UpdateBandInfo;
(*
Band objects can send commands to their container.
Two commands are supported:
DBID_BANDINFOCHANGED
   The band's information has changed. The container will call the band
   object's GetBandInfo method to request the updated information.
DBID_MAXIMIZEBAND
The container will maximize the band.
*)
var
  vain, vaOut: OleVariant;
  PtrGuid: PGUID;
begin
  vaIn := Variant(BandID);
  New(PtrGUID);
  PtrGUID^ := IDESKBAND;
  cmdTarget.Exec(PtrGUID, DBID_BANDINFOCHANGED, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
  Dispose(PtrGUID);
end;

function TDelphiBand.GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):
  HResult;
// Retrieves the information for the band object.
begin
  BandId := dwBandID;
  (*
DBIM_MINSIZE:
The minimum size of the band object.
The minimum width is placed in the x member
and the minimum height is placed in the y member.
NB: In vertical bands is y=width e.g.:
    pdbi.ptMinSize.y:=Bandform.Width;
*)
  if (pdbi.dwMask or DBIM_MINSIZE) <> 0
    then begin
    pdbi.ptMinSize.y := Bandform.width;
    pdbi.ptMinSize.x := -1;
  end;
(*
DBIM_MAXSIZE:
The maximum size of the band object.
The maximum height is placed in the y member
and the x member is ignored. If there is no
limit for the maximum height, -1 should be used.
*)
  if (pdbi.dwMask or DBIM_MAXSIZE) <> 0
    then begin
    pdbi.ptMaxSize.x := -1;
    pdbi.ptMaxSize.y := -1;
  end;
(*
DBIM_INTEGRAL:
the sizing step value of the band object.
The vertical step value is placed in the y member,
and the x member is ignored. The step value determines
in what increments the band will be resized.
This member is ignored if dwModeFlags does not
contain DBIMF_VARIABLEHEIGHT.
*)
  if (pdbi.dwMask or DBIM_INTEGRAL) <> 0
    then begin
    pdbi.ptIntegral.x := 1;
    pdbi.ptIntegral.y := 1;
  end;

(*
DBIM_ACTUAL:
The ideal size of the band object. The ideal width
is placed in the x member and the ideal height is placed
in the y member. The band container will attempt to use
these values, but the band is not guaranteed to be this size.
*)
  if (pdbi.dwMask or DBIM_ACTUAL) <> 0
    then begin
    pdbi.ptActual.x := Bandform.Height;
    pdbi.ptActual.y := bandform.Width;
  end;
(*
DBIM_MODEFLAGS:
A value that receives a set of flags that define the mode of
operation for the band object. This must be one or a combination
of the following values:
DBIMF_NORMAL:  The band is normal in all respects. The other mode flags modify this flag.
DBIMF_VARIABLEHEIGHT:  The height of the band object can be changed.
        The ptIntegral member defines the step value by which the band object can be resized.
DBIMF_DEBOSSED:  The band object is displayed with a sunken appearance.
DBIMF_BKCOLOR:  The band will be displayed with the background color specified in crBkgnd
*)
  if (pdbi.dwMask or DBIM_MODEFLAGS) <> 0 then
  begin
    pdbi.dwModeFlags := DBIMF_VARIABLEHEIGHT;
  end;
(*
DBIM_BKCOLOR:
A value that eceives the background color of the band.
This member is ignored if dwModeFlags does not contain the DBIMF_BKCOLOR flag.
*)
  if (pdbi.dwMask or DBIM_BKCOLOR) <> 0 then
  begin
    pdbi.dwMask := pdbi.dwMask and (not DBIM_BKCOLOR);
  end;

(*
DBIM_TITLE:
the title of the band.
*)
  if (Pdbi.dwMask and DBIM_TITLE) = DBIM_TITLE
    then begin
    FillChar(pdbi.wszTitle, SizeOf(Caption) + 1, ' ');
    StringToWideChar(Caption, @pdbi.wszTitle, Length(Caption) + 1);
  end;
  Result := NOERROR;
end;

function TDelphiBand.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
begin
//Add Menuitems here in reverse order:
  InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst + 2, 'About...');
  InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst + 1, 'IE and Delphi');
  InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdfirst, 'Update Bandinfo');
// Return number of items added:
  MenuItems := 3;
  Result := MenuItems;
end;

function TDelphiBand.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
  if (HiWord(Integer(lpici.lpVerb)) <> 0) or (LoWord(lpici.lpVerb) > MenuItems-1) then
  begin
    Result := E_FAIL;
    Exit;
  end;
  case LoWord(lpici.lpVerb) of
// Add menu commands:
    0: UpdateBandInfo;
    //1: Bandform.NavigateFromBand('http://www.euromind.com/iedelphi');
    2: Showmessage('Band Objects ver. 1.1');
  end;
  Result := NO_ERROR;
end;

procedure TDelphiBand.BandWndProc(var Message: TMessage);
begin
// Notify the browser when the band has focus so Accelerator
// keys are translated.
  if (Message.Msg = WM_PARENTNOTIFY)  then
  begin
  Hasfocus:=True;
  FocusChange(True);
  end;
  SavedWndProc(Message);
end;
function TDelphiBand.GetWindow(out wnd: HWnd): HResult;
begin
  if not Assigned(BandForm) then
  begin
  BandForm := TBandForm.CreateParented(ParentWnd);
  BandForm.IE:=IE;
  end;
  Wnd := Bandform.Handle;
  SavedWndProc := Bandform.WindowProc;
  Bandform.WindowProc := BandWndProc;
  Result := S_OK;
end;
procedure TDelphiBand.FocusChange(bHasFocus: Boolean);
begin
// Informs the browser that the focus has changed.
  if (Site <> nil) then Site.OnFocusChangeIS(Self, bHasFocus);
end;
function TDelphiBand.TranslateAcceleratorIO(var lpMsg: TMsg): HResult;
// Passes keyboard accelerators to the object.
begin
  if (lpMsg.WParam <> VK_TAB) then begin
    TranslateMessage(lpMSg);
    DispatchMessage(lpMsg);
    Result := S_OK;
  end
  else Result := S_FALSE;
end;

function TDelphiBand.HasFocusIO: HResult;
// Determines if one of the object's windows has the keyboard focus.
begin
Result:=Integer(not HasFocus);
end;

function TDelphiBand.UIActivateIO(fActivate: BOOL;
  var lpMsg: TMsg): HResult;
// Activates or deactivates the object.
begin
Hasfocus:=fActivate;
if HasFocus then Bandform.SetFocus;
Result := S_OK;
end;

function TDelphiBand.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
begin
  Result := NOERROR;
end;

function TDelphiBand.SetSite(const pUnkSite: IUnknown): HResult;
// When the user selects an Explorer Bar, the container calls
// the corresponding band object's SetSite method. The punkSite
// parameter will be set to the site's IUnknown pointer.
begin
//If the pointer passed to SetSite is set to Nil, the band is being removed.
//SetSite can return S_OK. ->
  if Assigned(pUnkSite) then begin
// Store the pointer to this interface for use later. ->
    Site := pUnkSite as IInputObjectSite;
//Call GetWindow to obtain the parent window's handle,
//and save it for future use. ->
    (pUnkSite as IOleWindow).GetWindow(ParentWnd);
// Need IOleCommandTarget if you want to send commands to the container
// (see UpdateBandInfo) ->
    cmdTarget := pUnkSite as IOleCommandTarget;
//  Get a connection to IE's browser-window ->
    (CmdTarget as IServiceProvider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
  end;
  Result := S_OK;
end;
function TDelphiBand.GetSite(const riid: TIID; out site: IUnknown): HResult;
// Retrieves the last site set with SetSite.
begin
  if Assigned(Site) then Result := Site.QueryInterface(riid, site)
  else Result := E_FAIL;
end;
function TDelphiBand.GetClassID(out classID: TCLSID): HResult;
begin
  classID := CLSID_DelphiBand;
  Result := S_OK;
end;

function TDelphiBand.CloseDW(dwReserved: DWORD): HResult;
begin
  if BandForm <> nil then BandForm.Destroy;
  Result := S_OK;
end;

function TDelphiBand.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
  Result := E_NOTIMPL;
end;
function TDelphiBand.ShowDW(fShow: BOOL): HResult;
begin
  Hasfocus:=fShow;
  FocusChange(fShow);
  Result := S_OK;
end;

function TDelphiBand.ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;
  fReserved: BOOL): HResult;
begin
  Result := E_NOTIMPL;
end;

function TDelphiBand.IsDirty: HResult;
begin
  Result := S_FALSE;
end;
function TDelphiBand.Load(const stm: IStream): HResult;
begin
  Result := S_OK;
end;
function TDelphiBand.Save(const stm: IStream; fClearDirty: BOOL): HResult;
begin
  Result := S_OK;
end;
function TDelphiBand.GetSizeMax(out cbSize: Largeint): HResult;
begin
  Result := E_NOTIMPL;
end;
function TDelphiBand.InitNew: HResult;
begin
  Result := E_NOTIMPL;
end;

procedure TDelphiBandFactory.UpdateRegistry(Register: Boolean);
begin
  inherited UpdateRegistry(Register);
  if Register then AddKeys else RemoveKeys;
end;
procedure TDelphiBandFactory.AddKeys;
var S: string;
begin
  S := GUIDToString(CLSID_DelphiBand);
  with TRegistry.Create do
  try
// http://support.microsoft.com/support/kb/articles/Q247/7/05.ASP   ->
    if BandType <> DeskBand then
    begin
      DeleteKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Discardable\PostSetup\Component Categories\' + VerticalBand + '\Enum');
      DeleteKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Discardable\PostSetup\Component Categories\' + HorizontalBand + '\Enum');
    end;
    RootKey := HKEY_CLASSES_ROOT;
    if OpenKey('CLSID\' + S, True) then
    begin
      WriteString('', '&Delphi Band');
      CloseKey;
    end;
    if OpenKey('CLSID\' + S + '\InProcServer32', True) then
    begin
      WriteString('ThreadingModel', 'Apartment');
      CloseKey;
    end;
    if OpenKey('CLSID\' + S + '\Implemented Categories\' + BandType, True)
      then CloseKey;
    if Toolband then begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey('SOFTWARE\Microsoft\Internet Explorer\Toolbar', True) then
      begin
        WriteString(S, '');
        CloseKey;
      end;
    end;
  finally
    Free;
  end;
end;
procedure TDelphiBandFactory.RemoveKeys;
var S: string;
begin
  S := GUIDToString(CLSID_DelphiBand);
  with TRegistry.Create do
  try
    RootKey := HKEY_CLASSES_ROOT;
    // http://support.microsoft.com/support/kb/articles/Q214/8/42.ASP ->
    if BandType = DeskBand then
      DeleteKey('Component Categories\' + DeskBand + '\Enum');
    DeleteKey('CLSID\' + S + '\Implemented Categories\' + BandType);
    DeleteKey('CLSID\' + S + '\InProcServer32');
    DeleteKey('CLSID\' + S);
    Closekey;
    if ToolBand then begin
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey('Software\Microsoft\Internet Explorer\Toolbar', FALSE);
      DeleteValue(s);
      CloseKey;
    end;
  finally
    Free;
  end;
end;
initialization
  TDelphiBandFactory.Create(ComServer, TDelphiBand, CLSID_DelphiBand, '', Caption, ciMultiInstance);
end.


unit DelphiBandForm;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ExtCtrls, StdCtrls, ComCtrls,mshtml, Buttons, ToolWin, Menus, OleCtrls,
  SHDocVw;
type
  TBandForm = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    IE: IWebbrowser2;
  end;

implementation
{$R *.DFM}

end.

完全代码在附件中

先谢了
附件: 您需要登录才可以下载或查看附件。没有帐号?加入 我们

在IE中完全正常,无法在TW中加载!

TOP

  1. if not Assigned(BandForm) then
  2.   begin
  3.   BandForm := TBandForm.CreateParented(ParentWnd);
  4.   BandForm.IE:=IE;
  5.   end;
复制代码
这段创建窗体的代码放到 SetSite 方法中的 (CmdTarget as IServiceProvider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
之后看看, 代码我没时间测

TOP

返回列表