大家看一下COM中还有哪些接口需要添加,或者在接口的方法中如何实现才不会出现楼一的问题
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
HasFocus: Boolean;
BandID: DWORD;
SavedWndProc: twndmethod;
ParentWnd: HWND;
Site: IInputObjectSite;
IE:IWebBrowser2;
BandForm: TBandform;
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 BandWndProc(var Message: TMessage);
end;
implementation
uses dialogs, Registry;
function TDelphiBand.GetBandInfo(dwBandID, dwViewMode: DWORD;
var pdbi:
TDeskBandInfo):
HResult;
begin
BandId := dwBandID;
if (pdbi.dwMask or DBIM_MINSIZE) <> 0 then
begin
pdbi.ptMinSize.y := Bandform.width;
pdbi.ptMinSize.x := -1;
end;
if (pdbi.dwMask or DBIM_MAXSIZE) <> 0 then
begin
pdbi.ptMaxSize.x := -1;
pdbi.ptMaxSize.y := -1;
end;
if (pdbi.dwMask or DBIM_INTEGRAL) <> 0 then
begin
pdbi.ptIntegral.x := 1;
pdbi.ptIntegral.y := 1;
end;
if (pdbi.dwMask or DBIM_ACTUAL) <> 0 then
begin
pdbi.ptActual.x := Bandform.Height;
pdbi.ptActual.y := bandform.Width;
end;
if (pdbi.dwMask or DBIM_MODEFLAGS) <> 0 then
begin
pdbi.dwModeFlags := DBIMF_VARIABLEHEIGHT;
end;
if (pdbi.dwMask or DBIM_BKCOLOR) <> 0 then
begin
pdbi.dwMask := pdbi.dwMask and (not DBIM_BKCOLOR);
end;
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
InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
'About...');
Result := 1;
end;
function TDelphiBand.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
if (HiWord(Integer(lpici.lpVerb)) <> 0) or (LoWord(lpici.lpVerb) > 0) then
begin
Result := E_FAIL;
Exit;
end;
case LoWord(lpici.lpVerb) of
0: Showmessage('IE面板组件演示程序1.0');
end;
Result := NO_ERROR;
end;
procedure TDelphiBand.BandWndProc(var Message: TMessage);
begin
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
if (Site <> nil) then
Site.OnFocusChangeIS(Self, bHasFocus);
end;
function TDelphiBand.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 TDelphiBand.HasFocusIO: HResult;
begin
Result := Integer(not HasFocus);
end;
function TDelphiBand.UIActivateIO(fActivate: BOOL;
var lpMsg: TMsg): HResult;
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;
begin
if Assigned(pUnkSite) then
begin
Site := pUnkSite as IInputObjectSite;
(pUnkSite as IOleWindow).GetWindow(ParentWnd);
(Site as IServiceProvider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
end;
Result := S_OK;
end;
function TDelphiBand.GetSite(const riid: TIID;
out site: IUnknown): HResult;
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.Createdo
try
DeleteKey('Software/Microsoft/Windows/CurrentVersion/Explorer/Discardable/PostSetup/Component Categories/'
+ VerticalBand + '/Enum');
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/' + VerticalBand, True)
then
CloseKey;
finally
Free;
end;
end;
procedure TDelphiBandFactory.RemoveKeys;
var
S: string;
begin
S := GUIDToString(CLSID_DelphiBand);
with TRegistry.Createdo
try
RootKey := HKEY_CLASSES_ROOT;
DeleteKey('CLSID/' + S + '/Implemented Categories/' + VerticalBand);
DeleteKey('CLSID/' + S + '/InProcServer32');
DeleteKey('CLSID/' + S);
Closekey;
finally
Free;
end;
end;
]