Mega Code Archive
Expoler plugin
<![CDATA[
Title: Expoler plugin
Question: Expoler plugin
Answer:
unit DeskBandCom;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows,Messages,ActiveX, Classes, ComObj,ShlObj,Unit1,Registry;
const
MIN_SIZE_X=10;
MIN_SIZE_Y=10;
const
IDM_COMMAND=0;
type
TBand = class(TComObject,
IDeskBand,
IObjectWithSite,
IPersistStream,
IInputObject,
IContextMenu)
protected
private
MenuItems : Integer;
HasFocus: Boolean;
BandID: DWORD;
SavedWndProc: twndmethod;
ParentWnd: HWND;
cmdTarget: IOleCommandTarget;
Form:TNOFORM;
//
Site:IInputObjectSite;
{procedure}
procedure FocusChange(HasFocus:Boolean);
procedure UpdateBandInfo;
procedure BandWndProc(var Message: TMessage);
public
{IDeskBand}
function GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):
HResult; stdcall;
{IObjectWithSite}
function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;
function GetSite(const riid: TIID; out site: IUnknown):HResult; stdcall;
{IPersist}
function GetClassID(out classID: TCLSID): HResult; stdcall;
{IPersistStream}
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;
{IDockingWindow}
function ShowDW(fShow: BOOL): HResult; stdcall;
function CloseDW(dwReserved: DWORD): HResult; stdcall;
function ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;
fReserved: BOOL): HResult; stdcall;
{IInputObject}
function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall;
function HasFocusIO: HResult; stdcall;
function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;
{IOleWindow}
function GetWindow(out wnd: HWnd): HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
{IContextMenu}
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;
end;
type
TBandFactory = class(TComObjectFactory)
private
procedure AddKeys;
procedure RemoveKeys;
public
procedure UpdateRegistry(Register: Boolean); override;
end;
const
Class_DeskBand: TGUID = '{01098678-9DB0-4584-962B-1079F6C9A65C}';
BandType='{00021492-0000-0000-C000-000000000046}';
implementation
uses ComServ;
{ TBand }
function TBand.CloseDW(dwReserved: DWORD): HResult;
begin
ShowDW(False);
if Assigned(Form) then
begin
Form.Destroy;
end;
Result:= S_OK;
end;
function TBand.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
Result:=E_NOTIMPL;
end;
function TBand.GetBandInfo(dwBandID, dwViewMode: DWORD;
var pdbi: TDeskBandInfo): HResult;
begin
BandId := dwBandID;
if (pdbi.dwMask or DBIM_MINSIZE) 0
then begin
pdbi.ptMinSize.y :=21;
pdbi.ptMinSize.x :=Form.Width;
end;
if (pdbi.dwMask or DBIM_MAXSIZE) 0
then begin
pdbi.ptMaxSize.x :=Form.Width;
pdbi.ptMaxSize.y :=21;
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 :=Form.Width;
pdbi.ptActual.y :=21;
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;
Result := NOERROR;
end;
function TBand.GetClassID(out classID: TCLSID): HResult;
begin
classID:=Class_DeskBand;
Result:=S_OK;
end;
function TBand.GetSite(const riid: TIID;
out site: IInterface): HResult;
begin
if Assigned(Site) then Result := Site.QueryInterface(riid, site)
else Result := E_FAIL;
end;
function TBand.GetSizeMax(out cbSize: Largeint): HResult;
begin
Result:=E_NOTIMPL;
end;
function TBand.GetWindow(out wnd: HWnd): HResult;
begin
if not Assigned(Form) then
begin
Form := TNOFORM.CreateParented(ParentWnd);
end;
Wnd := Form.Handle;
SavedWndProc := Form.WindowProc;
Form.WindowProc := BandWndProc;
Result := S_OK;
end;
function TBand.HasFocusIO: HResult;
begin
Result:=Integer(not HasFocus);
end;
function TBand.IsDirty: HResult;
begin
Result:=S_FALSE;
end;
function TBand.Load(const stm: IStream): HResult;
begin
Result:=S_OK;
end;
function TBand.ResizeBorderDW(var prcBorder: TRect;
punkToolbarSite: IInterface; fReserved: BOOL): HResult;
begin
Result:=E_NOTIMPL;
end;
function TBand.Save(const stm: IStream;
fClearDirty: BOOL): HResult;
begin
Result:=S_OK;
end;
function TBand.SetSite(const pUnkSite: IInterface): HResult;
begin
if Assigned(pUnkSite) then begin
Site := pUnkSite as IInputObjectSite;
(pUnkSite as IOleWindow).GetWindow(ParentWnd);
end;
Result := S_OK;
end;
function TBand.ShowDW(fShow: BOOL): HResult;
begin
Hasfocus:=fShow;
FocusChange(fShow);
Result:=S_OK;
end;
function TBand.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 TBand.UIActivateIO(fActivate: BOOL;
var lpMsg: TMsg): HResult;
begin
Hasfocus:=fActivate;
if HasFocus then Form.SetFocus;
Result := S_OK;
end;
function TBand.QueryContextMenu(Menu: HMENU;
indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
begin
InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst + 2, 'About ...');
InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst + 2, 'UpdateBandInfo...');
// Return number of items added:
MenuItems := 2;
Result := MenuItems;
end;
function TBand.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
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: Messagebox(0,' Client.1.0','Title',MB_ICONQUESTION);
end;
Result := NO_ERROR;
end;
function TBand.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
begin
Result := NOERROR;
end;
procedure TBand.BandWndProc(var Message: TMessage);
begin
if (Message.Msg = WM_PARENTNOTIFY) then
begin
Hasfocus:=True;
FocusChange(True);
end;
SavedWndProc(Message);
end;
procedure TBand.FocusChange(HasFocus: Boolean);
begin
if (Site nil) then Site.OnFocusChangeIS(Self,HasFocus);
end;
procedure TBand.UpdateBandInfo;
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;
{ TBandFactory }
procedure TBandFactory.AddKeys;
var S: string;
begin
S := GUIDToString(Class_DeskBand);
with TRegistry.Create do
try
// http://support.microsoft.com/support/kb/articles/Q247/7/05.ASP -
RootKey := HKEY_CLASSES_ROOT;
if OpenKey('CLSID\' + S, True) then
begin
WriteString('', '&BandBar');
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;
finally
Free;
end;
end;
procedure TBandFactory.RemoveKeys;
var S: string;
begin
S := GUIDToString(Class_DeskBand);
with TRegistry.Create do
try
RootKey := HKEY_CLASSES_ROOT;
// http://support.microsoft.com/support/kb/articles/Q214/8/42.ASP -
DeleteKey('Component Categories\' + BandType + '\Enum');
DeleteKey('CLSID\' + S + '\Implemented Categories\' + BandType);
DeleteKey('CLSID\' + S + '\InProcServer32');
DeleteKey('CLSID\' + S);
Closekey;
finally
Free;
end;
end;
procedure TBandFactory.UpdateRegistry(Register: Boolean);
begin
inherited UpdateRegistry(Register);
if Register then AddKeys else RemoveKeys;
end;
initialization
TBandFactory.Create(ComServer, TBand, Class_DeskBand,
'Band', '', ciMultiInstance, tmApartment);
end.
]]>