Componentes.Terceros.DevExp.../official/x.48/ExpressWeb Framework/Sources/cxWebHTMLEditor.pas
2010-01-18 18:33:24 +00:00

3187 lines
94 KiB
ObjectPascal

{*******************************************************************}
{ }
{ ExpressWeb Framework by Developer Express }
{ Designer Module }
{ }
{ Copyright (c) 2000-2009 Developer Express Inc. }
{ ALL RIGHTS RESERVED }
{ }
{ The entire contents of this file is protected by U.S. and }
{ International Copyright Laws. Unauthorized reproduction, }
{ reverse-engineering, and distribution of all or any portion of }
{ the code contained in this file is strictly prohibited and may }
{ result in severe civil and criminal penalties and will be }
{ prosecuted to the maximum extent possible under the law. }
{ }
{ RESTRICTIONS }
{ }
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
{ LICENSED TO DISTRIBUTE THE EXPRESSWEB FRAMEWORK AND ALL }
{ ACCOMPANYING VCL CLASSES AS PART OF AN EXECUTABLE WEB }
{ APPLICATION ONLY. }
{ }
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
{ }
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
{ ADDITIONAL RESTRICTIONS. }
{ }
{*******************************************************************}
unit cxWebHTMLEditor;
interface
uses Classes, SysUtils, Windows, ActiveX, OleCtrls, MSHTML_TLB, SHDocVw,
cxWebHTMLBehaviors, cxWebHTMLevents, cxWebHTMLEdIntf, cxWebHTMLHostIntf;
type
TcxHTMLDocReadyEvent = procedure(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant) of object;
TcxHTMLBeforeNavigateEvent = procedure(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant;
var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant;
var Headers: OleVariant; var Cancel: WordBool) of object;
TcxHTMLNewWindowEvent = procedure(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool) of object;
TcxHTMLEditor = class;
TcxHTMLUndoManager = class(TObject)
private
FEditor: TcxHTMLEditor;
FOpenBlockCount: Integer;
function GetUndoDesctiption: string;
function GetRedoDesctiption: string;
protected
function GetOleUndoManager: IcxOleUndoManager;
public
constructor Create(AEditor: TcxHTMLEditor);
procedure Clear;
procedure BeginUndoBlock(const ACaption: string);
procedure EndUndoBlock;
function CanRedo: Boolean;
function CanUndo: Boolean;
procedure Redo;
procedure Undo;
property RedoDesctiption: string read GetRedoDesctiption;
property UndoDesctiption: string read GetUndoDesctiption;
end;
TcxHTMLDocHostUIHandler = class(TObject)
private
FEditor: TcxHTMLEditor;
protected
function ShowContextMenu(dwID: LongWord; ppt: PPoint; const pcmdtReserved: IUnknown;
const pdispReserved: IDispatch): HResult; stdcall;
function GetHostInfo(var pInfo: DOCHOSTUIINFO): HResult; stdcall;
function ShowUI(dwID: LongWord; const pActiveObject: IUnknown; const pCommandTarget: IUnknown;
const pFrame: IUnknown; const pDoc: IUnknown): HResult; stdcall;
function HideUI: HResult; stdcall;
function UpdateUI: HResult; stdcall;
function EnableModeless(fEnable: Integer): HResult; stdcall;
function OnDocWindowActivate(fActivate: Integer): HResult; stdcall;
function OnFrameWindowActivate(fActivate: Integer): HResult; stdcall;
function ResizeBorder(var prcBorder: Integer; const pUIWindow: IUnknown; fRameWindow: Integer): HResult; stdcall;
function TranslateAccelerator(lpmsg: PMsg; pguidCmdGroup: PGUID; nCmdID: LongWord): HResult; stdcall;
function GetOptionKeyPath(out pchKey: PWideChar; dw: LongWord): HResult; stdcall;
function GetDropTarget(const pDropTarget: IUnknown; var ppDropTarget: IUnknown): HResult; stdcall;
function GetExternal(var ppDispatch: IDispatch): HResult; stdcall;
function TranslateUrl(dwTranslate: LongWord; const pchURLIn: PWideChar; out ppchURLOut: PWideChar): HResult; stdcall;
function FilterDataObject(const pDO: IUnknown; var ppDORet: IUnknown): HResult; stdcall;
function ShowMessage(hwnd: THandle; lpstrText, lpstrCaption: PWideChar; dwType: LongWord; lpstrHelpFile: PWideChar;
dwHelpContext: LongWord; var plResult: LongInt): HResult; stdcall;
function ShowHelp(hwnd: THandle; pszHelpFile: PWideChar; uCommand: LongWord; dwData: LongWord;
ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HResult; stdcall;
public
constructor Create(AEditor: TcxHTMLEditor);
end;
TcxHTMLFrameSide = (fsLeft, fsRight, fsTop, fsBottom);
TcxHTMLOleCommandTarget = class(TInterfacedObject, IcxOleCommandTarget)
private
FEditor: TcxHTMLEditor;
function GetWBCommandTarget: IcxOleCommandTarget;
// Table editing helper
function FindCellOf(AElement: IHTMLElement): IHTMLTableCell;
function FindRowOf(AElement: IHTMLElement): IHTMLTableRow;
function FindTableOf(AElement: IHTMLElement): IHTMLTable;
function GetCellByAbsIndex(ARow: IHTMLTableRow; AIndex: Integer): IHTMLTableCell;
function GetCellAbsIndex(ARow: IHTMLTableRow; AIndex: Integer): Integer;
function IsCellsSelected: Boolean;
function IsRowsSelected: Boolean;
function IsViewLinkSelected: Boolean;
procedure UpdateCellColSpan(ACell: IHTMLTableCell; N: Integer);
// Frame editing helper
function IsFrameSelected: Boolean;
function GetFrameIndex(AFrameSet, AFrame: IHTMLElement): Integer;
function FindParentFrameset(const AElement: IHTMLElement): IHTMLFrameSetElement;
protected
function QueryStatus(CmdGroup: PGUID; cCmds: Cardinal;
prgCmds: POleCmd; CmdText: POleCmdText): HResult; stdcall;
function Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
vaIn, vaOut: PVariantArg): HResult; stdcall;
public
constructor Create(AEditor: TcxHTMLEditor);
// Table editing commands
function CanTableInsert: Boolean;
function CanRowInsert: Boolean;
function CanColInsert: Boolean;
function CanCellInsert: Boolean;
function CanTableSelect: Boolean;
function CanRowSelect: Boolean;
function CanColSelect: Boolean;
function CanCellSelect: Boolean;
function CanCellMerge: Boolean;
function CanCellSplit: Boolean;
function CanTableDelete: Boolean;
function CanRowDelete: Boolean;
function CanColDelete: Boolean;
function CanCellDelete: Boolean;
procedure TableInsert;
procedure TableSelect;
procedure TableDelete;
procedure ColInsert(ToRight: Boolean = False);
procedure ColSelect;
procedure ColDelete;
procedure RowInsert(Below: Boolean = False);
procedure RowSelect;
procedure RowDelete;
procedure CellInsert;
procedure CellSelect;
procedure CellMerge;
procedure CellSplit;
procedure CellDelete;
// Frames editing commands
function CanFrame: Boolean;
function CanWholeFrame: Boolean;
procedure FrameInsert(ASide: TcxHTMLFrameSide);
procedure FrameDelete;
procedure WholeFrameInsert;
// Undo/Redo commands
procedure AfterUndoRedo(const ACommand: string);
function BeforeUndoRedo(ACmdID: Cardinal): string;
end;
TcxHTMLSelectionType = (stNone, stText, stControl);
TcxHTMLSelection = class(TObject)
private
FEditor: TcxHTMLEditor;
function GetAbsolutePosition: Boolean;
procedure SetAbsolutePosition(const Value: Boolean);
function GetCaret: IHTMLCaret;
function GetControl(Index: Integer): IHTMLElement;
function GetCount: Integer;
function GetElementFromCaret: IHTMLElement;
function GetElementsFromTextRange(AElements: TInterfaceList): Integer;
function GetSelType: TcxHTMLSelectionType;
function GetSelectionObject: IHTMLSelectionObject;
function GetControlRange: IHTMLControlRange;
function GetTextRange: IHTMLTxtRange;
function CreateControlRange: IHTMLControlRange;
function GetActiveFrame: IHTMLFrameBase;
protected
function CanCommand(const ACmdID: OLECMDID): Boolean;
procedure ExeCommand(const ACmdID: OLECMDID);
property ControlRange: IHTMLControlRange read GetControlRange;
property TextRange: IHTMLTxtRange read GetTextRange;
public
constructor Create(AEditor: TcxHTMLEditor);
procedure Add(AControl: IHTMLElement);
function CanClear: Boolean;
function CanCopy: Boolean;
function CanCut: Boolean;
function CanDelete: Boolean;
function CanPaste: Boolean;
function CanSelectAll: Boolean;
procedure Clear;
procedure Copy;
procedure Cut;
procedure Delete;
procedure Empty;
function IndexOf(AControl: IHTMLElement): Integer;
function Last: IHTMLElement;
procedure Paste;
procedure Remove(AControl: IHTMLElement);
procedure SelectAll;
property AbsolutePosition: Boolean read GetAbsolutePosition write SetAbsolutePosition;
property Count: Integer read GetCount;
property Controls[Index: Integer]: IHTMLElement read GetControl; default;
property SelType: TcxHTMLSelectionType read GetSelType;
end;
TcxHTMLEditorContextMenuEvent = procedure(ASender: TObject; APos: TPoint;
AElement: IHTMLElement) of object;
TcxControlInsertEvent = procedure(Sender: TObject; R: TRect; var HTML, InnerHTML: string;
var ParentElement: IHTMLElement) of object;
TcxControlInsertedEvent = procedure(Sender: TObject; Element: IHTMLElement) of object;
TcxParentChangedEvent = procedure(ASender: TObject; ANewParent: IHTMLElement) of object;
TcxHTMLEditorState = (esNormal, esDragging, esMoving, esResizing);
TcxHTMLEditor = class(TOleControl, IDispatch, IServiceProvider, IHTMLEditHost,
IDocHostUIHandler, IDocHostShowUI, IcxHTMLEditorInfo, IcxHTMLElementInfo,
IHTMLChangeSink)
private
FBar: IcxHTMLEditorBar;
FCommandTarget: IcxOleCommandTarget;
FDocEventSink: TcxHTMLDocEventSink;
FDocEventSinkIntf: IcxEventSink;
FNamespaces: IInterfaceList;
FHostUIHandler: TcxHTMLDocHostUIHandler;
FIntf: IWebBrowser2;
FModified: Boolean;
FPrimaryMCId: Cardinal;
FBaseURL: string;
FInternalBrowseMode: Boolean;
FSelection: TcxHTMLSelection;
FState: TcxHTMLEditorState;
FOnControlInsert: TcxControlInsertEvent;
FOnControlInserted: TcxControlInsertedEvent;
FOnDocumentComplete: TNotifyEvent;
FOnDocumentChange: TNotifyEvent;
FOnSelectionChanged: TNotifyEvent;
FOnShowContextMenu: TcxHTMLEditorContextMenuEvent;
FOnDocReady: TcxHTMLDocReadyEvent;
FOnBeforeNavigate: TcxHTMLBeforeNavigateEvent;
FOnNewWindow: TcxHTMLNewWindowEvent;
FOnParentChanged: TcxParentChangedEvent;
FOnMoved: TNotifyEvent;
FOnResized: TNotifyEvent;
FDraggingElement: IHTMLElement;
FDropTarget: IHTMLElement;
FUndoManager: TcxHTMLUndoManager;
function GetControlInterface: IWebBrowser2;
function GetDocument: IHTMLDocument2;
function GetDocument3: IHTMLDocument3;
function GetDocument4: IHTMLDocument4;
function GetBrowseMode: Boolean;
function GetBusy: Boolean;
function GetDocumentReady: Boolean;
function GetModified: Boolean;
function GetDocumentHTML: string;
function GetDisplayServices: IDisplayServices;
function GetMarkupServices: IMarkupServices;
procedure ProcessMessages;
procedure SetBaseURL(const Value: string);
procedure SetBrowseMode(const Value: Boolean);
procedure SetDocumentHTML(const Value: string);
procedure SetModified(const Value: Boolean);
function GetBody: IHTMLBodyElement;
function GetBodyElement: IHTMLElement;
function AddNamespace(const ANamespace: string): IcxHTMLNamespace;
function FindNamespace(const ANamespace: string): IcxHTMLNamespace;
function FindElementBehavior(AElement: IHTMLElement): IcxHTMLBehaviorViewLink;
function CheckInSelectRect(Element: IHTMLElement; R: TRect): Boolean;
function FireEvent(ASrcElement: IHTMLElement; const AName: string): Boolean;
procedure AddGlobalBehaviors;
procedure LinkChangeSink;
procedure UnlinkChangeSink;
protected
procedure CreateControl;
procedure InitControlData; override;
procedure AssignEvents;
procedure SetupControl;
procedure DoOnDocumentReady(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); virtual;
procedure DoOnBeforeNavigate(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant;
var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant;
var Headers: OleVariant; var Cancel: WordBool); virtual;
procedure DoOnNewWindow(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); virtual;
procedure DoDocumentChange; virtual;
procedure DoInsert(AParent: IHTMLElement; R: TRect); virtual;
procedure DoSelectionChanged; virtual;
procedure SelectByRect(const AEventObj: IHTMLEventObj; const ARect: TRect);
procedure GetHTMLElementsList(const AList: IInterfaceList); virtual;
procedure StartMoveSelectionByKey(const AKey: Integer; ASnap: Boolean);
procedure StartResizeSelectionByKey(const AKey: Integer);
procedure EndMoveSelectionByKey;
procedure EndResizeSelectionByKey;
{ Document event handlers }
procedure DoOnActivate(const AEventObj: IHTMLEventObj); virtual;
procedure DoOnSelectionChange(const AEventObj: IHTMLEventObj); virtual;
function DoOnClick(const AEventObj: IHTMLEventObj): WordBool; virtual;
function DoOnDblClick(const AEventObj: IHTMLEventObj): WordBool; virtual;
procedure DoOnKeyDown(const AEventObj: IHTMLEventObj); virtual;
function DoOnMoveStart(const AEventObj: IHTMLEventObj): WordBool; virtual;
procedure DoOnMoveEnd(const AEventObj: IHTMLEventObj); virtual;
function DoOnResizeStart(const AEventObj: IHTMLEventObj): WordBool; virtual;
procedure DoOnResizeEnd(const AEventObj: IHTMLEventObj); virtual;
procedure DoOnMouseDown(const AEventObj: IHTMLEventObj); virtual;
procedure DoOnMouseUp(const AEventObj: IHTMLEventObj); virtual;
procedure DoOnFocusOut(const AEventObj: IHTMLEventObj); virtual;
function DoOnDragStart(const AEventObj: IHTMLEventObj): WordBool; virtual;
procedure DoOnDragEnd(const AEventObj: IHTMLEventObj); virtual;
function DoOnDrop(const AEventObj: IHTMLEventObj): WordBool; virtual;
property CommandTarget: IcxOleCommandTarget read FCommandTarget;
property DisplayServices: IDisplayServices read GetDisplayServices;
property MarkupServices: IMarkupServices read GetMarkupServices;
property DraggingElement: IHTMLElement read FDraggingElement;
{ IDispatch }
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
{ IServiceProvider }
function QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
{ IHTMLEditHost }
function SnapRect(const pIElement: IHTMLElement; var prcNew: tagRECT; eHandle: _ELEMENT_CORNER): HResult; stdcall;
{ IDocHostUIHandler }
property HostUIHandler: TcxHTMLDocHostUIHandler read FHostUIHandler
implements IDocHostUIHandler, IDocHostShowUI;
{ IcxHTMLEditorInfo }
function ShowBorders: Boolean; virtual;
function ShowDetails: Boolean; virtual;
function ShowGrid: Boolean; virtual;
function SnapToGrid: Boolean; virtual;
function GridXSize: Integer; virtual;
function GridYSize: Integer; virtual;
function IsToolSelected: Boolean; virtual;
procedure CompleteUndoBlock;
{ IcxHTMLElementInfo }
procedure GetViewLinkContent(const AElement: IHTMLElement; var AContent, ACSSContent, AInlineStyle: string); virtual;
function IsElementContainer(const AElement: IHTMLElement): Boolean; virtual;
function CanHaveBehavior(const AElement: IHTMLElement): Boolean; virtual;
function ContainerLayout(const AElement: IHTMLElement): TcxHTMLContainerLayout; virtual;
function CanElementSelect(const AElement: IHTMLElement): Boolean; virtual;
{ IHTMLChangeSink }
function Notify: HResult; stdcall;
public
constructor Create(AOwner: TComponent; ABrowseMode: Boolean = False); reintroduce;
destructor Destroy; override;
function ExecCommand(const ACmdID: OLECMDID; ACmdExecOpt: OLECMDEXECOPT): OleVariant; overload;
function ExecCommand(const ACmdID: OLECMDID; ACmdExecOpt: OLECMDEXECOPT; AInVar: OleVariant): OleVariant; overload;
function QueryStatus(const ACmdID: OLECMDID): OLECMDF;
procedure LoadDocumentFromStream(const AStream: TStream);
procedure NewDocument;
procedure SaveDocumentToStream(const AStream: TStream);
procedure RegisterTags(const ANamespace: string; ATags: array of string);
function HasElementViewLink(AElement: IHTMLElement): Boolean;
procedure UpdateViewLinkContent(AElement: IHTMLElement);
procedure Wait;
property Bar: IcxHTMLEditorBar read FBar write FBar;
property BaseURL: string read FBaseURL write SetBaseURL;
property BrowseMode: Boolean read GetBrowseMode write SetBrowseMode;
property Busy: Boolean read GetBusy;
property Body: IHTMLBodyElement read GetBody;
property BodyElement: IHTMLElement read GetBodyElement;
property ControlInterface: IWebBrowser2 read GetControlInterface;
property DocumentReady: Boolean read GetDocumentReady;
property DocumentHTML: string read GetDocumentHTML write SetDocumentHTML;
property Document: IHTMLDocument2 read GetDocument;
property Document3: IHTMLDocument3 read GetDocument3;
property Document4: IHTMLDocument4 read GetDocument4;
property Selection: TcxHTMLSelection read FSelection;
property State: TcxHTMLEditorState read FState;
property Modified: Boolean read GetModified write SetModified;
property UndoManager: TcxHTMLUndoManager read FUndoManager;
property OnControlInsert: TcxControlInsertEvent read FOnControlInsert write FOnControlInsert;
property OnControlInserted: TcxControlInsertedEvent read FOnControlInserted write FOnControlInserted;
property OnDocumentComplete: TNotifyEvent read FOnDocumentComplete write FOnDocumentComplete;
property OnDocumentChange: TNotifyEvent read FOnDocumentChange write FOnDocumentChange;
property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
property OnParentChanged: TcxParentChangedEvent read FOnParentChanged write FOnParentChanged;
property OnResized: TNotifyEvent read FOnResized write FOnResized;
property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
property OnShowContextMenu: TcxHTMLEditorContextMenuEvent read FOnShowContextMenu write FOnShowContextMenu;
end;
var
cxWebHTMLDesignerMajorVersion: Integer = 5;
function IsEqualElement(const Element1, Element2: IHTMLElement): Boolean;
implementation
uses Messages, ComObj, cxWebHTMLConsts, Types, Variants, cxWebUtils, cxWebDsgnStrs;
const
URLBlank = 'about:Blank'; // Do not localize
function IsEqualElement(const Element1, Element2: IHTMLElement): Boolean;
begin
Result := False;
if (Element1 = nil) or (Element2 = nil) then Exit;
Result := Element1.sourceIndex = Element2.sourceIndex;
end;
{ TcxHTMLDocHostUIHandler }
constructor TcxHTMLDocHostUIHandler.Create(AEditor: TcxHTMLEditor);
begin
inherited Create;
FEditor := AEditor;
end;
function TcxHTMLDocHostUIHandler.EnableModeless(fEnable: Integer): HResult;
begin
{ OnEnable/Disable modeless UI }
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.FilterDataObject(const pDO: IInterface;
var ppDORet: IInterface): HResult;
begin
{ implement to support additional clipboard formats }
ppDORet := nil;
Result := S_FALSE;
end;
function TcxHTMLDocHostUIHandler.GetDropTarget(
const pDropTarget: IInterface; var ppDropTarget: IInterface): HResult;
begin
{ implement to supply an alternative drop target }
Result := E_NOTIMPL;
end;
function TcxHTMLDocHostUIHandler.GetExternal(
var ppDispatch: IDispatch): HResult;
begin
{ implement to expose an automation interface}
ppDispatch := nil;
Result := S_FALSE;
end;
function TcxHTMLDocHostUIHandler.GetHostInfo(
var pInfo: DOCHOSTUIINFO): HResult;
begin
pInfo.dwFlags := DOCHOSTUIFLAG_DISABLE_HELP_MENU or
DOCHOSTUIFLAG_OPENNEWWIN or
DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY or
DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE or
DOCHOSTUIFLAG_FLAT_SCROLLBAR or
DOCHOSTUIFLAG_NO3DBORDER or
DOCHOSTUIFLAG_DIV_BLOCKDEFAULT;
pInfo.dwDoubleClick := DOCHOSTUIDBLCLK_DEFAULT;
// pInfo.pchHostNS; investigate
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.GetOptionKeyPath(out pchKey: PWideChar;
dw: LongWord): HResult;
begin
{ implement to store individual registry settings }
Result := E_NOTIMPL;
end;
function TcxHTMLDocHostUIHandler.HideUI: HResult;
begin
if FEditor.Bar <> nil then
begin
FEditor.Bar.DisableUI(True);
FEditor.Bar.UpdateActionControls;
end;
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.OnDocWindowActivate(
fActivate: Integer): HResult;
begin
{ OnDocumentActivate/Deactivate }
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.OnFrameWindowActivate(
fActivate: Integer): HResult;
begin
{ OnFrameActivate/Deactivate (top-level) }
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.ResizeBorder(var prcBorder: Integer;
const pUIWindow: IInterface; fRameWindow: Integer): HResult;
begin
{ OnResizeFrame/Document }
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.ShowContextMenu(dwID: LongWord;
ppt: PPoint; const pcmdtReserved: IInterface;
const pdispReserved: IDispatch): HResult;
var
Element: IHTMLElement;
begin
if Assigned(FEditor.FOnShowContextMenu) then
begin
Supports(pdispReserved, IHTMLElement, Element);
FEditor.FOnShowContextMenu(FEditor, ppt^, Element);
end;
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.ShowHelp(hwnd: THandle;
pszHelpFile: PWideChar; uCommand: LongWord; dwData: LongWord;
ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HResult;
begin
{OnHelp}
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.ShowMessage(hwnd: THandle; lpstrText,
lpstrCaption: PWideChar; dwType: LongWord; lpstrHelpFile: PWideChar;
dwHelpContext: LongWord; var plResult: LongInt): HResult;
begin
{ OnShowMessage }
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.ShowUI(dwID: LongWord;
const pActiveObject, pCommandTarget, pFrame, pDoc: IInterface): HResult;
begin
if FEditor.Bar <> nil then
begin
FEditor.Bar.DisableUI(dwID = DOCHOSTUITYPE_BROWSE);
FEditor.Bar.SetCommandTarget(FEditor.CommandTarget);
FEditor.Bar.UpdateActionControls;
end;
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.TranslateAccelerator(lpmsg: PMsg;
pguidCmdGroup: PGUID; nCmdID: LongWord): HResult;
function IsCtrlDown: Boolean;
begin
Result := GetAsyncKeyState(VK_CONTROL) < 0;
end;
function IsShiftDown: Boolean;
begin
Result := GetAsyncKeyState(VK_SHIFT) < 0;
end;
begin
{ implement to handle key pressing }
Result := E_NOTIMPL;
{ Suppress some WebBrowser accelerators }
if ((lpmsg^.message = WM_KEYDOWN) or (lpmsg^.message = WM_KEYUP)) and
IsCtrlDown and (lpmsg^.wParam in [Ord('P'), Ord('N'), Ord('Y')]) then
Result := S_OK;
{ Override Undo/Redo accelerators }
if (lpmsg^.message = WM_KEYDOWN) and IsCtrlDown and
(lpmsg^.wParam = Ord('Z')) then
begin
Result := S_OK;
if IsShiftDown then
FEditor.UndoManager.Redo
else
begin
FEditor.UndoManager.Undo;
Result := S_FALSE;
//TODO
end;
end;
{ Move/Resize selected controls }
if (lpmsg^.message = WM_KEYDOWN) and
(FEditor.Selection.SelType = stControl) and
(lpmsg^.wParam in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT]) then
if IsCtrlDown then
begin
FEditor.StartMoveSelectionByKey(lpmsg^.wParam, IsShiftDown);
Result := S_OK;
end
else
if IsShiftDown then
begin
FEditor.StartResizeSelectionByKey(lpmsg^.wParam);
Result := S_OK;
end;
if (lpmsg^.message = WM_KEYUP) and
(FEditor.Selection.SelType = stControl) and
(lpmsg^.wParam in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT]) then
begin
FEditor.EndMoveSelectionByKey;
FEditor.EndResizeSelectionByKey;
Result := S_OK;
end;
end;
function TcxHTMLDocHostUIHandler.TranslateUrl(dwTranslate: LongWord;
const pchURLIn: PWideChar; out ppchURLOut: PWideChar): HResult;
var
NewURL: WideString;
begin
{ implement to modify the URL to be loaded }
ppchURLOut := nil;
if not SameText(pchURLIn, URLBlank) and not FEditor.BrowseMode then
begin
NewURL := URLBlank;
ppchURLOut := PWideChar(NewURL);
end;
Result := S_OK;
end;
function TcxHTMLDocHostUIHandler.UpdateUI: HResult;
begin
if FEditor.Bar <> nil then
FEditor.Bar.UpdateActionControls;
Result := S_OK;
end;
{ TcxHTMLOleCommandTarget }
constructor TcxHTMLOleCommandTarget.Create(AEditor: TcxHTMLEditor);
begin
inherited Create;
FEditor := AEditor;
end;
function TcxHTMLOleCommandTarget.Exec(CmdGroup: PGUID; nCmdID,
nCmdexecopt: DWORD; vaIn, vaOut: PVariantArg): HResult;
var
Command: string;
begin
Result := S_FALSE;
if IsEqualGUID(CmdGroup^, CGID_MSHTML) then
case nCmdID of
IDM_TABLESELECT:
begin
TableSelect;
Result := S_OK;
end;
IDM_ROWSELECT:
begin
RowSelect;
Result := S_OK;
end;
IDM_COLUMNSELECT:
begin
ColSelect;
Result := S_OK;
end;
IDM_CELLSELECT:
begin
CellSelect;
Result := S_OK;
end;
IDM_TABLEINSERT:
begin
TableInsert;
Result := S_OK;
end;
IDM_ROWINSERT:
begin
RowInsert;
Result := S_OK;
end;
IDM_ROWINSERTBELOW:
begin
RowInsert(True);
Result := S_OK;
end;
IDM_COLUMNINSERT:
begin
ColInsert;
Result := S_OK;
end;
IDM_COLUMNINSERTRIGHT:
begin
ColInsert(True);
Result := S_OK;
end;
IDM_CELLINSERT:
begin
CellInsert;
Result := S_OK;
end;
IDM_CELLMERGE:
begin
CellMerge;
Result := S_OK;
end;
IDM_CELLSPLIT:
begin
CellSplit;
Result := S_OK;
end;
IDM_TABLEDELETE:
begin
TableDelete;
Result := S_OK;
end;
IDM_ROWDELETE:
begin
RowDelete;
Result := S_OK;
end;
IDM_COLUMNDELETE:
begin
ColDelete;
Result := S_OK;
end;
IDM_CELLDELETE:
begin
CellDelete;
Result := S_OK;
end;
IDM_FRAMEINSLEFT:
begin
FrameInsert(fsLeft);
Result := S_OK;
end;
IDM_FRAMEINSRIGHT:
begin
FrameInsert(fsRight);
Result := S_OK;
end;
IDM_FRAMEINSTOP:
begin
FrameInsert(fsTop);
Result := S_OK;
end;
IDM_FRAMEINSBOTTOM:
begin
FrameInsert(fsBottom);
Result := S_OK;
end;
IDM_FRAMEDELETE:
begin
FrameDelete;
Result := S_OK;
end;
IDM_FRAMEINSERT:
begin
WholeFrameInsert;
Result := S_OK;
end;
IDM_UNDO:
begin
Command := BeforeUndoRedo(IDM_UNDO);
Result := GetWBCommandTarget.Exec(@CGID_MSHTML, IDM_UNDO, nCmdexecopt, vaIn, vaOut);
AfterUndoRedo(Command);
end;
IDM_REDO:
begin
Command := BeforeUndoRedo(IDM_REDO);
Result := GetWBCommandTarget.Exec(@CGID_MSHTML, IDM_REDO, nCmdexecopt, vaIn, vaOut);
AfterUndoRedo(Command);
end;
{ IDM_PASTE:
begin
FEditor.UndoManager.BeginUndoBlock('Paste');
Result := GetWBCommandTarget.Exec(CmdGroup, nCmdID, nCmdexecopt, vaIn, vaOut);
//FEditor.UndoManager.EndUndoBlock;
end; }
end;
if Result <> S_OK then
Result := GetWBCommandTarget.Exec(CmdGroup, nCmdID, nCmdexecopt, vaIn, vaOut);
end;
function TcxHTMLOleCommandTarget.QueryStatus(CmdGroup: PGUID;
cCmds: Cardinal; prgCmds: POleCmd; CmdText: POleCmdText): HResult;
procedure CmdSupported(AValue: Boolean);
begin
if AValue then
prgCmds^.cmdf := prgCmds^.cmdf or OLECMDF_SUPPORTED
else
prgCmds^.cmdf := prgCmds^.cmdf and not OLECMDF_SUPPORTED;
end;
procedure CmdEnabled(AValue: Boolean);
begin
if AValue then
prgCmds^.cmdf := prgCmds^.cmdf or OLECMDF_ENABLED
else
prgCmds^.cmdf := prgCmds^.cmdf and not OLECMDF_ENABLED;
end;
procedure CmdLatched(AValue: Boolean);
begin
if AValue then
prgCmds^.cmdf := prgCmds^.cmdf or OLECMDF_LATCHED
else
prgCmds^.cmdf := prgCmds^.cmdf and not OLECMDF_LATCHED;
end;
{var
Status: string;}
begin
Result := S_FALSE;
if (cCmds = 1) and IsEqualGUID(CmdGroup^, CGID_MSHTML) then
case prgCmds^.cmdID of
IDM_TABLESELECT:
begin
CmdSupported(True);
CmdEnabled(CanTableSelect);
Result := S_OK;
end;
IDM_ROWSELECT:
begin
CmdSupported(True);
CmdEnabled(CanRowSelect);
Result := S_OK;
end;
IDM_COLUMNSELECT:
begin
CmdSupported(True);
CmdEnabled(CanColSelect);
Result := S_OK;
end;
IDM_CELLSELECT:
begin
CmdSupported(True);
CmdEnabled(CanCellSelect);
Result := S_OK;
end;
IDM_TABLEINSERT:
begin
CmdSupported(True);
CmdEnabled(CanTableInsert);
Result := S_OK;
end;
IDM_ROWINSERT, IDM_ROWINSERTBELOW:
begin
CmdSupported(True);
CmdEnabled(CanRowInsert);
Result := S_OK;
end;
IDM_COLUMNINSERT, IDM_COLUMNINSERTRIGHT:
begin
CmdSupported(True);
CmdEnabled(CanColInsert);
Result := S_OK;
end;
IDM_CELLINSERT:
begin
CmdSupported(True);
CmdEnabled(CanCellInsert);
Result := S_OK;
end;
IDM_CELLMERGE:
begin
CmdSupported(True);
CmdEnabled(CanCellMerge);
Result := S_OK;
end;
IDM_CELLSPLIT:
begin
CmdSupported(True);
CmdEnabled(CanCellSplit);
Result := S_OK;
end;
IDM_TABLEDELETE:
begin
CmdSupported(True);
CmdEnabled(CanTableDelete);
Result := S_OK;
end;
IDM_ROWDELETE:
begin
CmdSupported(True);
CmdEnabled(CanRowDelete);
Result := S_OK;
end;
IDM_COLUMNDELETE:
begin
CmdSupported(True);
CmdEnabled(CanColDelete);
Result := S_OK;
end;
IDM_CELLDELETE:
begin
CmdSupported(True);
CmdEnabled(CanCellDelete);
Result := S_OK;
end;
IDM_FRAMEINSLEFT, IDM_FRAMEINSRIGHT, IDM_FRAMEINSTOP, IDM_FRAMEINSBOTTOM,
IDM_FRAMEDELETE:
begin
CmdSupported(True);
CmdEnabled(CanFrame);
Result := S_OK;
end;
IDM_FRAMEINSERT:
begin
CmdSupported(True);
CmdEnabled(CanWholeFrame);
Result := S_OK;
end;
IDM_UNDO:
if CmdText <> nil then
begin
//TODO
{ Result := GetWBCommandTarget.QueryStatus(CmdGroup, cCmds, prgCmds, nil);
if (prgCmds^.cmdf and OLECMDF_ENABLED) = OLECMDF_ENABLED then
Status := scxCmdUndo + ' ' + FEditor.UndoManager.UndoDesctiption
else
Status := scxCmdCantUndo;
CmdText^.cwActual := Length(Status);
StringToWideChar(Status, CmdText^.rgwz, CmdText^.cwBuf);
} Result := S_OK;
end;
IDM_REDO:
if CmdText <> nil then
begin
//TODO
{ Result := GetWBCommandTarget.QueryStatus(CmdGroup, cCmds, prgCmds, nil);
if (prgCmds^.cmdf and OLECMDF_ENABLED) = OLECMDF_ENABLED then
Status := scxCmdRedo + ' ' + FEditor.UndoManager.RedoDesctiption
else
Status := scxCmdCantRedo;
CmdText^.cwActual := Length(Status);
StringToWideChar(Status, CmdText^.rgwz, CmdText^.cwBuf);
}
Result := S_OK;
end;
IDM_UNLINK:
begin
Result := GetWBCommandTarget.QueryStatus(CmdGroup, cCmds, prgCmds, nil);
if IsViewLinkSelected then
CmdEnabled(False);
end;
end;
if Result <> S_OK then
Result := GetWBCommandTarget.QueryStatus(CmdGroup, cCmds, prgCmds, nil);
end;
function TcxHTMLOleCommandTarget.GetWBCommandTarget: IcxOleCommandTarget;
begin
FEditor.ControlInterface.QueryInterface(IcxOleCommandTarget, Result);
end;
function TcxHTMLOleCommandTarget.CanTableInsert: Boolean;
begin
Result := (FEditor.Selection.SelType <> stControl) and
(FEditor.Selection.Count = 1);
end;
function TcxHTMLOleCommandTarget.CanCellInsert: Boolean;
begin
Result := IsCellsSelected;
end;
function TcxHTMLOleCommandTarget.CanCellMerge: Boolean;
begin
Result := (FEditor.Selection.Count > 1) and IsCellsSelected;
end;
function TcxHTMLOleCommandTarget.CanCellSelect: Boolean;
begin
Result := False;
// TODO: implement
end;
function TcxHTMLOleCommandTarget.CanCellSplit: Boolean;
begin
Result := (FEditor.Selection.Count = 1) and IsCellsSelected;
end;
function TcxHTMLOleCommandTarget.CanTableDelete: Boolean;
var
I: Integer;
Table: IHTMLElement;
begin
Result := False;
if (FEditor.Selection.SelType = stControl) then
Result := (FEditor.Selection.Count = 1) and
Supports(FEditor.Selection[0], IHTMLTable)
else
if Supports(FindTableOf(FEditor.Selection[0]), IHTMLElement, Table) then
begin
Result := True;
for I := 1 to FEditor.Selection.Count - 1 do
begin
Result := IsEqualElement(Table, FindTableOf(FEditor.Selection[I]) as IHTMLElement);
if not Result then
break;
end;
end;
end;
function TcxHTMLOleCommandTarget.CanRowDelete: Boolean;
begin
Result := IsRowsSelected;
end;
function TcxHTMLOleCommandTarget.CanColDelete: Boolean;
begin
Result := IsCellsSelected;
end;
function TcxHTMLOleCommandTarget.CanCellDelete: Boolean;
begin
Result := IsCellsSelected;
end;
function TcxHTMLOleCommandTarget.CanColInsert: Boolean;
begin
Result := IsCellsSelected;
end;
function TcxHTMLOleCommandTarget.CanColSelect: Boolean;
begin
Result := False;
// TODO: implement
end;
function TcxHTMLOleCommandTarget.CanRowInsert: Boolean;
begin
Result := IsCellsSelected;
end;
function TcxHTMLOleCommandTarget.CanRowSelect: Boolean;
begin
Result := False;
// TODO: implement
end;
function TcxHTMLOleCommandTarget.CanTableSelect: Boolean;
begin
Result := False;
// TODO: implement
end;
procedure TcxHTMLOleCommandTarget.CellInsert;
var
Cell: IHTMLTableCell;
Row: IHTMLTableRow;
begin
if not CanCellInsert then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdCellInsert);
Cell := FindCellOf(FEditor.Selection[0]);
Row := (Cell as IHTMLElement).parentElement as IHTMLTableRow;
Row.insertCell(Cell.cellIndex);
FEditor.UndoManager.EndUndoBlock;
end;
procedure TcxHTMLOleCommandTarget.CellMerge;
var
I: Integer;
Elements: IInterfaceList;
FirstCell, CurCell: IHTMLTableCell;
begin
if not CanCellMerge then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdCellMerge);
Elements := TInterfaceList.Create;
for I := 0 to FEditor.Selection.Count - 1 do
Elements.Add(FEditor.Selection[I]);
FirstCell := nil;
for I := 0 to Elements.Count - 1 do
begin
CurCell := FindCellOf(Elements[I] as IHTMLElement);
if CurCell <> nil then
if FirstCell <> nil then
begin
FirstCell.colSpan := FirstCell.colSpan + CurCell.colSpan;
(FirstCell as IHTMLElement).innerHTML := (FirstCell as IHTMLElement).innerHTML +
(CurCell as IHTMLElement).innerHTML;
(CurCell as IHTMLDOMNode).removeNode(True);
end
else
FirstCell := CurCell;
end;
FEditor.DoSelectionChanged;
FEditor.UndoManager.EndUndoBlock;
end;
procedure TcxHTMLOleCommandTarget.CellSelect;
begin
if not CanCellSelect then Exit;
// TODO: implement
end;
procedure TcxHTMLOleCommandTarget.CellSplit;
var
Cell: IHTMLTableCell;
Row: IHTMLTableRow;
Table: IHTMLTable;
I, RowIndex, CellIndex: Integer;
begin
if not CanCellSplit then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdCellSplit);
Cell := FindCellOf(FEditor.Selection[0]);
Row := (Cell as IHTMLElement).parentElement as IHTMLTableRow;
CellIndex := GetCellAbsIndex(Row, Cell.cellIndex);
RowIndex := Row.rowIndex;
Table := FindTableOf(Cell as IHTMLElement);
Row.insertCell(Cell.cellIndex + 1);
if Cell.colSpan > 1 then
UpdateCellColSpan(Cell, -1)
else
if Table <> nil then
for I := 0 to Table.rows.length - 1 do
begin
Row := Table.rows.item(I, 0) as IHTMLTableRow;
if Row.rowIndex <> RowIndex then
UpdateCellColSpan(GetCellByAbsIndex(Row, CellIndex), 1)
end;
FEditor.UndoManager.EndUndoBlock;
end;
procedure TcxHTMLOleCommandTarget.CellDelete;
var
I: Integer;
Elements: IInterfaceList;
CellNode: IHTMLDOMNode;
Caret: IHTMLCaret;
begin
if not CanCellDelete then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdCellDelete);
Elements := TInterfaceList.Create;
for I := 0 to FEditor.Selection.Count - 1 do
Elements.Add(FEditor.Selection[I]);
for I := Elements.Count - 1 downto 0 do
begin
CellNode := FindCellOf(Elements[I] as IHTMLElement) as IHTMLDOMNode;
if CellNode <> nil then
CellNode.removeNode(True);
end;
FEditor.Selection.Empty;
Caret := FEditor.Selection.GetCaret;
if Caret <> nil then
Caret.Hide;
FEditor.UndoManager.EndUndoBlock;
end;
procedure TcxHTMLOleCommandTarget.ColInsert(ToRight: Boolean = False);
var
NewCell, Cell: IHTMLTableCell;
Row: IHTMLTableRow;
Table: IHTMLTable;
I, CellIndex: Integer;
Element: IHTMLElement;
Element2: IHTMLElement2;
begin
if not CanColInsert then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdColInsert);
Cell := FindCellOf(FEditor.Selection[0]);
Row := (Cell as IHTMLElement).parentElement as IHTMLTableRow;
Table := FindTableOf(Row as IHTMLElement);
CellIndex := GetCellAbsIndex(Row, Cell.cellIndex);
if ToRight then
Inc(CellIndex, Cell.colSpan);
if (Cell.cellIndex = Row.cells.length - 1) and ToRight then
for I := 0 to Table.rows.length - 1 do
begin
Row := Table.rows.item(I, 0) as IHTMLTableRow;
Element := Row.cells.item(Row.cells.length - 1, 0) as IHTMLElement;
Cell := Row.insertCell(-1) as IHTMLTableCell;
// merge cell attributes
Element2 := Cell as IHTMLElement2;
Element2.mergeAttributes(Element);
// remove colspan
Element := Element2 as IHTMLElement;
Element.removeAttribute('colspan', 0);
end
else
for I := 0 to Table.rows.length - 1 do
begin
Row := Table.rows.item(I, 0) as IHTMLTableRow;
Cell := GetCellByAbsIndex(Row, CellIndex);
if GetCellAbsIndex(Row, Cell.cellIndex) = CellIndex then
begin
NewCell := Row.insertCell(Cell.cellIndex) as IHTMLTableCell;
// merge cell attributes
if ToRight then
Element := Row.cells.item(NewCell.cellIndex - 1, 0) as IHTMLElement
else
Element := Row.cells.item(NewCell.cellIndex + 1, 0) as IHTMLElement;
Element2 := NewCell as IHTMLElement2;
Element2.mergeAttributes(Element);
// remove colspan
Element := Element2 as IHTMLElement;
Element.removeAttribute('colspan', 0);
end
else
UpdateCellColSpan(Cell, 1);
end;
FEditor.UndoManager.EndUndoBlock;
//TODO: maintein rowspan
end;
procedure TcxHTMLOleCommandTarget.ColSelect;
begin
if not CanColSelect then Exit;
// TODO: implement
end;
procedure TcxHTMLOleCommandTarget.ColDelete;
var
Elements: IInterfaceList;
Caret: IHTMLCaret;
Cell, NextCell: IHTMLTableCell;
Row: IHTMLTableRow;
Table: IHTMLTable;
I, J, C, CellIndex, CellColSpan: Integer;
begin
if not CanColDelete then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdColDelete);
Elements := TInterfaceList.Create;
for I := 0 to FEditor.Selection.Count - 1 do
Elements.Add(FEditor.Selection[I]);
for I := Elements.Count - 1 downto 0 do
begin
Cell := FindCellOf(Elements[I] as IHTMLElement);
Row := (Cell as IHTMLElement).parentElement as IHTMLTableRow;
Table := FindTableOf(Row as IHTMLElement);
CellIndex := GetCellAbsIndex(Row, Cell.cellIndex);
CellColSpan := Cell.colSpan;
for J := 0 to Table.rows.length - 1 do
begin
Row := Table.rows.item(J, 0) as IHTMLTableRow;
Cell := GetCellByAbsIndex(Row, CellIndex);
if Cell <> nil then
if Cell.colSpan > CellColSpan then
UpdateCellColSpan(Cell, -CellColSpan)
else
begin
C := 0;
while (C < CellColSpan) and (Cell <> nil) do
begin
NextCell := (Cell as IHTMLDOMNode).nextSibling as IHTMLTableCell;
Inc(C, Cell.colSpan);
(Cell as IHTMLDOMNode).removeNode(True);
Cell := NextCell;
end;
end;
end;
end;
FEditor.Selection.Empty;
Caret := FEditor.Selection.GetCaret;
if Caret <> nil then
Caret.Hide;
FEditor.UndoManager.EndUndoBlock;
end;
procedure TcxHTMLOleCommandTarget.RowInsert(Below: Boolean = False);
var
NewRow, Row: IHTMLTableRow;
Table: IHTMLTable;
RowIndex, I: Integer;
Element: IHTMLElement;
Element2: IHTMLElement2;
begin
if not CanRowInsert then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdRowInsert);
Row := (FindCellOf(FEditor.Selection[0]) as IHTMLElement).parentElement as IHTMLTableRow;
Table := FindTableOf(Row as IHTMLElement);
RowIndex := Row.rowIndex;
if Below then
Inc(RowIndex);
NewRow := Table.insertRow(RowIndex) as IHTMLTableRow;
for I := 0 to Row.cells.length - 1 do
NewRow.insertCell(-1);
// merge row attributes
Element := Row as IHTMLElement;
Element2 := NewRow as IHTMLElement2;
Element2.mergeAttributes(Element);
// merge cell attributes
for I := 0 to Row.cells.length - 1 do
begin
Element := Row.cells.item(I, 0) as IHTMLElement;
Element2 := NewRow.cells.item(I, 0) as IHTMLElement2;
Element2.mergeAttributes(Element);
// remove colspan
Element := Element2 as IHTMLElement;
Element.removeAttribute('rowspan', 0);
end;
FEditor.UndoManager.EndUndoBlock;
end;
procedure TcxHTMLOleCommandTarget.RowSelect;
begin
if not CanRowSelect then Exit;
// TODO: implement
end;
procedure TcxHTMLOleCommandTarget.RowDelete;
var
I: Integer;
Caret: IHTMLCaret;
Elements: IInterfaceList;
RowNode: IHTMLDOMNode;
begin
if not CanRowDelete then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdRowDelete);
Elements := TInterfaceList.Create;
for I := 0 to FEditor.Selection.Count - 1 do
Elements.Add(FEditor.Selection[I]);
for I := Elements.Count - 1 downto 0 do
begin
RowNode := FindRowOf(Elements[I] as IHTMLElement) as IHTMLDOMNode;
if RowNode <> nil then
RowNode.removeNode(True);
end;
FEditor.Selection.Empty;
Caret := FEditor.Selection.GetCaret;
if Caret <> nil then
Caret.Hide;
FEditor.UndoManager.EndUndoBlock;
end;
procedure TcxHTMLOleCommandTarget.TableInsert;
begin
// TODO: implement
end;
procedure TcxHTMLOleCommandTarget.TableSelect;
begin
if not CanTableSelect then Exit;
// TODO: implement
end;
procedure TcxHTMLOleCommandTarget.TableDelete;
var
Table: IHTMLTable;
Caret: IHTMLCaret;
begin
if not CanTableDelete then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdTableDelete);
Table := FindTableOf(FEditor.Selection[0]);
if Table <> nil then
(Table as IHTMLDOMNode).removeNode(True);
Caret := FEditor.Selection.GetCaret;
if Caret <> nil then
Caret.Hide;
FEditor.UndoManager.EndUndoBlock;
end;
function TcxHTMLOleCommandTarget.CanFrame: Boolean;
begin
Result := IsFrameSelected;
end;
function TcxHTMLOleCommandTarget.CanWholeFrame: Boolean;
begin
Result := Supports(FEditor.Document.activeElement, IHTMLFrameSetElement) and
(FEditor.Document.frames.length = 0);
end;
procedure TcxHTMLOleCommandTarget.FrameDelete;
function RemoveAsterix(S: string; AIndex: Integer): string;
begin
with TStringList.Create do
try
Delimiter := ',';
DelimitedText := S;
if AIndex < Count then
Delete(AIndex);
Result := DelimitedText;
finally
Free;
end;
end;
procedure RemoveFrame(AFrame: IHTMLElement);
var
FrameSet: IHTMLFrameSetElement;
FrameSetElement: IHTMLElement;
Frames: IHTMLElementCollection;
Node: IHTMLDOMNode;
Index: Integer;
begin
Node := AFrame as IHTMLDOMNode;
FrameSet := FindParentFrameset(AFrame);
FrameSetElement := FrameSet as IHTMLElement;
if FrameSet <> nil then
begin
Index := GetFrameIndex(FrameSetElement, AFrame);
if Index <> -1 then
begin
if FrameSet.cols <> '' then
FrameSet.cols := RemoveAsterix(FrameSet.cols, Index)
else
FrameSet.rows := RemoveAsterix(FrameSet.rows, Index);
Node.parentNode.removeChild(Node);
Frames := FrameSetElement.children as IHTMLElementCollection;
if (Frames.length = 1) and
(FindParentFrameset(FrameSetElement) <> nil) then
begin
Node := Frames.item(0, 0) as IHTMLDOMNode;
if Supports(Frames.item(0, 0), IHTMLFrameBase) then
(FrameSetElement as IHTMLDomNode).replaceNode(Node);
end;
if Frames.length = 0 then
RemoveFrame(FrameSetElement);
end;
end;
end;
var
ActiveFrame: IHTMLFrameBase;
begin
if not CanFrame then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdFrameDelete);
ActiveFrame := FEditor.Selection.GetActiveFrame;
RemoveFrame(ActiveFrame as IHTMLElement);
FEditor.UndoManager.EndUndoBlock;
end;
procedure TcxHTMLOleCommandTarget.WholeFrameInsert;
var
FrameSet: IHTMLFrameSetElement;
Node, NewNode: IHTMLDOMNode;
begin
if not CanWholeFrame then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdFrameInsert);
FrameSet := FEditor.Document.ActiveElement as IHTMLFrameSetElement;
Node := FrameSet as IHTMLDOMNode;
NewNode := FEditor.Document.createElement('frame') as IHTMLDOMNode;
Node.appendChild(NewNode);
FrameSet.cols := '*';
(NewNode as IHTMLElement3).setActive;
FEditor.UndoManager.EndUndoBlock;
end;
procedure TcxHTMLOleCommandTarget.FrameInsert(ASide: TcxHTMLFrameSide);
function InsertAsterix(S: string; AIndex: Integer): string;
begin
with TStringList.Create do
try
Delimiter := ',';
DelimitedText := S;
Insert(AIndex, '*');
Result := DelimitedText;
finally
Free;
end;
end;
function CreateFrameSet(var AReplaceNode: IHTMLDOMNode):
IHTMLFrameSetElement;
var
FrameSetNode: IHTMLDOMNode;
begin
Result := FEditor.Document.createElement('frameset') as IHTMLFrameSetElement;
FrameSetNode := Result as IHTMLDOMNode;
AReplaceNode.swapNode(FrameSetNode);
AReplaceNode := FrameSetNode.appendChild(AReplaceNode);
end;
var
ActiveFrame: IHTMLFrameBase;
FrameSet: IHTMLFrameSetElement;
ActiveNode, NewNode: IHTMLDOMNode;
Index: Integer;
begin
if not CanFrame then Exit;
FEditor.UndoManager.BeginUndoBlock(scxCmdFrameInsert);
ActiveFrame := FEditor.Selection.GetActiveFrame;
ActiveNode := ActiveFrame as IHTMLDOMNode;
FrameSet := FindParentFrameset(ActiveFrame as IHTMLElement);
Index := GetFrameIndex(FrameSet as IHTMLElement, ActiveFrame as IHTMLElement);
NewNode := FEditor.Document.createElement('frame') as IHTMLDOMNode;
if ASide in [fsTop, fsBottom] then
// horizontal
begin
if FrameSet.rows = '' then
begin
FrameSet := CreateFrameSet(ActiveNode);
Index := 0;
FrameSet.rows := InsertAsterix(FrameSet.rows, Index);
end;
if ASide = fsBottom then
Inc(Index);
FrameSet.rows := InsertAsterix(FrameSet.rows, Index);
end
else
// vertical
begin
if FrameSet.cols = '' then
begin
FrameSet := CreateFrameSet(ActiveNode);
Index := 0;
FrameSet.cols := InsertAsterix(FrameSet.cols, Index);
end;
if ASide = fsRight then
Inc(Index);
FrameSet.cols := InsertAsterix(FrameSet.cols, Index);
end;
ActiveFrame := ActiveNode.parentNode.insertBefore(NewNode, ActiveNode) as IHTMLFrameBase;
if ASide in [fsRight, fsBottom] then
ActiveNode.swapNode(NewNode);
(ActiveFrame as IHTMLElement3).setActive;
FEditor.UndoManager.EndUndoBlock;
end;
function TcxHTMLOleCommandTarget.BeforeUndoRedo(ACmdID: Cardinal): string;
const
BuffLen = 255;
var
Cmd: TOleCmd;
Text: POleCmdText;
begin
Result := '';
Cmd.cmdID := ACmdID;
Cmd.cmdf := 0;
GetMem(Text, SizeOf(TOleCmdText) + BuffLen * SizeOf(WideChar));
try
Text^.cmdtextf := OLECMDTEXTF_STATUS;
Text^.cwBuf := BuffLen;
Text^.cwActual := 0;
if (QueryStatus(@CGID_MSHTML, 1, @Cmd, Text) = S_OK) and
(Text^.cwActual > 0) then
Result := WideCharToString(Text^.rgwz);
finally
FreeMem(Text);
end;
end;
procedure TcxHTMLOleCommandTarget.AfterUndoRedo(const ACommand: string);
begin
{ if (Pos(scxCmdResize, ACommand) <> 0) and Assigned(FEditor.FOnResized) then
FEditor.FOnResized(FEditor);
if Pos(scxCmdMove, ACommand) <> 0 then
FEditor.DoOnMoveEnd(nil); }
end;
function TcxHTMLOleCommandTarget.IsCellsSelected: Boolean;
var
I: Integer;
begin
Result := (FEditor.Selection.SelType <> stControl) and
(FEditor.Selection.Count > 0);
if Result then
for I := 0 to FEditor.Selection.Count - 1 do
Result := Result and (FindCellOf(FEditor.Selection[I]) <> nil);
end;
function TcxHTMLOleCommandTarget.IsRowsSelected: Boolean;
var
I: Integer;
begin
Result := (FEditor.Selection.SelType <> stControl) and
(FEditor.Selection.Count > 0);
if Result then
for I := 0 to FEditor.Selection.Count - 1 do
Result := Result and (FindRowOf(FEditor.Selection[I]) <> nil);
end;
function TcxHTMLOleCommandTarget.IsViewLinkSelected: Boolean;
var
I: Integer;
begin
Result := False;
for I := 0 to FEditor.Selection.Count - 1 do
begin
Result := FEditor.HasElementViewLink(FEditor.Selection[I]);
if Result then break;
end;
end;
function TcxHTMLOleCommandTarget.IsFrameSelected: Boolean;
begin
Result := FEditor.Selection.GetActiveFrame <> nil;
end;
function TcxHTMLOleCommandTarget.FindParentFrameset(const AElement: IHTMLElement): IHTMLFrameSetElement;
var
FrameSetElement: IHTMLElement;
begin
FrameSetElement := AElement.parentElement;
while (FrameSetElement <> nil) and not Supports(FrameSetElement, IHTMLFrameSetElement) do
FrameSetElement := FrameSetElement.parentElement;
Supports(FrameSetElement, IHTMLFrameSetElement, Result);
end;
function TcxHTMLOleCommandTarget.GetFrameIndex(AFrameSet, AFrame: IHTMLElement): Integer;
var
Frames: IHTMLElementCollection;
I, Cnt: Integer;
begin
Result := -1;
Cnt := -1;
Frames := AFrameSet.children as IHTMLElementCollection;
for I := 0 to Frames.length - 1 do
if Supports(Frames.item(I, 0), IHTMLFrameElement) or
Supports(Frames.item(I, 0), IHTMLFrameSetElement) then
begin
Inc(Cnt);
if (Frames.item(I, 0) as IHTMLElement).sourceIndex = AFrame.sourceIndex then
begin
Result := Cnt;
break;
end;
end;
end;
function TcxHTMLOleCommandTarget.FindCellOf(AElement: IHTMLElement): IHTMLTableCell;
var
CellElement: IHTMLElement;
begin
CellElement := AElement;
while (CellElement <> nil) and not Supports(CellElement, IHTMLTableCell) do
CellElement := CellElement.parentElement;
Supports(CellElement, IHTMLTableCell, Result);
end;
function TcxHTMLOleCommandTarget.FindRowOf(AElement: IHTMLElement): IHTMLTableRow;
var
RowElement: IHTMLElement;
begin
RowElement := AElement;
while (RowElement <> nil) and not Supports(RowElement, IHTMLTableRow) do
RowElement := RowElement.parentElement;
Supports(RowElement, IHTMLTableRow, Result);
end;
function TcxHTMLOleCommandTarget.FindTableOf(AElement: IHTMLElement): IHTMLTable;
var
TableElement: IHTMLElement;
begin
TableElement := AElement;
while (TableElement <> nil) and not Supports(TableElement, IHTMLTable) do
TableElement := TableElement.parentElement;
Supports(TableElement, IHTMLTable, Result);
end;
function TcxHTMLOleCommandTarget.GetCellAbsIndex(ARow: IHTMLTableRow; AIndex: Integer): Integer;
var
I: Integer;
Cell: IHTMLTableCell;
begin
Result := -1;
for I := 0 to ARow.cells.length - 1 do
begin
Cell := ARow.cells.item(I, 0) as IHTMLTableCell;
if Cell.cellIndex = AIndex then
begin
Inc(Result);
break;
end
else
Inc(Result, Cell.colSpan);
end;
end;
function TcxHTMLOleCommandTarget.GetCellByAbsIndex(ARow: IHTMLTableRow; AIndex: Integer): IHTMLTableCell;
var
I, AbsIndex: Integer;
begin
Result := nil;
AbsIndex := -1;
for I := 0 to ARow.cells.length - 1 do
begin
Result := ARow.cells.item(I, 0) as IHTMLTableCell;
Inc(AbsIndex, Result.colSpan);
if AbsIndex >= AIndex then
break;
end;
end;
procedure TcxHTMLOleCommandTarget.UpdateCellColSpan(ACell: IHTMLTableCell; N: Integer);
begin
if ACell <> nil then
ACell.colSpan := ACell.colSpan + N;
end;
{ TcxHTMLSelection }
constructor TcxHTMLSelection.Create(AEditor: TcxHTMLEditor);
begin
inherited Create;
FEditor := AEditor;
end;
function TcxHTMLSelection.CanClear: Boolean;
begin
Result := CanCommand(IDM_CLEARSELECTION);
end;
function TcxHTMLSelection.CanCopy: Boolean;
begin
Result := CanCommand(IDM_COPY);
end;
function TcxHTMLSelection.CanCut: Boolean;
begin
Result := CanCommand(IDM_CUT);
end;
function TcxHTMLSelection.CanDelete: Boolean;
begin
Result := CanCommand(IDM_DELETE);
end;
function TcxHTMLSelection.CanPaste: Boolean;
begin
Result := CanCommand(IDM_PASTE);
end;
function TcxHTMLSelection.CanSelectAll: Boolean;
begin
Result := CanCommand(IDM_SELECTALL);
end;
procedure TcxHTMLSelection.Clear;
begin
ExeCommand(IDM_CLEARSELECTION);
end;
procedure TcxHTMLSelection.Copy;
begin
ExeCommand(IDM_COPY);
end;
procedure TcxHTMLSelection.Cut;
begin
ExeCommand(IDM_CUT);
end;
procedure TcxHTMLSelection.Delete;
begin
ExeCommand(IDM_DELETE);
end;
procedure TcxHTMLSelection.Empty;
begin
if SelType <> stNone then
GetSelectionObject.empty;
end;
function TcxHTMLSelection.IndexOf(AControl: IHTMLElement): Integer;
var
I: Integer;
begin
Result := -1;
if AControl = nil then Exit;
for I := 0 to Count - 1 do
if (Controls[I] <> nil) and (Controls[I].sourceIndex = AControl.sourceIndex) then
begin
Result := I;
break;
end;
end;
function TcxHTMLSelection.Last: IHTMLElement;
var
CountLoc: Integer;
begin
CountLoc := GetCount;
if CountLoc > 0 then
Result := GetControl(CountLoc - 1)
else
Result := nil;
end;
procedure TcxHTMLSelection.Paste;
begin
ExeCommand(IDM_PASTE);
end;
procedure TcxHTMLSelection.Remove(AControl: IHTMLElement);
var
Index: Integer;
Range: IHTMLControlRange;
begin
Index := IndexOf(AControl);
if Index <> -1 then
begin
Range := ControlRange;
if Range <> nil then
try
Range.remove(Index);
Range.select;
except
end;
end;
end;
procedure TcxHTMLSelection.SelectAll;
begin
ExeCommand(IDM_SELECTALL);
end;
function TcxHTMLSelection.CanCommand(const ACmdID: OLECMDID): Boolean;
begin
Result := FEditor <> nil;
if Result then
Result := (FEditor.QueryStatus(ACmdID) and OLECMDF_ENABLED) = OLECMDF_ENABLED;
end;
procedure TcxHTMLSelection.ExeCommand(const ACmdID: OLECMDID);
begin
if FEditor = nil then Exit;
FEditor.ExecCommand(ACmdID, OLECMDEXECOPT_DONTPROMPTUSER);
end;
function TcxHTMLSelection.GetAbsolutePosition: Boolean;
begin
Result := CanCommand(IDM_2D_ELEMENT);
if Result then
Result := FEditor.ExecCommand(IDM_2D_ELEMENT, OLECMDEXECOPT_DONTPROMPTUSER);
end;
procedure TcxHTMLSelection.SetAbsolutePosition(const Value: Boolean);
begin
if CanCommand(IDM_ABSOLUTE_POSITION) then
FEditor.ExecCommand(IDM_ABSOLUTE_POSITION, OLECMDEXECOPT_DONTPROMPTUSER, Value);
end;
function TcxHTMLSelection.GetCaret: IHTMLCaret;
begin
Result := nil;
if FEditor.DisplayServices <> nil then
FEditor.DisplayServices.GetCaret(Result);
end;
function TcxHTMLSelection.GetControl(Index: Integer): IHTMLElement;
var
EList: TInterfaceList;
begin
Result := nil;
if Supports(GetActiveFrame, IHTMLElement, Result) then
Exit;
if ControlRange <> nil then
Result := ControlRange.item(Index);
if (Result = nil) and (TextRange <> nil) then
begin
EList := TInterfaceList.Create;
try
if GetElementsFromTextRange(EList) > 0 then
Result := EList.Items[Index] as IHTMLElement;
finally
EList.Free;
end;
end;
if Result = nil then
Result := GetElementFromCaret;
if not FEditor.CanElementSelect(Result) then
Result := nil;
end;
function TcxHTMLSelection.GetCount: Integer;
begin
Result := 0;
if GetActiveFrame <> nil then
Result := 1
else
if ControlRange <> nil then
Result := ControlRange.length
else
if TextRange <> nil then
Result := GetElementsFromTextRange(nil)
else
if GetElementFromCaret <> nil then
Result := 1;
end;
function TcxHTMLSelection.GetElementFromCaret: IHTMLElement;
var
Caret: IHTMLCaret;
CaretPos: TPoint;
Visible: Integer;
begin
Result := nil;
Caret := GetCaret;
if Caret <> nil then
begin
Caret.IsVisible(Visible);
if Visible = Ord(True) then
begin
Caret.GetLocation(@CaretPos, 1);
Result := FEditor.Document.elementFromPoint(CaretPos.X, CaretPos.Y);
end;
end;
end;
function TcxHTMLSelection.GetElementsFromTextRange(AElements: TInterfaceList): Integer;
var
BP, EP: IMarkupPointer;
StartElement, EndElement, Element: IHTMLElement;
I: Integer;
Elements: IHTMLElementCollection;
InsideRange: Boolean;
begin
Result := 0;
if AElements <> nil then
AElements.Clear;
if TextRange = nil then Exit;
with FEditor.MarkupServices do
begin
CreateMarkupPointer(BP);
CreateMarkupPointer(EP);
MovePointersToRange(TextRange, BP, EP);
end;
if BP <> nil then
BP.CurrentScope(StartElement)
else
StartElement := nil;
if EP <> nil then
EP.CurrentScope(EndElement)
else
EndElement := nil;
if (StartElement = nil) and (EndElement = nil) then
Exit;
if (StartElement <> nil) and (EndElement = nil) then
begin
if AElements <> nil then
AElements.Add(StartElement);
Result := 1;
Exit;
end;
if (EndElement <> nil) and (StartElement = nil) then
begin
if AElements <> nil then
AElements.Add(EndElement);
Result := 1;
Exit;
end;
if IsEqualElement(StartElement, EndElement) then
begin
if AElements <> nil then
AElements.Add(StartElement);
Result := 1;
Exit;
end;
Elements := TextRange.parentElement.children as IHTMLElementCollection;
InsideRange := False;
for I := 0 to Elements.length - 1 do
begin
Element := Elements.item(I, 0) as IHTMLElement;
if not InsideRange then
InsideRange := IsEqualElement(Element, StartElement) or
Element.contains(StartElement);
if InsideRange then
begin
if AElements <> nil then
AElements.Add(Element);
Inc(Result);
if IsEqualElement(Element, EndElement) or
Element.contains(EndElement) then
break;
end;
end;
end;
function TcxHTMLSelection.GetSelType: TcxHTMLSelectionType;
var
SelObj: IHTMLSelectionObject;
TypeAsStr: string;
begin
Result := stNone;
SelObj := GetSelectionObject;
if SelObj = nil then Exit;
TypeAsStr := SelObj.type_;
if SameText(TypeAsStr, 'control') then
Result := stControl
else
if SameText(TypeAsStr, 'text') then
Result := stText;
end;
function TcxHTMLSelection.GetSelectionObject: IHTMLSelectionObject;
begin
if FEditor.Document <> nil then
Result := FEditor.Document.selection
else
Result := nil;
end;
function TcxHTMLSelection.GetControlRange: IHTMLControlRange;
begin
Result := nil;
if SelType = stControl then
Supports(GetSelectionObject.createRange, IHTMLControlRange, Result);
end;
function TcxHTMLSelection.GetTextRange: IHTMLTxtRange;
begin
Result := nil;
if SelType = stText then
Supports(GetSelectionObject.createRange, IHTMLTxtRange, Result);
end;
procedure TcxHTMLSelection.Add(AControl: IHTMLElement);
var
Range: IHTMLControlRange;
begin
Range := ControlRange;
if Range = nil then
begin
Empty;
Range := CreateControlRange;
end;
if FEditor.CanElementSelect(AControl) then
begin
try // Temporary solution for "invalid argument"
(Range as IHTMLControlRange2).addElement(AControl);
Range.select;
except
end;
end;
end;
function TcxHTMLSelection.CreateControlRange: IHTMLControlRange;
begin
Result := (FEditor.BodyElement as IHTMLElement2).createControlRange as
IHTMLControlRange;
end;
function TcxHTMLSelection.GetActiveFrame: IHTMLFrameBase;
var
FrameElement: IHTMLelement;
begin
FrameElement := FEditor.Document.activeElement;
while (FrameElement <> nil) and not Supports(FrameElement, IHTMLFrameBase) do
FrameElement := FrameElement.parentElement;
Supports(FrameElement, IHTMLFrameBase, Result);
end;
{ TcxHTMLEditor }
{ TcxHTMLEditor public }
constructor TcxHTMLEditor.Create(AOwner: TComponent; ABrowseMode: Boolean = False);
begin
inherited Create(AOwner);
FInternalBrowseMode := ABrowseMode;
FModified := False;
FPrimaryMCId := 0;
FBaseURL := '';
FNamespaces := TInterfaceList.Create;
FDocEventSink := TcxHTMLDocEventSink.Create(nil);
FDocEventSinkIntf := FDocEventSink;
FHostUIHandler := TcxHTMLDocHostUIHandler.Create(Self);
FCommandTarget := TcxHTMLOleCommandTarget.Create(Self) as IcxOleCommandTarget;
FSelection := TcxHTMLSelection.Create(Self);
FUndoManager := TcxHTMLUndoManager.Create(Self);
NewDocument;
Wait;
BrowseMode := ABrowseMode;
end;
destructor TcxHTMLEditor.Destroy;
begin
UnlinkChangeSink;
FDocEventSinkIntf.Disconnect;
inherited;
FUndoManager.Free;
FSelection.Free;
FHostUIHandler.Free;
end;
function TcxHTMLEditor.ExecCommand(const ACmdID: OLECMDID;
ACmdExecOpt: OLECMDEXECOPT): OleVariant;
begin
VarClear(Result);
CommandTarget.Exec(@CGID_MSHTML, ACmdID, ACmdExecOpt, nil, @Result);
end;
function TcxHTMLEditor.ExecCommand(const ACmdID: OLECMDID;
ACmdExecOpt: OLECMDEXECOPT; AInVar: OleVariant): OleVariant;
begin
VarClear(Result);
CommandTarget.Exec(@CGID_MSHTML, ACmdID, ACmdExecOpt, @AInVar, @Result);
end;
function TcxHTMLEditor.QueryStatus(const ACmdID: OLECMDID): OLECMDF;
var
Cmd: TOleCmd;
begin
Cmd.cmdID := ACmdID;
Cmd.cmdf := 0;
CommandTarget.QueryStatus(@CGID_MSHTML, 1, @Cmd, nil);
Result := Cmd.cmdf;
end;
procedure TcxHTMLEditor.LoadDocumentFromStream(const AStream: TStream);
var
OleStream: IStream;
PersistStream: IPersistStreamInit;
begin
if Busy then
ControlInterface.Stop;
if Supports(ControlInterface.Document, IPersistStreamInit, PersistStream) then
begin
OleCheck(PersistStream.InitNew);
OleStream := TStreamAdapter.Create(AStream);
OleCheck(PersistStream.Load(OleStream));
Modified := False;
FBaseURL := '';
end;
end;
procedure TcxHTMLEditor.NewDocument;
var
NavFlags: OleVariant;
PersistStream: IPersistStreamInit;
begin
NavFlags := navNoHistory or navNoReadFromCache or navNoWriteToCache;
ControlInterface.Stop;
ControlInterface.Navigate(URLBlank, NavFlags, EmptyParam, EmptyParam, EmptyParam);
if Supports(ControlInterface.Document, IPersistStreamInit, PersistStream) then
OleCheck(PersistStream.InitNew);
Modified := False;
FBaseURL := '';
end;
procedure TcxHTMLEditor.SaveDocumentToStream(const AStream: TStream);
var
OleStream: IStream;
PersistStream: IPersistStreamInit;
begin
Wait;
if Supports(ControlInterface.Document, IPersistStreamInit, PersistStream) then
begin
// OleCheck(PersistStream.InitNew);
OleStream := TStreamAdapter.Create(AStream);
OleCheck(PersistStream.Save(OleStream, True));
Modified := False;
end;
end;
procedure TcxHTMLEditor.RegisterTags(const ANamespace: string; ATags: array of string);
var
Namespace: IcxHTMLNamespace;
VFactory: OleVariant;
SP: IServiceProvider;
NST: IElementNamespaceTable;
begin
Namespace := FindNamespace(ANamespace);
if Namespace = nil then
Namespace := AddNamespace(ANamespace);
Namespace.AddTags(ATags);
TVarData(VFactory).VType := VT_UNKNOWN;
TVarData(VFactory).VUnknown := Pointer(Namespace as IElementNamespaceFactory);
Namespace._AddRef;
if Supports(Document, IServiceProvider, SP) and
(SP.QueryService(IElementNamespaceTable, IElementNamespaceTable, NST) = S_OK) then
begin
NST.AddNamespace(ANamespace, '', ELEMENTNAMESPACEFLAGS_QUERYFORUNKNOWNTAGS, VFactory); {Creates a normal namespace}
end;
end;
function TcxHTMLEditor.HasElementViewLink(AElement: IHTMLElement): Boolean;
begin
Result := FindElementBehavior(AElement) <> nil;
end;
procedure TcxHTMLEditor.UpdateViewLinkContent(AElement: IHTMLElement);
var
Behavior: IcxHTMLBehaviorViewLink;
begin
Behavior := FindElementBehavior(AElement);
if Behavior <> nil then
Behavior.UpdateContent;
end;
procedure TcxHTMLEditor.Wait;
begin
while Busy do
ProcessMessages;
end;
{ TcxHTMLEditor protected }
procedure TcxHTMLEditor.CreateControl;
procedure DoCreate;
begin
FIntf := IUnknown(OleObject) as IWebBrowser2;
end;
begin
if FIntf = nil then DoCreate;
end;
{$WRITEABLECONST ON}
procedure TcxHTMLEditor.InitControlData;
const
CEventDispIDs: array [0..2] of DWORD =
(DISPID_DOCUMENTCOMPLETE, DISPID_BEFORENAVIGATE2, DISPID_NEWWINDOW2);
CControlData: TControlData2 = (
ClassID: '{8856F961-340A-11D0-A96B-00C04FD705A2}';
EventIID: '{34A715A0-6587-11D0-924A-0020AFC7AC4D}';
EventCount: 3;
EventDispIDs: @CEventDispIDs;
LicenseKey: nil (*HR:$80040154*);
Flags: $00000000;
Version: 401);
begin
ControlData := @CControlData;
FOnDocReady := DoOnDocumentReady;
FOnBeforeNavigate := DoOnBeforeNavigate;
FOnNewWindow := DoOnNewWindow;
TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnDocReady) - Cardinal(Self);
end;
procedure TcxHTMLEditor.AssignEvents;
begin
with FDocEventSink do
begin
OnActivate := DoOnActivate;
OnSelectionChange := DoOnSelectionChange;
OnKeyDown := DoOnKeyDown;
OnClick := DoOnClick;
OnMouseDown := DoOnMouseDown;
OnMouseUp := DoOnMouseUp;
OnDblClick := DoOnDblClick;
OnMoveEnd := DoOnMoveEnd;
OnMoveStart := DoOnMoveStart;
OnResizeStart := DoOnResizeStart;
OnResizeEnd := DoOnResizeEnd;
OnFocusOut := DoOnFocusOut;
OnDrop := DoOnDrop;
OnDragStart := DoOnDragStart;
OnDragEnd := DoOnDragEnd;
end;
end;
procedure TcxHTMLEditor.DoOnActivate(const AEventObj: IHTMLEventObj);
begin
if Supports(AEventObj.srcElement, IHTMLFrameBase) then
DoSelectionChanged;
end;
procedure TcxHTMLEditor.DoOnDocumentReady(ASender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
begin
FDocEventSinkIntf.Connect(Document);
LinkChangeSink;
AssignEvents;
SetupControl;
if Assigned(FOnDocumentComplete) then
FOnDocumentComplete(Self);
UndoManager.Clear;
FState := esNormal;
end;
procedure TcxHTMLEditor.DoOnBeforeNavigate(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant;
var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant;
var Headers: OleVariant; var Cancel: WordBool);
begin
if not SameText(URL, URLBlank) and (Pos('res://', URL) = 0) then
Cancel := True;
end;
procedure TcxHTMLEditor.DoOnNewWindow(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
begin
Cancel := True;
end;
procedure TcxHTMLEditor.DoDocumentChange;
begin
FModified := True;
if Assigned(OnDocumentChange) then
OnDocumentChange(Self);
end;
procedure TcxHTMLEditor.SetupControl;
begin
ExecCommand(IDM_MULTIPLESELECTION, OLECMDEXECOPT_DODEFAULT, True);
ExecCommand(IDM_2D_POSITION, OLECMDEXECOPT_DODEFAULT, True);
ExecCommand(IDM_LIVERESIZE, OLECMDEXECOPT_DODEFAULT, True);
ExecCommand(IDM_DISABLE_EDITFOCUS_UI, OLECMDEXECOPT_DODEFAULT, False);
ExecCommand(IDM_SHOWZEROBORDERATDESIGNTIME, OLECMDEXECOPT_DODEFAULT, ShowBorders);
ExecCommand(IDM_PRESERVEUNDOALWAYS, OLECMDEXECOPT_DODEFAULT, True);
ExecCommand(IDM_PROTECTMETATAGS, OLECMDEXECOPT_DODEFAULT, True);
//TODO: Show Details option
AddGlobalBehaviors;
end;
procedure TcxHTMLEditor.SelectByRect(const AEventObj: IHTMLEventObj; const ARect: TRect);
var
I: Integer;
AElements: IInterfaceList;
Element: IHTMLElement;
begin
if IsToolSelected then
DoInsert(BodyElement, ARect)
else
begin
AElements := TInterfaceList.Create;
GetHTMLElementsList(AElements);
for I := 0 to AElements.Count - 1 do
begin
Element := AElements.Items[I] as IHTMLElement;
if CheckInSelectRect(Element, ARect) then
Selection.Add(Element);
end;
end;
end;
function TcxHTMLEditor.DoOnClick(const AEventObj: IHTMLEventObj): WordBool;
var
Rect: TREct;
Receiver: IHTMLElement;
begin
Result := not IsToolSelected;
if not Result then
begin
if IsElementContainer(AEventObj.srcElement) then
begin
Receiver := AEventObj.srcElement;
Rect.Left := AEventObj.offsetX;
Rect.Top := AEventObj.offsetY;
end
else
begin
Rect.Left := AEventObj.x;
Rect.Top := AEventObj.y;
Receiver := BodyElement;
end;
Rect.Right := Rect.Left;
Rect.Bottom := Rect.Top;
DoInsert(Receiver, Rect);
end;
end;
function TcxHTMLEditor.DoOnDblClick(
const AEventObj: IHTMLEventObj): WordBool;
begin
Result := True;
end;
procedure TcxHTMLEditor.DoOnDragEnd(const AEventObj: IHTMLEventObj);
begin
if (FDropTarget <> nil) and Assigned(FOnParentChanged) then
FOnParentChanged(Self, FDropTarget);
FDraggingElement := nil;
FDropTarget := nil;
end;
function TcxHTMLEditor.DoOnDragStart(
const AEventObj: IHTMLEventObj): WordBool;
begin
FDraggingElement := AEventObj.srcElement;
FDropTarget := nil;
Result := True;
end;
function TcxHTMLEditor.DoOnDrop(const AEventObj: IHTMLEventObj): WordBool;
begin
FDropTarget := AEventObj.srcElement;
Result := True;
end;
procedure TcxHTMLEditor.DoOnFocusOut(const AEventObj: IHTMLEventObj);
begin
end;
procedure TcxHTMLEditor.DoOnKeyDown(const AEventObj: IHTMLEventObj);
begin
end;
procedure TcxHTMLEditor.DoOnMouseDown(const AEventObj: IHTMLEventObj);
begin
end;
procedure TcxHTMLEditor.DoOnMouseUp(const AEventObj: IHTMLEventObj);
var
Range: IHTMLControlRange;
Rect: TRect;
begin
// Complete control resizing by mouse
if FState = esResizing then
begin
FState := esNormal;
if Assigned(FOnResized) then
FOnresized(Self);
end;
// Complete control moving by mouse
if FState = esMoving then
begin
FState := esNormal;
if Assigned(FOnMoved) then
FOnMoved(Self);
UndoManager.EndUndoBlock;
end;
// Workaround for the IE 5.5 bug with the OnSelectionChange event
if cxWebHTMLDesignerMajorVersion = 5 then
if (AEventObj.ctrlKey or AEventObj.shiftKey) and
Supports(Document.selection.createRange, IHTMLControlRange, Range) and
(Range.length > 0) then
DoSelectionChanged;
if IsToolSelected and IsElementContainer(AEventObj.srcElement) then
begin
Rect.Left := AEventObj.offsetX;
Rect.Top := AEventObj.offsetY;
Rect.Right := Rect.Left;
Rect.Bottom := Rect.Top;
DoInsert(AEventObj.srcElement, Rect);
end;
end;
procedure TcxHTMLEditor.DoOnMoveEnd(const AEventObj: IHTMLEventObj);
begin
// DoDocumentChange;
end;
function TcxHTMLEditor.DoOnMoveStart(
const AEventObj: IHTMLEventObj): WordBool;
begin
if FState <> esMoving then
UndoManager.BeginUndoBlock(scxCmdMove);
FState := esMoving;
Result := True;
end;
function TcxHTMLEditor.DoOnResizeStart(const AEventObj: IHTMLEventObj): Wordbool;
begin
if HasElementViewLink(AEventObj.srcElement) then
UndoManager.BeginUndoBlock(scxCmdResize);
FState := esResizing;
Result := True;
end;
procedure TcxHTMLEditor.DoOnResizeEnd(const AEventObj: IHTMLEventObj);
begin
// DoDocumentChange;
end;
procedure TcxHTMLEditor.DoOnSelectionChange(
const AEventObj: IHTMLEventObj);
var
Element: IHTMLElement;
Changed: Boolean;
begin
if not Busy then
begin
Changed := False;
if GetAsyncKeyState(VK_LBUTTON) < 0 then
begin
Element := Document.elementFromPoint(AEventObj.clientX, AEventObj.clientY);
if (ContainerLayout(Element) = hclGrid) and
(Selection.Count > 0) and not CanElementSelect(Element) then
begin
Selection.Empty;
Changed := True;
end;
end;
if not Changed then
DoSelectionChanged;
end;
end;
procedure TcxHTMLEditor.DoInsert(AParent: IHTMLElement; R: TRect);
var
AHTML, AInnerHTML: string;
Element: IHTMLElement;
begin
if Assigned(FOnControlInsert) then
begin
UndoManager.BeginUndoBlock(scxCmdInsert);
FOnControlInsert(Self, R, AHTML, AInnerHTML, AParent);
if (AHTML <> '') and (AParent <> nil) then
begin
Element := Document.createElement(AHTML);
if AInnerHTML <> '' then
Element.innerHTML := AInnerHTML;
while True do
begin
if (AParent as IHTMLElement2).canHaveChildren then
break;
AParent := AParent.parentElement;
if AParent = nil then break;
end;
(AParent as IHTMLDOMNode).appendChild(Element as IHTMLDOMNode);
if Assigned(FOnControlInserted) then
FOnControlInserted(Self, Element);
if not HasElementViewLink(Element) then
UndoManager.EndUndoBlock;
end;
end;
end;
procedure TcxHTMLEditor.DoSelectionChanged;
begin
if Assigned(FOnSelectionChanged) then
FOnSelectionChanged(Self);
end;
procedure TcxHTMLEditor.GetHTMLElementsList(const AList: IInterfaceList);
begin
end;
procedure TcxHTMLEditor.StartMoveSelectionByKey(const AKey: Integer; ASnap: Boolean);
var
I: Integer;
Element: IHTMLElement;
DeltaX, DeltaY: Integer;
IsFirst: Boolean;
begin
if ASnap and SnapToGrid then
begin
DeltaX := GridXSize;
DeltaY := GridYSize;
end
else
begin
DeltaX := 1;
DeltaY := 1;
end;
IsFirst := FState <> esMoving;
if IsFirst then
EndResizeSelectionByKey;
for I := 0 to Selection.Count - 1 do
begin
Element := Selection.Controls[I];
if not SameText((Element as IHTMLElement2).currentStyle.position, 'static') then // Do not localize
begin
if IsFirst then
FireEvent(Element, 'onmovestart');
case AKey of
VK_UP:
Element.style.setAttribute('top', Element.offsetTop - DeltaY, 0);
VK_DOWN:
Element.style.setAttribute('top', Element.offsetTop + DeltaY, 0);
VK_LEFT:
Element.style.setAttribute('left', Element.offsetLeft - DeltaX, 0);
VK_RIGHT:
Element.style.setAttribute('left', Element.offsetLeft + DeltaX, 0);
end;
end;
end;
end;
procedure TcxHTMLEditor.StartResizeSelectionByKey(const AKey: Integer);
var
I: Integer;
Element: IHTMLElement;
IsFirst: Boolean;
begin
IsFirst := FState <> esResizing;
if IsFirst then
begin
EndMoveSelectionByKey;
UndoManager.BeginUndoBlock(scxCmdResize);
end;
for I := 0 to Selection.Count - 1 do
begin
Element := Selection.Controls[I];
if IsFirst then
FireEvent(Element, 'onresizestart');
Element.style.setAttribute('height', Element.offsetHeight, 0);
Element.style.setAttribute('width', Element.offsetWidth, 0);
case AKey of
VK_UP:
Element.style.setAttribute('height', Element.offsetHeight - 1, 0);
VK_DOWN:
Element.style.setAttribute('height', Element.offsetHeight + 1, 0);
VK_LEFT:
Element.style.setAttribute('width', Element.offsetWidth - 1, 0);
VK_RIGHT:
Element.style.setAttribute('width', Element.offsetWidth + 1, 0);
end;
end;
end;
procedure TcxHTMLEditor.EndMoveSelectionByKey;
var
I: Integer;
Element: IHTMLElement;
SelElements: IInterfaceList;
begin
if FState <> esMoving then Exit;
SelElements := TInterfaceList.Create;
for I := 0 to Selection.Count - 1 do
SelElements.Add(Selection[I]);
for I := 0 to SelElements.Count - 1 do
begin
Element := SelElements[I] as IHTMLElement;
if not SameText((Element as IHTMLElement2).currentStyle.position, 'static') then // Do not localize
FireEvent(Element, 'onmoveend');
end;
FState := esNormal;
if Assigned(FOnMoved) then
FOnMoved(Self);
UndoManager.EndUndoBlock;
end;
procedure TcxHTMLEditor.EndResizeSelectionByKey;
var
I: Integer;
begin
if FState <> esResizing then Exit;
for I := 0 to Selection.Count - 1 do
FireEvent(Selection.Controls[I], 'onresizeend');
FState := esNormal;
if Assigned(FOnResized) then
FOnResized(Self);
UndoManager.EndUndoBlock;
end;
function TcxHTMLEditor.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
Result := DISP_E_MEMBERNOTFOUND;
if DispID = DISPID_AMBIENT_DLCONTROL then
if VarResult <> nil then
begin
POleVariant(VarResult)^ :=
DLCTL_DLIMAGES or DLCTL_VIDEOS or DLCTL_BGSOUNDS or
DLCTL_NO_SCRIPTS or DLCTL_NO_JAVA or
DLCTL_NO_RUNACTIVEXCTLS or DLCTL_NO_DLACTIVEXCTLS or
DLCTL_PRAGMA_NO_CACHE or
DLCTL_NO_BEHAVIORS or
DLCTL_FORCEOFFLINE or DLCTL_NO_CLIENTPULL or DLCTL_SILENT or
DLCTL_NO_METACHARSET;
Result := S_OK;
if FInternalBrowseMode then
POleVariant(VarResult)^ := POleVariant(VarResult)^ or DLCTL_NO_FRAMEDOWNLOAD;
end
else
Result := E_INVALIDARG;
end;
function TcxHTMLEditor.QueryService(const rsid, iid: TGuid;
out Obj): HResult;
begin
Result := E_NOINTERFACE;
if IsEqualGUID(rsid, IID_IHTMLEditHost) and IsEqualGUID(iid, IID_IHTMLEditHost) then
Result := QueryInterface(IHTMLEditHost, Obj);
end;
function TcxHTMLEditor.SnapRect(const pIElement: IHTMLElement;
var prcNew: tagRECT; eHandle: _ELEMENT_CORNER): HResult;
function GetGlobalPoint(AElement: IHTMLElement): TPoint;
begin
Result.X := (BodyElement as IHTMLElement2).scrollLeft;
Result.Y := (BodyElement as IHTMLElement2).scrollTop;
while AElement <> nil do
begin
Result.X := Result.X + AElement.offsetLeft;
Result.Y := Result.Y + AElement.offsetTop;
AElement := AElement.offsetParent;
end;
end;
procedure EvalResize(const ACurValue, ADelta: Integer; var ANewValue: Integer);
var
I: Integer;
begin
I := ANewValue;
if I > ACurValue then
Inc(I, ADelta);
I := (I div ADelta) * ADelta;
if ((ADelta < 4) and (Abs(I - ANewValue) < 2) ) or
(Abs(I - ANewValue) < (ADelta div 2)) then
ANewValue := I
else
ANewValue := ACurValue;
end;
procedure EvalMove(const ACurValue, ADelta: Integer; var ANewValue: Integer);
var
I: Integer;
begin
I := ACurValue + ((ANewValue - ACurValue) div ADelta) * ADelta;
if Abs(I - ANewValue) < (ADelta div 2) then
ANewValue := I
else
ANewValue := ACurValue;
end;
var
DeltaX, DeltaY: Integer;
begin
Result := S_OK;
DeltaX := GridXSize;
DeltaY := GridYSize;
if SnapToGrid and (pIElement <> nil) and (GetAsyncKeyState(VK_MENU) >= 0) then
case eHandle of
ELEMENT_CORNER_NONE:
begin
EvalMove(GetGlobalPoint(pIElement).Y, DeltaY, prcNew.top);
EvalMove(GetGlobalPoint(pIElement).X, DeltaX, prcNew.left);
end;
ELEMENT_CORNER_TOP:
EvalResize(GetGlobalPoint(pIElement).Y, DeltaY, prcNew.top);
ELEMENT_CORNER_LEFT:
EvalResize(GetGlobalPoint(pIElement).X, DeltaX, prcNew.left);
ELEMENT_CORNER_BOTTOM:
EvalResize(GetGlobalPoint(pIElement).Y + pIElement.offsetHeight,
DeltaY, prcNew.bottom);
ELEMENT_CORNER_RIGHT:
EvalResize(GetGlobalPoint(pIElement).X + pIElement.offsetWidth,
DeltaX, prcNew.right);
ELEMENT_CORNER_TOPLEFT:
begin
EvalResize(GetGlobalPoint(pIElement).Y, DeltaY, prcNew.top);
EvalResize(GetGlobalPoint(pIElement).X, DeltaX, prcNew.left);
end;
ELEMENT_CORNER_TOPRIGHT:
begin
EvalResize(GetGlobalPoint(pIElement).Y, DeltaY, prcNew.top);
EvalResize(GetGlobalPoint(pIElement).X + pIElement.offsetWidth,
DeltaX, prcNew.right);
end;
ELEMENT_CORNER_BOTTOMLEFT:
begin
EvalResize(GetGlobalPoint(pIElement).Y + pIElement.offsetHeight,
DeltaY, prcNew.bottom);
EvalResize(GetGlobalPoint(pIElement).X, DeltaX, prcNew.left);
end;
ELEMENT_CORNER_BOTTOMRIGHT:
begin
EvalResize(GetGlobalPoint(pIElement).Y + pIElement.offsetHeight,
DeltaY, prcNew.bottom);
EvalResize(GetGlobalPoint(pIElement).X + pIElement.offsetWidth,
DeltaX, prcNew.right);
end;
end;
end;
function TcxHTMLEditor.ShowBorders: Boolean;
begin
Result := True;
end;
function TcxHTMLEditor.ShowDetails: Boolean;
begin
Result := False;
end;
function TcxHTMLEditor.ShowGrid: Boolean;
begin
Result := True;
end;
function TcxHTMLEditor.SnapToGrid: Boolean;
begin
Result := True;
end;
function TcxHTMLEditor.GridXSize: Integer;
begin
Result := 0;
end;
function TcxHTMLEditor.GridYSize: Integer;
begin
Result := 0;
end;
function TcxHTMLEditor.IsToolSelected: Boolean;
begin
Result := False;
end;
procedure TcxHTMLEditor.CompleteUndoBlock;
begin
if UndoManager.FOpenBlockCount > 0 then
UndoManager.EndUndoBlock
else
UndoManager.Clear;
end;
procedure TcxHTMLEditor.GetViewLinkContent(const AElement: IHTMLElement;
var AContent, ACSSContent, AInlineStyle: string);
begin
AContent := '';
ACSSContent := '';
AInlineStyle := '';
end;
function TcxHTMLEditor.IsElementContainer(const AElement: IHTMLElement): Boolean;
begin
Result := False;
end;
function TcxHTMLEditor.CanHaveBehavior(const AElement: IHTMLElement): Boolean;
begin
Result := True;
end;
function TcxHTMLEditor.ContainerLayout(const AElement: IHTMLElement): TcxHTMLContainerLayout;
begin
Result := hclFlow;
end;
function TcxHTMLEditor.CanElementSelect(const AElement: IHTMLElement): Boolean;
begin
Result := True;
end;
function TcxHTMLEditor.Notify: HResult;
begin
DoDocumentChange;
Result := S_OK;
end;
{ TcxHTMLEditor private }
function TcxHTMLEditor.GetControlInterface: IWebBrowser2;
begin
CreateControl;
Result := FIntf;
end;
function TcxHTMLEditor.GetDocument: IHTMLDocument2;
begin
Supports(ControlInterface.Document, IHTMLDocument2, Result);
end;
function TcxHTMLEditor.GetDocument3: IHTMLDocument3;
begin
Supports(ControlInterface.Document, IHTMLDocument3, Result);
end;
function TcxHTMLEditor.GetDocument4: IHTMLDocument4;
begin
Supports(ControlInterface.Document, IHTMLDocument4, Result);
end;
function TcxHTMLEditor.GetBrowseMode: Boolean;
begin
// Wait;
if Document <> nil then
Result := not SameText(Document.designMode, 'On')
else
Result := True;
end;
function TcxHTMLEditor.GetBusy: Boolean;
begin
Result := ControlInterface.Busy;
end;
function TcxHTMLEditor.GetDocumentReady: Boolean;
begin
Result := ControlInterface.ReadyState = READYSTATE_COMPLETE;
end;
function TcxHTMLEditor.GetModified: Boolean;
begin
Result := FModified or UndoManager.CanUndo;
end;
function TcxHTMLEditor.GetDocumentHTML: string;
var
StrStream: TStream;
begin
Result := '';
StrStream := TStringStream.Create('');
try
SaveDocumentToStream(StrStream);
Result := TStringStream(StrStream).DataString;
finally
StrStream.Free;
end;
end;
function TcxHTMLEditor.GetDisplayServices: IDisplayServices;
begin
Supports(Document, IDisplayServices, Result);
end;
function TcxHTMLEditor.GetMarkupServices: IMarkupServices;
begin
Supports(Document, IMarkupServices, Result);
end;
procedure TcxHTMLEditor.ProcessMessages;
var
Msg: TMsg;
begin
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
if Msg.Message <> WM_QUIT then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
procedure TcxHTMLEditor.SetBaseURL(const Value: string);
var
Elements: IHTMLElementCollection;
BaseElement: IHTMLElement;
Node: IHTMLDOMNode;
TagName: WideString;
Stream: TStream;
begin
if Value = FBaseURL then Exit;
LockWindowUpdate(Handle);
try
// Wait for document complete
Wait;
while not DocumentReady do
ProcessMessages;
while not IsDocumentReady(Document) do
ProcessMessages;
// Get Base element
MarkupServices.GetNameForTagID(TAGID_BASE, TagName);
Elements := Document3.getElementsByTagName(TagName);
if Elements.length = 0 then
begin
MarkupServices.createElement(TAGID_BASE, 'ewf_designer', BaseElement);
MarkupServices.GetNameForTagID(TAGID_HEAD, TagName);
Elements := Document3.getElementsByTagName(TagName);
if Elements.length > 0 then
begin
Node := Elements.item(0, 0) as IHTMLDomNode;
Node.appendChild(BaseElement as IHTMLDOMNode);
end;
end
else
BaseElement := Elements.item(0, 0) as IHTMLElement;
if not VarIsNull(BaseElement.getAttribute('ewf_designer', 0)) then
begin
// Modify Base URL
(BaseElement as IHTMLBaseElement).href := Value;
// Reload HTML
Stream := TMemoryStream.Create;
try
SaveDocumentToStream(Stream);
Stream.Position := 0;
LoadDocumentFromStream(Stream);
finally
Stream.Free
end;
FBaseURL := Value;
end;
finally
LockWindowUpdate(0);
end;
end;
procedure TcxHTMLEditor.SetBrowseMode(const Value: Boolean);
begin
Wait;
if Document <> nil then
if Value then
Document.designMode := 'Off'
else
Document.designMode := 'On';
end;
procedure TcxHTMLEditor.SetDocumentHTML(const Value: string);
var
StrStream: TStream;
begin
StrStream := TStringStream.Create(Value);
try
LoadDocumentFromStream(StrStream);
finally
StrStream.Free;
end;
end;
procedure TcxHTMLEditor.SetModified(const Value: Boolean);
begin
if not Value then
UndoManager.Clear;
FModified := Value;
end;
function TcxHTMLEditor.GetBody: IHTMLBodyElement;
begin
Supports(BodyElement, IHTMLBodyElement, Result);
end;
function TcxHTMLEditor.GetBodyElement: IHTMLElement;
begin
if Document <> nil then
Result := Document.body
else
Result := nil;
end;
function TcxHTMLEditor.AddNamespace(const ANamespace: string): IcxHTMLNamespace;
begin
Result := TcxHTMLNamespace.CreateObj(ANamespace, self) as IcxHTMLNamespace;
if Result <> nil then
FNamespaces.Add(Result);
end;
function TcxHTMLEditor.FindNamespace(const ANamespace: string): IcxHTMLNamespace;
var
I: Integer;
Namespace: IcxHTMLNamespace;
begin
Result := nil;
for I := 0 to FNamespaces.Count - 1 do
begin
Namespace := FNamespaces.Items[I] as IcxHTMLNamespace;
if SameText(Namespace.Name, ANamespace) then
begin
Result := Namespace;
break;
end;
end;
end;
function TcxHTMLEditor.FindElementBehavior(AElement: IHTMLElement): IcxHTMLBehaviorViewLink;
var
I: Integer;
begin
Result := nil;
for I := 0 to FNamespaces.Count - 1 do
if Supports((FNamespaces[I] as IcxHTMLNamespace).GetElementBehavior(AElement),
IcxHTMLBehaviorViewLink, Result) then break;
end;
function TcxHTMLEditor.CheckInSelectRect(Element: IHTMLElement; R: TRect): Boolean;
var
ElementRect, ResultRect: TRect;
begin
ElementRect.Left := Element.offsetLeft;
ElementRect.Top := Element.offsetTop;
ElementRect.Right := ElementRect.Left + Element.offsetWidth;
ElementRect.Bottom := ElementRect.Top + Element.offsetHeight;
Result := IntersectRect(ResultRect, ElementRect, R);
end;
function TcxHTMLEditor.FireEvent(ASrcElement: IHTMLElement; const AName: string): Boolean;
var
NewEvent: IHTMLEventObj;
VEvent: OleVariant;
begin
NewEvent := Document4.CreateEventObject(nil);
VEvent := NewEvent;
Result := (ASrcElement as IHTMLElement3).FireEvent(AName, VEvent);
end;
procedure TcxHTMLEditor.AddGlobalBehaviors;
procedure RemoveBehavior(ABehavior: IcxHTMLBehavior);
var
Cookie: Integer;
Element2: IHTMLElement2;
begin
ABehavior.PaintSite.GetHitTestCookie(Cookie);
if Supports(ABehavior.Element, IHTMLElement2, Element2) then
Element2.removeBehavior(Cookie);
end;
var
I: Integer;
Namespace: IcxHTMLNamespace;
Body2: IHTMLElement2;
vFactory: OleVariant;
Factory: IElementBehaviorFactory;
SelectionBehavior: IcxHTMLSelectionBehavior;
begin
Namespace := FindNamespace('');
if Namespace = nil then
Namespace := AddNamespace('');
while Namespace.Behaviors.Count > 0 do
RemoveBehavior(Namespace.Behaviors.Items[0] as IcxHTMLBehavior);
Supports(Namespace, IElementBehaviorFactory, Factory);
Factory._AddRef;
TVarData(vFactory).VType := varUnknown;
TVarData(vFactory).VUnknown := Pointer(Factory);
if (Body <> nil) and (ContainerLayout(BodyElement) = hclGrid) then
begin
Body2 := BodyElement as IHTMLElement2;
Body2.addBehavior('grid', vFactory);
Body2.addBehavior('select', vFactory);
//TODO: improve events handling mechanism
for I := 0 to Namespace.Behaviors.Count - 1 do
if Supports(Namespace.Behaviors.Items[I], IcxHTMLSelectionBehavior, SelectionBehavior) then
SelectionBehavior.OnRegionSelected := SelectByRect;
end;
end;
procedure TcxHTMLEditor.LinkChangeSink;
var
PrimaryMC: IMarkupContainer2;
begin
if Supports(Document, IMarkupContainer2, PrimaryMC) then
begin
UnlinkChangeSink;
PrimaryMC.RegisterForDirtyRange(Self, FPrimaryMCId);
end;
end;
procedure TcxHTMLEditor.UnlinkChangeSink;
var
PrimaryMC: IMarkupContainer2;
begin
if Supports(Document, IMarkupContainer2, PrimaryMC) then
if FPrimaryMCId <> 0 then
begin
PrimaryMC.UnRegisterForDirtyRange(FPrimaryMCId);
FPrimaryMCId := 0;
end;
end;
{ TcxHTMLUndoManager }
constructor TcxHTMLUndoManager.Create(AEditor: TcxHTMLEditor);
begin
FEditor := AEditor;
FOpenBlockCount := 0;
end;
procedure TcxHTMLUndoManager.BeginUndoBlock(const ACaption: string);
begin
FEditor.MarkupServices.BeginUndoUnit(ACaption);
Inc(FOpenBlockCount);
end;
procedure TcxHTMLUndoManager.Clear;
var
OleUndoManager: IcxOleUndoManager;
begin
OleUndoManager := GetOleUndoManager;
if OleUndoManager <> nil then
begin
OleUndoManager.DiscardFrom(nil);
OleUndoManager.Enable(False);
OleUndoManager.Enable(True);
end;
end;
procedure TcxHTMLUndoManager.EndUndoBlock;
begin
if FOpenBlockCount = 0 then Exit;
FEditor.MarkupServices.EndUndoUnit;
Dec(FOpenBlockCount);
end;
function TcxHTMLUndoManager.GetUndoDesctiption: string;
var
WDesc: WideString;
begin
Result := '';
if GetOleUndoManager.GetLastUndoDescription(WDesc) = S_OK then
Result := WDesc;
end;
function TcxHTMLUndoManager.GetRedoDesctiption: string;
var
WDesc: WideString;
begin
Result := '';
if GetOleUndoManager.GetLastRedoDescription(WDesc) = S_OK then
Result := WDesc;
end;
function TcxHTMLUndoManager.CanRedo: Boolean;
begin
//TODO Result := (FEditor.QueryStatus(IDM_REDO) and OLECMDF_ENABLED) = OLECMDF_ENABLED;
Result := False;
end;
function TcxHTMLUndoManager.CanUndo: Boolean;
begin
//TODO Result := (FEditor.QueryStatus(IDM_UNDO) and OLECMDF_ENABLED) = OLECMDF_ENABLED;
Result := False;
end;
procedure TcxHTMLUndoManager.Redo;
begin
if not CanRedo then Exit;
FEditor.ExecCommand(IDM_REDO, OLECMDEXECOPT_DONTPROMPTUSER);
end;
procedure TcxHTMLUndoManager.Undo;
begin
if not CanUndo then Exit;
FEditor.ExecCommand(IDM_UNDO, OLECMDEXECOPT_DONTPROMPTUSER);
end;
function TcxHTMLUndoManager.GetOleUndoManager: IcxOleUndoManager;
var
SP: IServiceProvider;
begin
if Supports(FEditor.Document, IServiceProvider, SP) then
SP.QueryService(IcxOleUndoManager, IcxOleUndoManager, Result);
end;
initialization
OleInitialize(nil);
finalization
OleUninitialize;
end.