http://www.koders.com/
http://www.koders.com/ 推荐这个英文网站给大家，支持很多编程语言的选择，在这里可以搜索和下载想要的单元文件，头文件。
http://www.koders.com/delphi/fidE2EC5FB8EF53E0D3E2BEA1A0449FB5503204DF6C.aspx?s=IEDocHostUIHandler
//从代码中可以得到启发。
关于IDocHostUIHandler接口的方法的声明和定义。如何继承IDocHostUIHandler接口。很好很详细。。这次有救了，呵呵~ ^-^
http://www.koders.com/delphi/fid97E114819C0B41CE446F02B1233C70B548DC2FAD.aspx?s=IDocHostUIHandler
为了好的东西可以留存下来，必需转载！
/* －－－－－－－－－－ IDocHostUIHandler －－－－－－－－－ */
unit VclWb;
interface
uses
Windows, Messages, SysUtils, Classes, Forms, Controls,
OleCtrls, StdActns, ExtActns, ActiveX, SHDocVw, MSHTML, IEConst, ActnList, uDebug;
const
CGID_MSHTML: TGUID = '{DE4BA900-59CA-11CF-9592-444553540000}';
(*{$I VwbConst.inc}*)
type
TVclWebBrowser = class(TWebBrowser, IOleControlSite, IDocHostUIHandler)
private
FDesignMode, dmPending: boolean;
FFocused: boolean;
FStartPage: WideString;
FCanGoBack: boolean;
FCanGoForward: boolean;
procedure SetDesignMode(const dm: boolean);
procedure CommandStateChange(Sender: TObject; Command: Integer; Enable: WordBool);
procedure MyUpdateAction(action: TCustomAction; cmdID: OLECMDID);
procedure MyExecuteAction(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT;
var vaIn, vaOut: OleVariant);
protected
property OnCommandStateChange;
procedure Loaded; override;
public
{ IOleControlSite }
function OnControlInfoChanged: HResult; stdcall;
function LockInPlaceActive(fLock: BOOL): HResult; stdcall;
function GetExtendedControl(out disp: IDispatch): HResult; stdcall;
function TransformCoords(var ptlHimetric: TPoint; var ptfContainer: TPointF;
flags: Longint): HResult; stdcall;
function IOleControlSite.TranslateAccelerator = OleControlSite_TranslateAccelerator;
function OleControlSite_TranslateAccelerator(msg: PMsg;
grfModifiers: Longint): HResult; stdcall;
function OnFocus(fGotFocus: BOOL): HResult; stdcall;
function ShowPropertyFrame: HResult; stdcall;
{ IDocHostUIHandler }
function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; const pcmdtReserved: IUnknown;
const pdispReserved: IDispatch): HRESULT; stdcall;
function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
function HideUI: HRESULT; stdcall;
function UpdateUI: HRESULT; stdcall;
function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
function ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow;
const FrameWindow: BOOL): HRESULT; stdcall;
function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
const nCmdID: DWORD): HRESULT; stdcall;
function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HRESULT; stdcall;
function GetDropTarget(const pDropTarget: IDropTarget;
out ppDropTarget: IDropTarget):HRESULT; stdcall;
function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
var ppchURLOut: POLESTR): HRESULT; stdcall;
function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
{ Normal }
function Focused: Boolean; override;
function ItemByName(name: WideString): IHTMLElement;
function UpdateAction(Action: TBasicAction): boolean; override;
function ExecuteAction(Action: TBasicAction): boolean; override;
property CanGoBack: boolean read FCanGoBack;
property CanGoForward: boolean read FCanGoForward;
published
{ Published declarations }
property DesignMode: boolean read FDesignMode write SetDesignMode;
property StartPage: WideString read FStartPage write FStartPage;
end;
TWebBrowserAction = class(TAction) //todo: or TCustomAction
{ private
FControl: TCustomEdit;
procedure SetControl(Value: TCustomEdit);
protected
function GetControl(Target: TObject): TCustomEdit; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
destructor Destroy; override;
function HandlesTarget(Target: TObject): Boolean; override;
procedure UpdateTarget(Target: TObject); override;
property Control: TCustomEdit read FControl write SetControl;}
end;
TWebGoBack = class(TWebBrowserAction);
TWebGoForward = class(TWebBrowserAction);
TWebGoHome = class(TWebBrowserAction);
TWebRefresh = class(TWebBrowserAction);
TWebPageSetup = class(TWebBrowserAction);
TWebPrint = class(TWebBrowserAction);
TWebPrintPreview = class(TWebBrowserAction);
TWebStop = class(TWebBrowserAction);
//todo: IECMDID_CLEAR_AUTOCOMPLETE_FOR_FORMS: Clears data saved in forms.
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Internet', [TVclWebBrowser]);
RegisterActions('WebBrowser', [
TWebGoBack, TWebGoForward, TWebGoHome, TWebRefresh, TWebPageSetup,
TWebPrint, TWebPrintPreview, TWebStop], nil);
end;
{ TVclWebBrowser }
{ TVclWebBrowser.IOleControlSite }
function TVclWebBrowser.OnControlInfoChanged: HResult;
begin
Result := E_NOTIMPL;
end;
function TVclWebBrowser.LockInPlaceActive(fLock: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;
function TVclWebBrowser.GetExtendedControl(out disp: IDispatch): HResult;
begin
Result := E_NOTIMPL;
end;
function TVclWebBrowser.TransformCoords(var ptlHimetric: TPoint;
var ptfContainer: TPointF; flags: Longint): HResult;
begin
if flags and XFORMCOORDS_HIMETRICTOCONTAINER <> 0 then
begin
ptfContainer.X := MulDiv(ptlHimetric.X, Screen.PixelsPerInch, 2540);
ptfContainer.Y := MulDiv(ptlHimetric.Y, Screen.PixelsPerInch, 2540);
end else
begin
ptlHimetric.X := Integer(Round(ptfContainer.X * 2540 / Screen.PixelsPerInch));
ptlHimetric.Y := Integer(Round(ptfContainer.Y * 2540 / Screen.PixelsPerInch));
end;
Result := S_OK;
end;
function TVclWebBrowser.OleControlSite_TranslateAccelerator(
msg: PMsg; grfModifiers: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TVclWebBrowser.OnFocus(fGotFocus: BOOL): HResult;
var
Form: TCustomForm;
begin
Result := S_OK;
FFocused := fGotFocus;
DebugPrint('Focused = ' + BoolToStr(fGotFocus));
//todo: see tweb.setfocus
(*this is it:
procedure TWeb.SetFocus;
begin
try
if TheDoc=nil then
exit;
SendMessage(Handle,wm_Activate,1,0);
if TheWind<>nil then
TheWind.Focus; {TheWind.Focus must come before TWeb.SetFocus}
if TheParent.Visible then {Parenting window hosting web browser}
if Visible then
if CanFocus then
inherited SetFocus; {must come AFTER TheWind.Focus}
except
on E:Exception do EError('Error setting focus on HTML component',E);
end;
end;
*)
(* if Document <> nil then
if fGotFocus then
(Document as IHTMLDocument2).parentWindow.focus
else
(Document as IHTMLDocument2).parentWindow.blur;
with Application as IOleobject do
if fGotFocus then
DoVerb(OLEIVERB_UIACTIVATE, nil, Self, 0, Handle, GetClientRect)
else
DoVerb(OLEIVERB_UIDEACTIVATE, nil, Self, 0, Handle, GetClientRect);}*)
Form := GetParentForm(Self);
if Form <> nil then
if fGotFocus then
Form.SetFocusedControl(Self)
else
Form.DefocusControl(self, false);
end;
function TVclWebBrowser.ShowPropertyFrame: HResult;
begin
Result := E_NOTIMPL;
end;
{ IDocHostUIHandler }
function TVclWebBrowser.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT;
{***************************************************************************************************
Called by MSHTML to display a shortcut menu.
***************************************************************************************************}
begin
Result := S_OK;
if Assigned(PopupMenu) then
PopupMenu.Popup(ppt^.X, ppt^.Y);
end;
function TVclWebBrowser.GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT;
{***************************************************************************************************
Called by MSHTML to retrieve the user interface (UI) capabilities of the application that is
hosting MSHTML.
***************************************************************************************************}
begin
pInfo.cbSize := SizeOf(pInfo); //todo: check if already filled
pInfo.dwFlags := DOCHOSTUIFLAG_OPENNEWWIN; //todo: �� ���� ��� published property
pInfo.dwDoubleClick := DOCHOSTUIDBLCLK_DEFAULT;
pInfo.chHostCss := nil; //todo: �� �� �� ������� ��������� �� css
pInfo.chHostNS := nil;
Result := S_OK;
end;
function TVclWebBrowser.ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HRESULT;
{***************************************************************************************************
Called by MSHTML to enable the host to replace MSHTML menus and toolbars.
***************************************************************************************************}
begin
Result := S_FALSE; //todo: 1. Maybe S_OK? 2. check IDM_DISABLEMODELESS
end;
function TVclWebBrowser.HideUI: HRESULT;
{***************************************************************************************************
Called when MSHTML removes its menus and toolbars.
***************************************************************************************************}
begin
Result := E_NOTIMPL;
end;
function TVclWebBrowser.UpdateUI: HRESULT;
{***************************************************************************************************
Called by MSHTML to notify the host that the command state has changed.
***************************************************************************************************}
begin
Result := S_OK;
//todo: maybe update actions...
end;
function TVclWebBrowser.EnableModeless(const fEnable: BOOL): HRESULT;
{***************************************************************************************************
Called by the MSHTML implementation of IOleInPlaceActiveObject::EnableModeless.
Also called when MSHTML displays a modal UI.
***************************************************************************************************}
begin
Result := E_NOTIMPL;
end;
function TVclWebBrowser.OnDocWindowActivate(const fActivate: BOOL): HRESULT;
{***************************************************************************************************
Called by the MSHTML implementation of IOleInPlaceActiveObject::OnDocWindowActivate.
***************************************************************************************************}
begin
Result := E_NOTIMPL; //todo: check if this is called regularly and remove onfocus...
end;
function TVclWebBrowser.OnFrameWindowActivate(const fActivate: BOOL): HRESULT;
{***************************************************************************************************
Called by the MSHTML implementation of IOleInPlaceActiveObject::OnFrameWindowActivate.
***************************************************************************************************}
begin
Result := E_NOTIMPL;
end;
function TVclWebBrowser.ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow;
const fRameWindow: BOOL): HRESULT;
{***************************************************************************************************
Called from the MSHTML implementation of IOleInPlaceActiveObject.ResizeBorder.
***************************************************************************************************}
begin
Result := E_NOTIMPL;
end;
function TVclWebBrowser.TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
const nCmdID: DWORD): HRESULT;
{***************************************************************************************************
Called by MSHTML when IOleInPlaceActiveObject::TranslateAccelerator
or IOleControlSite::TranslateAccelerator is called.
***************************************************************************************************}
begin
//called by VCL
//called by OCX
{ by OCX this is called from:
from: if FOleInPlaceActiveObject.TranslateAccelerator(WinMsg) = S_OK
in: procedure TOleControl.WndProc(var Message: TMessage);
after this call comes calls to:
TVclWebBrowser._TranslateAccelerator
TEditDesigner.TranslateAccelerator
TVclWebBrowser.OleControlSite_TranslateAccelerator
}
Result := E_NOTIMPL; //todo: check if this is a place to override ctrl+...
{ if we return S_OK then no further call to other "translate accelerator" occurs
because TOleControl.WndProc doesn't delegate the message further up the chain}
end;
function TVclWebBrowser.GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HRESULT;
{***************************************************************************************************
Called by the WebBrowser Control to retrieve a registry subkey path that overrides the default
Microsoft� Internet Explorer registry settings.
***************************************************************************************************}
begin
pchKey := nil;
Result := E_NOTIMPL;
end;
function TVclWebBrowser.GetDropTarget(const pDropTarget: IDropTarget;
out ppDropTarget: IDropTarget): HRESULT;
{***************************************************************************************************
Called by MSHTML when it is used as a drop target. This method enables the host to supply an
alternative IDropTarget interface.
***************************************************************************************************}
begin
Result := E_NOTIMPL;
end;
function TVclWebBrowser.GetExternal(out ppDispatch: IDispatch): HRESULT;
{***************************************************************************************************
Called by MSHTML to obtain the host's IDispatch interface.
***************************************************************************************************}
begin
ppDispatch := nil;
Result := E_NOTIMPL;
end;
function TVclWebBrowser.TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
var ppchURLOut: POLESTR): HRESULT;
{***************************************************************************************************
Called by MSHTML to give the host an opportunity to modify the URL to be loaded.
***************************************************************************************************}
begin
ppchURLOut := nil;
Result := S_FALSE;
end;
function TVclWebBrowser.FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT;
{***************************************************************************************************
Called by MSHTML to allow the host to replace the MSHTML data object.
***************************************************************************************************}
begin
ppDORet := nil;
Result := S_FALSE;
end;
{ Normal }
procedure TVclWebBrowser.SetDesignMode(const dm: boolean);
begin
FDesignMode := dm;
dmPending := true;
CommandStateChange(self, 0, false);
end;
procedure TVclWebBrowser.CommandStateChange(Sender: TObject; Command: Integer; Enable: WordBool);
begin
if dmPending then
if Document <> nil then
begin
// while Busy or (Document as IHTMLDocument2).
// while ReadyState <> READYSTATE_COMPLETE do
// Forms.Application.ProcessMessages;
// OleObject.Document.Body.ContentEditable := FDesignMode;
if FDesignMode then
(Document as IHTMLDocument2).designMode := 'On'
else
(Document as IHTMLDocument2).designMode := 'Off';
dmPending := false;
end;
case Command of
CSC_NAVIGATEFORWARD:
begin
FCanGoForward := Enable;
if FCanGoForward then
DebugPrint('CanGoForward <= TRUE')
else
DebugPrint('CanGoForward <= FALSE');
end;
CSC_NAVIGATEBACK:
begin
FCanGoBack := Enable;
if FCanGoBack then
DebugPrint('CanGoBack <= TRUE')
else
DebugPrint('CanGoBack <= FALSE');
end;
else { CSC_UPDATECOMMANDS: }
; //todo: update actions
end;
end;
procedure TVclWebBrowser.MyUpdateAction(action: TCustomAction; cmdID: OLECMDID);
var
oc: OLECMD;
s: IHTMLSelectionObject;
begin
if Document = nil then
Exit;
oc.cmdID := cmdId;
oc.cmdf := 0;
try
(Document as IOleCommandTarget).QueryStatus(@CGID_MSHTML, 1, @oc, nil)
except
DebugPrint('Interface not supported');
Exit;
end;
if (oc.cmdf and OLECMDF_SUPPORTED = 0) or (oc.cmdf and OLECMDF_ENABLED = 0) then
begin
s := (Document as IHTMLDocument2).selection;
if (s <> nil) and (s.type_ = 'text') then
(s.createRange as IOleCommandTarget).QueryStatus(@CGID_MSHTML, 1, @oc, nil);
{ if (oc.cmdf and OLECMDF_SUPPORTED = 0) or (oc.cmdf and OLECMDF_ENABLED = 0) then
if (Document as IHTMLDocument2).queryCommandEnabled('Copy') then
oc.cmdf := oc.cmdf or OLECMDF_ENABLED;}
end;
//todo: ���� �� ���� ��� tag ��� action �� ����� ����������...
//see queryCommandEnabled: it is different on a document/textrange.
// with Document as IOleCommandTarget do //����� �� selection ���� ������� �� �� document
// with ((Document as IHTMLDocument2).selection.createRange as IOleCommandTarget) do
action.Checked := (oc.cmdf and OLECMDF_LATCHED) <> 0;
// if not DesignMode {todo: and not ReadOnly} then
// action.Enabled := false
// else}
action.Enabled := (oc.cmdf and OLECMDF_ENABLED) <> 0;
end;
procedure TVclWebBrowser.MyExecuteAction(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT;
var vaIn, vaOut: OleVariant);
begin
if Document = nil then
Exit;
// self.ControlInterface.ExecWB(cmdID, cmdexecopt, vaIn, vaOut);
//JustifyFull �������� ��� ���� 4, print ���!
// ((Document as IHTMLDocument2).selection.createRange as IOleCommandTarget).
// ((Document as IHTMLDocument2).activeElement as IOleCommandTarget).
// (Document as IHTMLDocument2).execCommand('Delete', false, EmptyParam);
// ExecWB(cmdID, OLECMDEXECOPT_DODEFAULT)
(Document as IOleCommandTarget).Exec(@CGID_MSHTML, cmdID, cmdexecopt, vaIn, vaOut);
// ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT);
end;
procedure TVclWebBrowser.Loaded;
begin
Inherited;
if not (csDesigning in ComponentState) then
begin
OnCommandStateChange := CommandStateChange;
if Length(FStartPage) <> 0 then
Navigate(FStartPage);
end;
end;
function TVclWebBrowser.Focused: boolean;
begin
Result := FFocused;
end;
function TVclWebBrowser.ItemByName(name: WideString): IHTMLElement;
begin
if Document = nil then
result := nil
else
result := (Document as IHTMLDocument2).all.item(name, 0) as IHTMLElement; //Could be again nil
end;
var
backs: integer = 0;
forwards: integer = 0;
lastCanGoBack: boolean = false;
lastCanGoForward: boolean = false;
function TVclWebBrowser.UpdateAction(Action: TBasicAction): boolean;
var
ca: TCustomAction;
callInherited: boolean;
begin
ca := TCustomAction(Action);
Result := FFocused;
callInherited := not FFocused;
if FFocused then
if Action is TWebBrowserAction then
begin
if Action is TWebGoBack then
begin
Inc(backs);
if lastCanGoBack <> CanGoBack then
DebugPrint('CanGoBack = ' + BoolToStr(CanGoBack) + ', ' + IntToStr(backs));
lastCanGoBack := CanGoBack;
Result := CanGoBack;
end
else if Action is TWebGoForward then
begin
Inc(forwards);
if lastCanGoForward <> CanGoForward then
DebugPrint('CanGoForward = ' + BoolToStr(CanGoForward) + ', ' + IntToStr(forwards));
lastCanGoForward := CanGoForward;
Result := CanGoForward;
end
else if Action is TWebGoHome then
Result := true
else if Action is TWebRefresh then
Result := true
else if Action is TWebPageSetup then
Result := true
else if Action is TWebPrint then
Result := true
else if Action is TWebPrintPreview then
Result := true
else if Action is TWebStop then
Result := Busy
else
callInherited := true;
if not callInherited then
(Action as TWebBrowserAction).Enabled := result;
end
else if (ca is TRichEditAction) then //���� ��� ��� TEditAction ����� ����� �������� ���
begin
if ca is TRichEditBold then
MyUpdateAction(ca, IDM_BOLD)
else if ca is TRichEditItalic then
MyUpdateAction(ca, IDM_ITALIC)
else if ca is TRichEditUnderline then
MyUpdateAction(ca, IDM_UNDERLINE)
else if ca is TRichEditStrikeOut then
MyUpdateAction(ca, IDM_STRIKETHROUGH)
else if ca is TRichEditAlignLeft then
MyUpdateAction(ca, IDM_JUSTIFYLEFT)
else if ca is TRichEditAlignCenter then
MyUpdateAction(ca, IDM_JUSTIFYCENTER)
else if ca is TRichEditAlignRight then
MyUpdateAction(ca, IDM_JUSTIFYRIGHT)
else if ca is TRichEditBullets then
MyUpdateAction(ca, IDM_UNORDERLIST)
else
callInherited := true;
end
else if ca is TEditAction then
begin
if ca is TEditCopy then
MyUpdateAction(ca, IDM_COPY)
else if ca is TEditCut then
MyUpdateAction(ca, IDM_CUT)
else if ca is TEditDelete then
MyUpdateAction(ca, IDM_DELETE)
else if ca is TEditPaste then
MyUpdateAction(ca, IDM_PASTE)
else if ca is TEditSelectAll then
MyUpdateAction(ca, IDM_SELECTALL)
else if ca is TEditUndo then
MyUpdateAction(ca, IDM_UNDO)
else
callInherited := true;
end
else if ca is TSearchFind then
MyUpdateAction(ca, IDM_FIND)
else
callInherited := true;
if callInherited then
Result := inherited UpdateAction(Action);
end;
function TVclWebBrowser.ExecuteAction(Action: TBasicAction): boolean;
begin
Result := {Focused and }(Document <> nil);
if Action is TWebBrowserAction then
begin
if Action is TWebGoBack then
GoBack
else if Action is TWebGoForward then
GoForward
else if Action is TWebGoHome then
Navigate(StartPage)
else if Action is TWebRefresh then
Refresh
else if Action is TWebPageSetup then
MyExecuteAction(IDM_PAGESETUP, OLECMDEXECOPT_PROMPTUSER, EmptyParam, EmptyParam)
else if Action is TWebPrint then
MyExecuteAction(IDM_PRINT, OLECMDEXECOPT_PROMPTUSER, EmptyParam, EmptyParam)
else if Action is TWebPrintPreview then
MyExecuteAction(IDM_PRINTPREVIEW, OLECMDEXECOPT_PROMPTUSER, EmptyParam, EmptyParam)
else if Action is TWebStop then
Stop
else
Result := false;
end
else if Result then
if Action is TRichEditAction then //���� ��� ��� TEditAction ����� ����� �������� ���
begin
if Action is TRichEditBold then
MyExecuteAction(IDM_BOLD, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TRichEditItalic then
MyExecuteAction(IDM_ITALIC, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TRichEditUnderline then
MyExecuteAction(IDM_UNDERLINE, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TRichEditStrikeOut then
MyExecuteAction(IDM_STRIKETHROUGH, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TRichEditAlignLeft and DesignMode then
MyExecuteAction(IDM_JUSTIFYLEFT, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TRichEditAlignCenter and DesignMode then
MyExecuteAction(IDM_JUSTIFYCENTER, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TRichEditAlignRight and DesignMode then
MyExecuteAction(IDM_JUSTIFYRIGHT, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TRichEditBullets and DesignMode then
MyExecuteAction(IDM_UNORDERLIST, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else
Result := false;
end
else if Action is TEditAction then
begin
if Action is TEditCopy then
MyExecuteAction(IDM_COPY, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TEditCut then
MyExecuteAction(IDM_CUT, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TEditDelete then
MyExecuteAction(IDM_DELETE, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TEditPaste then
MyExecuteAction(IDM_PASTE, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TEditSelectAll then
MyExecuteAction(IDM_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else if Action is TEditUndo then
MyExecuteAction(IDM_UNDO, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam)
else
Result := false;
end
else if Action is TSearchFind then
MyExecuteAction(IDM_FIND, OLECMDEXECOPT_PROMPTUSER, EmptyParam, EmptyParam)
else
Result := false;
if not Result then
Result := inherited ExecuteAction(Action);
end;
initialization
OleInitialize(nil);
finalization
OleUnInitialize;
end.
浙公网安备 33010602011771号