source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/EmbeddedED/EmbeddedED.~pas@ 1806

Last change on this file since 1806 was 541, checked in by Kevin Toppenberg, 15 years ago

TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 180.1 KB
RevLine 
[541]1{ EmbeddedED ver 1.21 (Jan. 19, 2004) }
2{ }
3{ For Delphi 4, 5, 6 and 7 }
4{ }
5{ Copyright (C) 1999-2004, Kurt Senfer. }
6{ All Rights Reserved. }
7{ }
8{ Support@ks.helpware.net }
9{ }
10{ Documentation and updated versions: }
11{ }
12{ http://KS.helpware.net }
13{ }
14{ ********************************************* }
15
16{
17
18 This library is free software; you can redistribute it and/or
19 modify it under the terms of the GNU Lesser General Public
20 License as published by the Free Software Foundation; either
21 version 2.1 of the License, or (at your option) any later version.
22
23 This library is distributed in the hope that it will be useful,
24 but WITHOUT ANY WARRANTY; without even the implied warranty of
25 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
26 Lesser General Public License for more details.
27
28 You should have received a copy of the GNU Lesser General Public
29 License along with this library; if not, write to the Free Software
30 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
31
32This unit forms the basic core of a MSHTML Edit component witch can be used
33as the starting point for a full blown WYSIWYG HTML Editor.
34
35Don't change this unit, but subclass it in order to build your own advanced
36HTML Editor on top of it. If you change the unit you'll run into unnecessary
37troubles when official updates of this unit is released. If you build a
38subclassed editor you can benefit from new versions of the EmbeddedED unit
39without the need of changing your own code.
40
41If you find bugs or have ideas / wishes for new features that either should be
42incorporated into the EmbeddedED unit or cant be placed in a subclassed unit,
43then please let me know and I'll try to keep EmbeddedED updated at any time.
44
45----------------------------------------------------------------------
46
47Once I tried to get an HTML editor written as OSP. When it didn't succeeded
48I tried to get different groups of people to share the workload of
49writing a good HTML editor around the MSHTML engine - no succeed either.
50
51Then I finally had to do everything myself and finally I decided only to make
52parts of my source public.
53
54If you ever need to do more than the basic editing that the EmbeddedED unit
55will give you, you need to write some code yourself, or you might chose to acquire
56some of the code I wrote - check out my site at http://KS.helpware.net.
57
58The power of all units are compiled into the KsDHTMLEDLib.ocx witch you can use
59free of charge. }
60
61(*
62NOTE: Modified by K. Toppenberg (marked by //kt)
63*)
64
65
66
67unit EmbeddedED; //core VCL HTML edit component
68{.$DEFINE EDOCX} //unit not included
69{.$DEFINE EDTABLE} //unit not included
70{.$DEFINE EDUNDO} //unit not included
71{.$DEFINE EDMONIKER} //unit not included
72{.$DEFINE EDGLYPHS} //unit not included
73{.$DEFINE EDLIB} //unit not included
74{.$DEFINE EDPARSER} //unit not included
75{.$DEFINE EDDRAGDROP} //unit not included
76{.$DEFINE EDZINDEX} //unit not included
77{.$DEFINE EDDESIGNER} //unit not included
78{.$DEFINE EDPRINT} //unit not included
79
80
81{ $DEFINE DEBUG } //kt removed.
82
83
84
85 {$I KSED.INC} //Compiler version directives
86
87interface
88
89uses
90 Windows, Classes, ActiveX, Forms,
91 //ktMSHTML_TLB,
92 MSHTML_EWB, //kt
93 AXCtrls, menus, Controls, messages, URLMon,
94 {$IFDEF D6D7} Variants, {$ENDIF}
95 {$IFDEF EDPRINT} EDPrint, {$ENDIF}
96 IEConst, EmbedEDconst, KS_Lib, SHDocVw;
97
98type
99 TDHTMLEDITAPPEARANCE = (DEAPPEARANCE_FLAT, DEAPPEARANCE_3D);
100
101 TUserInterfaceOption = (NoBorder, NoScrollBar, FlatScrollBar, DivBlockOnReturn);
102 TUserInterfaceOptions = set of TUserInterfaceOption;
103
104 TDHTMLEditShowContextMenu = procedure(Sender: TObject; xPos: Integer; yPos: Integer) of object;
105 TDHTMLEditContextMenuAction = procedure(Sender: TObject; itemIndex: Integer) of object;
106 TQueryServiceEvent = function(const rsid, iid: TGuid; out Obj: IUnknown): HResult of object;
107 TShowContextMenuEvent = function(const dwID: DWORD; const ppt: PPOINT; const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT of object;
108 TShowContextMenuEventEx = procedure(Sender: TObject; xPos, yPos: Integer) of object;
109 TTranslateURLEvent = procedure(Sender: TObject; var URL: string; var Changed: Boolean) of object;
110 TMessageEventEx = procedure(Sender: TObject; var msg: LongWord; var wParam: SYSINT; var lParam: SYSINT; var Result: SYSINT) of object;
111 TEditDesignerEvent = procedure(Sender: TObject; inEvtDispId: Integer; const pIEventObj: IHTMLEventObj; var Result: HResult) of object;
112 TNotifyEventEx2 = procedure(Sender: TObject; NewFile: String) of object;
113 TNotifyEventEx4 = procedure(Sender: TObject; var S: String) of object;
114
115//kt TSnapRect = procedure(Sender: TObject; const pIElement: IHTMLElement; var prcNew: tagRECT; eHandle: _ELEMENT_CORNER; var Result: HResult) of object;
116 TNotifyEventEx = procedure(Sender: TObject; var Cancel: Boolean) of object;
117
118 TNotifyEventEx8 = procedure(Sender: TObject; var Key: Integer; const pEvtObj: IHTMLEventObj) of object;
119 TNotifyProcedureEvent = procedure of object;
120
121 TRefreshEvent = procedure(Sender: TObject; CmdID: Integer; var Cancel: Boolean) of object;
122 TMouseEventEx = procedure(Sender: TObject; const pEvtObj: IHTMLEventObj; X, Y: Integer; var Cancel: Boolean) of object;
123
124 {$IFNDEF EDPRINT}
125 TPrintSetup = array[0..8] of string; //Dummy type - if EDPRINT is undefines
126 {$ENDIF}
127
128
129 TEmbeddedED = class(TWebbrowser,
130 IDocHostUIHandler,
131 IDispatch, //invoke ~ general event sink
132 IServiceProvider,
133 IOleControlSite,
134 IPropertyNotifySink,
135 {$IFDEF EDDRAGDROP}
136 IDropTarget,
137 {$ENDIF}
138 IOleCommandTarget,
139 ISimpleFrameSite
140 )
141 private
142 FOnQueryService: TQueryServiceEvent;
143 FOnDisplayChanged: TNotifyEvent;
144 FOnShowContextMenu: TShowcontextmenuEvent;
145 FOnShowContextmenuEx: TShowContextMenuEventEx;
146 FOnTranslateURL: TTranslateURLEvent;
147 FOnDocumentComplete: TNotifyEvent;
148 FWaitMessage: Boolean;
149 DWEBbrowserEvents2Cookie: Integer; //event sink stuff
150 FReadyState: Integer;
151 FShowDetails: Boolean;
152 FIEVersion: String;
153 FIE6: boolean;
154 FMSHTMLDropTarget: IDropTarget;
155 FInternalStyles: String;
156 FExternalStyles: String;
157 FStylesRefreshed: Boolean;
158 FStyles: TStringList;
159 FFonts: TStringList;
160 FHTMLImage: String; //Source image of the current page as opened / last saved
161 FDebug: Boolean;
162 DebugBool: Boolean; //used to test any Boolean value
163 DebugString: String; //used to test any string value
164 DebugElement: IHTMLElement;
165 DummyString: String;
166 FSetInitialFocus: Boolean;
167 FEDMessageHandler: TMessageEvent;
168 FMessageHandler: TMessageEventEx;
169 FUserInterfaceValue: DWORD;
170 FDownloadControlValue: Integer;
171 FPrintFinished: Boolean;
172 // IHTMLEditHost
173 FSnapEnabled: Boolean;
174 FGridX: Integer;
175 FGridY: Integer;
176 //ktFExtSnapRect: TSnapRect;
177 FOnPreDrag: TNotifyEventEx;
178 FPreHandleEvent: TEditDesignerEvent;
179 FPostHandleEvent: TEditDesignerEvent;
180 FEDTranslateAccelerator: TEditDesignerEvent;
181 FPostEditorEventNotify: TEditDesignerEvent;
182 FOleInPlaceActiveObject: IOleInPlaceActiveObject;
183 //kt .. moved to protected section .. FmsHTMLwinHandle: Hwnd;
184 FLocalUndo: WordBool; //we handle UNDO and REDO ourselves
185 FTUndo: Pointer; //we cant use TUndo heir, it will cause a Circular reference
186 FTZindex: pointer; //we cant use TZindex ........
187 FTtable: pointer; //we cant use TTable ........
188 FEdit: pointer; //we cant use TEditDesigner ........
189 FEditHost: pointer; //we cant use TEditHost ........
190 FDestroyng: Boolean;
191 FContextMenu: TPopupMenu;
192 FCreateBakUp: Boolean;
193 FActualTxtRange: IHTMLTxtRange;
194 FActualControlRange: IHTMLControlRange;
195 FSelectionType: string;
196 FActualElement: IHTMLElement;
197 FActualRangeIsText: Boolean;
198 FSelection: Boolean; //There is a selection
199 FHighlight: IHighlightRenderingServices;
200 FHighlightSegment: IHighlightSegment;
201 FRenderStyle: IHTMLRenderStyle;
202 FDisplayPointerStart: IDisplayPointer;
203 FDisplayPointerEnd: IDisplayPointer;
204 FLoadFromString: Boolean;
205 FParamLoad: Boolean;
206 FRefreshing: Boolean;
207 FUserInterfaceOptions: TUserInterfaceOptions;
208 FBeforeSaveFile: TNotifyEvent;
209 FAfterSaveFile: TNotifyEvent;
210 FAfterSaveFileAs: TNotifyEvent;
211 FAfterLoadFile: TNotifyEventEx2;
212 FonAfterPrint: TNotifyEventEx;
213 FonBeforePrint: TNotifyEventEx;
214 FOnUnloadDoc: TNotifyEventEx;
215 FOnRefreshBegin: TRefreshEvent;
216 FOnRefreshEnd: TNotifyEvent;
217 FBaseURL: String;
218 {$IFNDEF EDMONIKER}
219 FDummyString: String;
220 {$ENDIF}
221 FBaseTagInDoc: Boolean;
222 FLiveResize: Boolean;
223 F2DPosition: Boolean;
224 FShowZeroBorderAtDesignTime: Boolean;
225 FConstrain : boolean;
226 EDMessageHandlerPtr: Pointer;
227 FOnMouseUp: TMouseEventEx;
228 FOnMouseDown: TMouseEventEx;
229 FOnDblClick: TNotifyEvent;
230 FOnClick: TNotifyEvent;
231 FOnKeyUp: TNotifyEventEx8;
232 FOnKeyDown: TNotifyEventEx8;
233 FOnKeyPress: TKeyPressEvent;
234 FOnMouseMove: TMouseEventEx;
235 FOnmouseout: TNotifyEvent;
236 FOnmouseover: TNotifyEvent;
237 FOnBlur: TNotifyEvent;
238 FAbsoluteDropMode: Boolean;
239 FShowBorders: Boolean;
240 FCurrentDocumentPath: String;
241 FOnReadystatechange: TNotifyEvent;
242 KeepLI: boolean;
243 FLength: Integer; //number of selected elements
244 FFirstElement: Integer;
245 FLastElement: Integer;
246 FStartElementSourceIndex: Integer;
247 FEndElementSourceIndex: Integer;
248 FElementCollection: IHTMLElementCollection;
249 FTagNumber: Integer; //actual tagnumber in a GetFirts GetNext sequence
250 FMarkUpServices: IMarkupServices;
251 FMarkupPointerStart: IMarkupPointer;
252 FMarkupPointerEnd: IMarkupPointer;
253 FOnInitialize: TNotifyEventEx4;
254 FAXCtrl: Pointer; // pointer to TActiveXControl (KsDHTMLEDLib.ocx)
255 FGenerator: String;
256 FSkipDirtyCheck: Boolean;
257 FWarmingUp: Boolean; //true while MSHTML is initialised
258 FSettingBaseURL: Boolean;
259 FkeepPath: Boolean;
260 FOnContextMenuAction: TDHTMLEditContextMenuAction;
261 // IDOCHOSTUIHANDLER
262 function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT; stdcall;
263 function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
264 function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject; const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame; const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
265 function HideUI: HRESULT; stdcall;
266 function UpdateUI: HRESULT; stdcall;
267 function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
268 function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
269 function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
270 function ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow; const FrameWindow: BOOL): HRESULT; stdcall;
271 function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT; stdcall;
272 function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HRESULT; stdcall;
273 function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HRESULT; stdcall;
274 function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
275 function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HRESULT; stdcall;
276 function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
277 // IDOCHOSTUIHANDLER END
278 // IDispatch
279 function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
280 function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
281 function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
282 function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
283 // IServiceProvider
284 function QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
285 // IServiceProvider END
286 // IOleControlSite
287 function OnControlInfoChanged: HResult; stdcall;
288 function LockInPlaceActive(fLock: BOOL): HResult; stdcall;
289 function GetExtendedControl(out disp: IDispatch): HResult; stdcall;
290 function TransformCoords(var ptlHimetric: TPoint; var ptfContainer: TPointF; flags: Longint): HResult; stdcall;
291 function IOleControlSite.TranslateAccelerator = OleControlSite_TranslateAccelerator;
292 function OleControlSite_TranslateAccelerator(msg: PMsg; grfModifiers: Longint): HResult; stdcall;
293 function OnFocus(fGotFocus: BOOL): HResult; stdcall;
294 function ShowPropertyFrame: HResult; stdcall;
295 // IOleControlSite END
296 {$IFDEF EDDRAGDROP}
297 // IDropTarget
298 function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
299 function IDropTarget.DragOver = _DragOver;
300 function _DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
301 function DragLeave: HResult; stdcall;
302 function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
303 // IDropTarget END
304 {$ENDIF}
305 // IOleCommandTarget
306 function IOleCommandTarget.QueryStatus = _QueryStatus;
307 function _QueryStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: POleCmd; CmdText: POleCmdText): HResult; stdcall;
308 function Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD; const vaIn: OleVariant; var vaOut: OleVariant): HResult; stdcall;
309 // IOleCommandTarget END
310 function GetOleobject: IOleobject;
311 function GetBaseURL: String;
312 procedure SetBaseURL(const Value: String);
313 {$IFNDEF EDMONIKER}
314 function LoadFromIStream(aIStream: IStream): HResult;
315 {$ENDIF}
316 Procedure GetSourceSnapShot;
317 function GetCharset: string;
318 function EmptyDoc: String;
319 procedure SubClassMsHTML;
320 procedure UnSubClassMsHTML;
321 function GetWebBrowserConnectionPoint(var CP: ICOnnectionPoint): boolean;
322 procedure EDOnMouseOver(const pEvtObj: IHTMLEventObj);
323 procedure WaitAsyncMessage(var Msg: Tmessage); message WaitAsync_MESSAGE;
324 function OpenChangeLog: HResult;
325 function LoadFromStrings(aStrings: TStrings): HResult;
326 function LoadFromString(aString: String): HResult;
327 function Get_Busy: Boolean;
328 procedure SetShowDetails(vIn: Boolean);
329 Function GetBackup: Boolean;
330 function CreateBackUp: Boolean;
331 procedure SetDocumentHTML(NewHTML: String);
332 procedure EDOnDownloadComplete(Sender: TObject);
333 procedure HookEvents;
334 function GetActualAppName: string;
335 procedure SetActualAppName(const Value: string);
336 procedure SetBrowseMode(const Value: WordBool);
337 function GetBrowseMode: WordBool;
338 procedure SetDirty(_dirty: boolean);
339 function GetDirty: boolean;
340 function GetDocTitle: String;
341 procedure SetDocTitle(NewTitle: string);
342 function GetDOC: IHTMLDocument2;
343 function GetCmdTarget: IOleCommandTarget;
344 function GetPersistStream: IPersistStreamInit;
345 function GetPersistFile: IPersistFile;
346 procedure SetLiveResize(const Value: Boolean);
347 procedure Set2DPosition(const Value: Boolean);
348 function GetBaseElement(var aBaseElement: IHTMLBaseElement): boolean;
349 function GetActualElement: IHTMLElement;
350 function GetActualTxtRange: IHTMLTxtRange;
351 function GetActualControlRange: IHTMLControlRange;
352 function GetSelLength: Integer;
353 Procedure GetSelStartElement;
354 Procedure GetSelEndElement;
355 function GetElementNr(ElementNumber: Integer): IHTMLElement;
356 function _GetNextItem(const aTag: String = ''): IHTMLElement;
357 procedure EDBeforePrint(Sender: TObject; const pEvtObj: IHTMLEventObj);
358 procedure EDAfterPrint(Sender: TObject; const pEvtObj: IHTMLEventObj);
359 procedure EDOnUnloadDoc(Sender: TObject; const pEvtObj: IHTMLEventObj);
360 procedure EDOnDocBlur(Sender: TObject; const pEvtObj: IHTMLEventObj);
361 procedure EDBeforeDragStart(Sender: TObject; const pEvtObj: IHTMLEventObj);
362 function GetLastError: string;
363 function KSTEst(var pInVar, pOutVar: OleVariant): HResult;
364 function Get_AbsoluteDropMode: Boolean;
365 function Get_Scrollbars: WordBool;
366 function Get_ShowBorders: WordBool;
367 procedure Set_AbsoluteDropMode(const Value: Boolean);
368 procedure Set_Appearance(const Value: TDHTMLEDITAPPEARANCE);
369 function GetAppearance(aType: TUserInterfaceOption): TDHTMLEDITAPPEARANCE;
370 function Get_Appearance: TDHTMLEDITAPPEARANCE;
371 procedure Set_ScrollbarAppearance(const Value: TDHTMLEDITAPPEARANCE);
372 function Get_ScrollbarAppearance: TDHTMLEDITAPPEARANCE;
373 procedure Set_Scrollbars(const Value: WordBool);
374 procedure Set_ShowBorders(const Value: WordBool);
375 function Get_UseDivOnCarriageReturn: WordBool;
376 procedure Set_UseDivOnCarriageReturn(const Value: WordBool);
377 procedure FContextMenuClicked(Sender: TObject);
378 procedure SetGridX(const Value: integer);
379 procedure SetGridY(const Value: integer);
380 procedure SetSnapEnabled(const Value: Boolean);
381 procedure SetUserInterfaceValue;
382 procedure Accept(const URL:String;var Accept:Boolean);
383 procedure Set_LocalUndo(const Value: WordBool);
384 function GetPrintFileName: String;
385 function ISEmptyParam(value: Olevariant): Boolean;
386 protected
387 KeyPressTime : FILETIME; //kt
388 FEditMode: Boolean;
389 FmsHTMLwinPtr: Pointer; //saved pointer to a subclassed MSHTML window
390 FmsHTMLwinHandle: Hwnd; //kt moved here from private section.
391 FMainWinHandle: Hwnd; //the "Shell Embedding" window
392 FScrollTop: Integer; //saved WYSIWYG scroll position
393 FBeforeCloseFile: TNotifyEventEx2;
394 FCurBackFile: String;
395 FCaret: IHTMLCaret; //kt moved from Private --> protected section
396 FTMGDisplayPointer: IDisplayPointer; //kt
397 // IPropertyNotifySink
398 function OnChanged(dispid: TDispID): HResult; override; stdcall;
399 function OnRequestEdit(dispid: TDispID): HResult; override; stdcall;
400 // IPropertyNotifySink END
401 procedure SubMessageHandler(var Message: TMessage); Virtual;
402 function SubFocusHandler(fGotFocus: BOOL): HResult; virtual; //kt
403 procedure EDMessageHandler(var Message: TMessage);
404 procedure DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant; var HandlingComplete: Boolean); virtual;
405 function _DoSaveFile: HResult; Virtual;
406 function DoSaveFile: HResult;
407 function DoSaveFileAs(aFile: String): HResult; Virtual;
408 procedure AfterFileSaved; Virtual;
409 procedure loaded; override;
410 procedure Set_Generator(const Value: String); Virtual;
411 procedure _UpdateUI; //back door for derived component
412 function GetDocumentHTML: string;
413 function ComponentInDesignMode: Boolean; Virtual;
414 function EndCurrentDocDialog(var mr: Integer; CancelPosible: Boolean = False; SkipDirtyCheck: Boolean = False): HResult;
415 function DocIsPersist: boolean;
416 function _LoadFile(aFileName: String): HResult; Virtual;
417 function _CurDir: string;
418 function _CurFileName: string;
419 procedure NotImplemented(S: String);
420 procedure _GetBuildInStyles;
421 procedure EditInitialize;
422 function GetSelStartEnd(Var SelStart, SelEnd: Integer): boolean;
423 function SetSelStartEnd(SelStart, SelEnd: Integer): boolean;
424 public
425 property Onmouseover: TNotifyEvent read FOnmouseover write FOnmouseover;
426 property OnReadystatechange: TNotifyEvent read FOnReadystatechange write FOnReadystatechange;
427 {$IFDEF EDOCX}
428 property AXCtrl: Pointer read FAXCtrl write FAXCtrl;
429 {$ENDIF}
430 // the folowing is for internal use (but need to be public),
431 constructor Create(Owner: TComponent); override;
432 destructor Destroy; override;
433 procedure ShowHighlight(pIRange: IHTMLTxtRange = nil);
434 procedure HideHighlight;
435 function GetInPlaceActiveObject: IOleInPlaceActiveObject;
436 function DocumentIsAssigned: Boolean;
437 procedure ShowCaret;
438 procedure _CheckGenerator(MainCheck: Boolean = true); Virtual;
439 procedure GetBaseTag(var BaseTagInDoc: Boolean; var BaseUrl: String);
440 property Debug: Boolean read FDebug;
441 property EDReadyState: Integer read FReadyState write FReadyState;
442 property CurrentDocumentPath: string read FCurrentDocumentPath;
443 property ExternalStyles: String read FExternalStyles write FExternalStyles;
444 property Styles: TStringlist read FStyles;
445 property MSHTMLDropTarget: IDropTarget read FMSHTMLDropTarget write FMSHTMLDropTarget;
446 property LocalUndo: WordBool read FLocalUndo write FLocalUndo;
447 property CmdTarget: IOleCommandTarget read GetCmdTarget;
448 property PersistStream: IPersistStreamInit read GetPersistStream;
449 property ScrollTop: Integer write FScrollTop;
450 property PrintFinished: Boolean read FPrintFinished write FPrintFinished;
451 property PersistFile: IPersistFile read GetPersistFile;
452 property HTMLImage: String read FHTMLImage;
453 function EndUndoBlock(aResult: HResult): HResult;
454 function ClearUndoStack: HResult;
455 procedure WaitAsync;
456 function GetGenerator: string; virtual;
457 function CmdSet(cmdID: CMDID; var pInVar: OleVariant): HResult; overload; virtual;
458 //VCL versions that isn't exposed by the OCX
459 function DoCommand(cmdID: CMDID): HResult; overload;
460 function DoCommand(cmdID: CMDID; cmdexecopt: OLECMDEXECOPT): HResult; overload;
461 function DoCommand(cmdID: CMDID; cmdexecopt: OLECMDEXECOPT; var pInVar: OleVariant): HResult; overload;
462 function DoCommand(cmdID: CMDID; cmdexecopt: OLECMDEXECOPT; var pInVar, pOutVar: OleVariant): HResult; overload;
463 function CmdSet(cmdID: CMDID): HResult; overload; virtual;
464 function CmdGet(cmdID: CMDID): OleVariant; overload;
465 function GetSaveFileName(var aFile: string): HResult;
466 function SaveFile: HResult; virtual;
467 function SaveFileAs(aFile: string = ''): HResult; virtual;
468 property CurDir: string read _CurDir;
469 property CurFileName: string read _CurFileName;
470 function WaitForDocComplete: Boolean;
471 property DocumentTitle: string read GetDocTitle Write SetDocTitle;
472 procedure ScrollDoc(Pos: Integer);
473 procedure SetFocusToDoc;
474 function GetMSHTMLwinHandle: Hwnd;
475 Function CaretIsVisible: Boolean;
476 procedure SetMouseElement(P: Tpoint; aWinHandle: Hwnd = 0);
477 procedure MakeSelElementVisible(Show: boolean);
478 Function RemoveElementID(const TagID: String): Boolean;
479 Procedure SetDebug(value: Boolean);
480 property CreateBakUp: Boolean read FCreateBakUp write FCreateBakUp;
481 property LastError: string read GetLastError;
482 property SkipDirtyCheck: Boolean read FSkipDirtyCheck write FSkipDirtyCheck;
483 //Old DHTMLEdit stuff
484 function ExecCommand(cmdID: CMDID; cmdexecopt: OLECMDEXECOPT; var pInVar: OleVariant): OleVariant;
485 procedure SetContextMenu(var menuStrings: OleVariant; var menuStates: OleVariant);
486 procedure LoadDocument(var pathIn: OleVariant; var promptUser: OleVariant);
487 procedure SaveDocument(var pathIn: OleVariant; var promptUser: OleVariant);
488 property ShowBorders: WordBool read Get_ShowBorders write Set_ShowBorders;
489 property ActualTextRange: IHTMLTxtRange read FActualTxtRange;
490 //this is the general interface
491 function NewDocument: HResult; virtual;
492 procedure AssignDocument;
493 procedure LoadURL(url: String);
494 function Go(Url: String): HResult;
495 function LoadFile(var aFileName: String; PromptUser: Boolean): HResult; overload; virtual;
496 function LoadFile(var aFileName: String): HResult; overload; virtual;
497 function EndCurrentDoc(CancelPosible: Boolean = False; SkipDirtyCheck: Boolean = False): HResult; virtual;
498 Function GetPersistedFile: String;
499 property IsDirty: Boolean read GetDirty write SetDirty;
500 property DOC: IHTMLDocument2 read GetDOC;
501 property DOM: IHTMLDocument2 read GetDOC; //just to enable old coding style
502 function CmdGet(cmdID: CMDID; pInVar: OleVariant): OleVariant; overload;
503 function CmdSet_B(cmdID: CMDID; pIn: Boolean): HResult; overload; virtual;
504 function CmdSet_S(cmdID: CMDID; pIn: String): HResult; overload; virtual;
505 function CmdSet_I(cmdID: CMDID; pIn: Integer): HResult; overload; virtual;
506 function QueryStatus(cmdID: CMDID): OLECMDF; virtual;
507 function QueryEnabled(cmdID: CMDID): Boolean; virtual;
508 function QueryLatched(cmdID: CMDID): Boolean;
509 function BeginUndoUnit(aTitle: String = 'Default'): HResult;
510 function EndUndoUnit: HResult;
511 procedure Refresh;
512 property DocumentHTML: String read GetDocumentHTML write SetDocumentHTML;
513 property Busy: Boolean read Get_Busy;
514 function GetStyles: String;
515 function GetBuildInStyles: String;
516 function GetExternalStyles: String;
517 function SetStyle(aStyleName: string): HResult; safecall;
518 function GetStylesIndex: Integer; overload; safecall;
519 function GetStylesIndex(aList: String): Integer; overload; safecall;
520 function GetFonts: String;
521 function GetFontSizeIndex(const aList: String; var Changed: String): Integer; safecall;
522 function GetFontNameIndex(aList: String): Integer; safecall;
523 function GetCurrentFontName: string;
524 function SelectedDocumentHTML(var SelStart, SelEnd: Integer): String;
525 procedure SyncDOC(HTML: string; SelStart, SelEnd: Integer);
526 function Print(value: TPrintSetup; Showdlg: boolean = false): Boolean;
527 function PrintEx(value: Olevariant; Showdlg: boolean): HResult; overload;
528 function PrintPreview(value: Olevariant): HResult; overload;
529 function PrintPreview(value: TPrintSetup): Boolean; overload;
530 procedure PrintDocument(var withUI: OleVariant);
531 property ActualAppName: string read GetActualAppName write SetActualAppName;
532 property ActualTxtRange: IHTMLTxtRange read GetActualTxtRange;
533 property ActualControlRange: IHTMLControlRange read GetActualControlRange;
534 property ActualElement: IHTMLElement read GetActualElement;
535 property ActualRangeIsText: Boolean read FActualRangeIsText;
536 function IsSelElementLocked: boolean;
537 Function GetFirstSelElement(const aTag: String = ''): IHTMLElement;
538 Function GetNextSelElement(const aTag: String = ''): IHTMLElement;
539 procedure GetSelParentElement;
540 function GetSelParentElementType(const aType: string; aMessage: string = ''): IHTMLElement;
541 Function IsSelType(aType: string): boolean;
542 Function IsSelElementID(const ID: String): Boolean;
543 Function IsSelElementClassName(const ClassName: String): Boolean;
544 Function IsSelElementTagName(const TagName: String): Boolean;
545 Function IsSelElementInVisible: Boolean;
546 function IsSelElementAbsolute: boolean;
547 Function GetSelText: String;
548 procedure TrimSelection;
549 procedure SelectActualTextrange;
550 procedure SelectElement(aElement: IhtmlElement);
551 function SetCursorAtElement(aElement: IhtmlElement; ADJACENCY:_ELEMENT_ADJACENCY): Boolean;
552 procedure CollapseActualTextrange(Start: boolean);
553 procedure KeepSelectionVisible;
554 procedure GetElementUnderCaret;// Refresh Selection
555 function MovePointersToRange(const aRange: IHTMLTxtRange): HResult;
556 function MovePointersToSel: HResult;
557 function CreateElement(const tagID: _ELEMENT_TAG_ID; var NewElement: IHTMLElement; const aTxtRange: IHTMLTxtRange = nil; const Attributes: string = ''): HResult;
558 function InsertElementAtCursor(var aElement: IHTMLElement; const aTxtRange: IHTMLTxtRange = nil): HResult;
559 function MoveTextRangeToPointer(aTxtRange: IHTMLTxtRange = nil): IHTMLTxtRange ;
560 function CreateMetaTag(var aMetaElement: IHTMLMetaElement): HResult;
561 property SelNumberOfElements: Integer read GetSelLength;
562 property Selection: Boolean read FSelection;
563 published
564 // EditDesigner
565 property OnPreHandleEvent: TEditDesignerEvent read FPreHandleEvent write FPreHandleEvent;
566 property OnPostHandleEvent: TEditDesignerEvent read FPostHandleEvent write FPostHandleEvent;
567 property OnPostEditorEventNotify: TEditDesignerEvent read FPostEditorEventNotify write FPostEditorEventNotify;
568 property OnTranslateAccelerator: TEditDesignerEvent read FEDTranslateAccelerator write FEDTranslateAccelerator;
569 property OnKeyDown: TNotifyEventEx8 read FOnKeyDown write FOnKeyDown;
570 property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
571 property OnKeyUp: TNotifyEventEx8 read FOnKeyUp write FOnKeyUp;
572 property OnClick: TNotifyEvent read FOnClick write FOnClick;
573 property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
574 property OnMouseDown: TMouseEventEx read FOnMouseDown write FOnMouseDown;
575 property OnMouseMove: TMouseEventEx read FOnMouseMove write FOnMouseMove;
576 property OnMouseUp: TMouseEventEx read FOnMouseUp write FOnMouseUp;
577 property Onmouseout: TNotifyEvent read FOnmouseout write FOnmouseout;
578 property LocalUndoManager: WordBool read FLocalUndo write Set_LocalUndo;
579 property Generator: String read GetGenerator write Set_Generator;
580 //grid stuff
581 property SnapToGridX: Integer read FGridX write SetGridX default 50;
582 property SnapToGridY: Integer read FGridY write SetGridY default 50;
583 property SnapToGrid: Boolean read FSnapEnabled write SetSnapEnabled Default true;
584 //ktproperty OnSnapRect: TSnapRect read FExtSnapRect write FExtSnapRect;
585 property BrowseMode: WordBool read GetBrowseMode write SetBrowseMode;
586 property ShowDetails: boolean read FShowDetails write SetShowDetails;
587 property UseDivOnCarriageReturn: WordBool read Get_UseDivOnCarriageReturn write Set_UseDivOnCarriageReturn;
588 property OnContextMenuAction: TDHTMLEditContextMenuAction read FOnContextMenuAction write FOnContextMenuAction;
589 property OnDisplayChanged: TNotifyEvent read FOnDisplayChanged write FOnDisplayChanged;
590 // IDOCHOSTUIHANDLER
591 property OnShowContextMenu: TShowContextMenuEvent read FOnShowContextmenu write FOnShowContextmenu;
592 property OnShowContextMenuEx: TShowContextMenuEventEx read FOnShowContextmenuEx write FOnShowContextmenuEx;
593 property OnQueryService: TQueryServiceEvent read FOnQueryService write FOnQueryService;
594 property OnPreDrag: TNotifyEventEx read FOnPreDrag write FOnPreDrag;
595 property OnTranslateURL: TTranslateURLEvent read FOnTranslateURL write FOnTranslateURL;
596 property OnBeforeCloseFile: TNotifyEventEx2 read FBeforeCloseFile write FBeforeCloseFile;
597 property OnBeforeSaveFile: TNotifyEvent read FBeforeSaveFile write FBeforeSaveFile;
598 property OnAfterSaveFile: TNotifyEvent read FAfterSaveFile write FAfterSaveFile;
599 property OnAfterSaveFileAs: TNotifyEvent read FAfterSaveFileAs write FAfterSaveFileAs;
600 property OnAfterLoadFile: TNotifyEventEx2 read FAfterLoadFile write FAfterLoadFile;
601 property OnEDMessageHandler: TMessageEvent read FEDMessageHandler write FEDMessageHandler;
602 property OnMessageHandler: TMessageEventEx read FMessageHandler write FMessageHandler;
603 property OnBlur: TNotifyEvent read FOnBlur write FOnBlur;
604 Property OnInitialize: TNotifyEventEx4 read FOnInitialize write FOnInitialize;
605 property OnBeforePrint: TNotifyEventEx read FonBeforePrint write FonBeforePrint;
606 property OnAfterPrint: TNotifyEventEx read FonAfterPrint write FonAfterPrint;
607 property OnUnloadDoc: TNotifyEventEx read FOnUnloadDoc write FOnUnloadDoc;
608 property OnRefreshBegin: TRefreshEvent read FOnRefreshBegin write FOnRefreshBegin;
609 property OnRefreshEnd: TNotifyEvent read FOnRefreshEnd write FOnRefreshEnd;
610 property OnDocumentComplete: TNotifyEvent read FOnDocumentComplete write FOnDocumentComplete;
611 property Appearance: TDHTMLEDITAPPEARANCE read Get_Appearance write Set_Appearance;
612 property BaseURL: String read GetBaseURL write SetBaseURL;
613 property Scrollbars: WordBool read Get_Scrollbars write Set_Scrollbars default true;
614 property ScrollbarAppearance: TDHTMLEDITAPPEARANCE read Get_ScrollbarAppearance write Set_ScrollbarAppearance;
615 property AbsoluteDropMode: Boolean read Get_AbsoluteDropMode write Set_AbsoluteDropMode;
616 property _2DPosition: Boolean read F2DPosition write Set2DPosition;
617 property LiveResize: Boolean read FLiveResize write SetLiveResize;
618 //the editor will try to load a file from paramstr(1) - has no meaning inside a OCX
619 property ParamLoad: Boolean read FParamLoad write FParamLoad;
620 end;
621
622
623threadVar
624 TheActualAppName: String;
625
626
627procedure Register;
628
629implementation
630
631uses SysUtils, dialogs, FileCtrl, ComObj,
632 {$IFDEF EDUNDO} UUndo, {$ENDIF}
633 {$IFDEF EDTABLE} EmbedEDTable, {$ENDIF}
634 {$IFDEF EDMONIKER} KS_EDMoniker, {$ENDIF}
635 {$IFDEF EDGLYPHS} CustomGlyphs, {$ENDIF}
636 {$IFDEF EDLIB} EDLIB, {$ENDIF}
637 {$IFDEF EDPARSER} KSIEParser, {$ENDIF}
638 {$IFDEF EDDRAGDROP} dragdrop, {$ENDIF}
639 {$IFDEF EDZINDEX} UZindex, {$ENDIF}
640 math, //kt
641 {$IFDEF EDDESIGNER} UEditDesigner, {$ENDIF}
642
643 UEditHost, KS_Procs, KS_Procs2, IEDispConst, RegFuncs;
644
645const
646 DLCTL_DLIMAGES = $00000010;
647 DLCTL_VIDEOS = $00000020;
648 DLCTL_BGSOUNDS = $00000040;
649 DLCTL_PRAGMA_NO_CACHE = $00004000;
650
651 CancelPosible: Boolean = true;
652
653//------------------------------------------------------------------------------
654procedure Register;
655begin
656 RegisterComponents('KS', [TEmbeddedED]);
657end;
658//------------------------------------------------------------------------------
659constructor TEmbeddedED.Create(Owner: TComponent);
660begin
661 //asm int 3 end; //trap
662
663 inherited Create(Owner);
664
665 FContextMenu := TPopupMenu.Create(nil);
666
667 FStyles := TStringList.Create;
668 FStyles.Sorted := true;
669 FStyles.Duplicates := dupIgnore;
670
671 FGridX := 50; //default values on startup
672 FGridY := 50;
673 FSnapEnabled := true;
674
675 FUserInterfaceOptions := [];
676 // default = Border, ScrollBar, 3DScrollBar, NoDivBlockOnReturn
677
678 FGenerator := 'KS MSHTML Edit 1.0'; //set default value
679
680 {$IFDEF DEBUG}
681 FDEbug := True;
682 {$ENDIF}
683end;
684//------------------------------------------------------------------------------
685destructor TEmbeddedED.Destroy;
686var
687 CP: ICOnnectionPoint;
688begin
689 //asm int 3 end; //trap
690
691 FDestroyng := true;
692 UnSubClassMsHTML; //just in case
693 FOleInPlaceActiveObject := nil;
694
695
696 if (DWEBbrowserEvents2Cookie <> 0) and GetWebBrowserConnectionPoint(CP)
697 then CP.UnAdvise(DWEBbrowserEvents2Cookie);
698
699 FContextMenu.free;
700
701 if assigned(FEditHost)
702 then TObject(FEditHost).free;
703
704 if FEdit <> nil
705 then TObject(FEdit).Free;
706
707 if FTUndo <> nil
708 then TObject(FTUndo).Free;
709
710 if FTZindex <> nil
711 then TObject(FTZindex).Free;
712
713 if FTtable <> nil
714 then TObject(FTtable).Free;
715
716 FStyles.free;
717 FFonts.free;
718
719 inherited Destroy;
720end;
721//------------------------------------------------------------------------------
722function TEmbeddedED.ComponentInDesignMode: Boolean;
723begin
724 //asm int 3 end; //trap
725
726 result := (csDesigning in ComponentState);
727
728 {$IFDEF EDOCX}
729 if Assigned(FAXCtrl)
730 then begin
731 //we are using the component from an OCX
732 try
733 result := not (TActiveXControl(FAXCtrl).ClientSite as IAmbientDispatch).UserMode;
734 except
735 //just catch any error - we are NOT in design mode
736 result := false;
737 end;
738 end;
739 {$ENDIF}
740end;
741//------------------------------------------------------------------------------
742procedure TEmbeddedED.loaded;
743var
744 CP: ICOnnectionPoint;
745begin
746 //asm int 3 end; //trap
747
748 inherited loaded;
749
750 if ComponentInDesignMode
751 then exit;
752
753 { TEmbeddedED's OnDocumentComplete override TWebbrowser's OnDocumentComplete
754 We sink all DWEBbrowserEvents2 - although we only use OnDocumentComplete }
755
756 if GetWebBrowserConnectionPoint(CP)
757 then CP.Advise(self, DWEBbrowserEvents2Cookie) //send events to TEmbeddedED.Invoke
758 else KSMessageE('TWebBrowser''s ICOnnectionPoint could not be found');
759
760 //set standard Download Control Values
761 FDownloadControlValue := DLCTL_BGSOUNDS + //download sounds
762 DLCTL_DLIMAGES + //download images
763 DLCTL_VIDEOS + //download videos
764 DLCTL_PRAGMA_NO_CACHE; //don't use the cache
765
766 SetUserInterfaceValue;
767
768 //linking in the EditHost
769 FEditHost := TEditHost.Create(self);
770 TEditHost(FEditHost).FSnapEnabled := FSnapEnabled;
771 TEditHost(FEditHost).FGridX := FGridX;
772 TEditHost(FEditHost).FGridY := FGridY;
773 //ktTEditHost(FEditHost).FExtSnapRect := FExtSnapRect;
774 TEditHost(FEditHost).FOnPreDrag := FOnPreDrag;
775
776 {$IFDEF EDDESIGNER}
777 //linking in the EditDesigner
778 FEdit := Pointer(TEditDesigner.Create(self));
779
780 TEditDesigner(FEdit).FPreHandleEvent := FPreHandleEvent;
781 TEditDesigner(FEdit).FPostHandleEvent := FPostHandleEvent;
782 TEditDesigner(FEdit).FPostEditorEventNotify := FPostEditorEventNotify;
783 TEditDesigner(FEdit).FOnDblClick := FOnDblClick;
784 TEditDesigner(FEdit).FOnClick := FOnClick;
785 TEditDesigner(FEdit).FOnKeyPress := FOnKeyPress;
786 TEditDesigner(FEdit).FOnReadystatechange := FOnReadystatechange;
787 TEditDesigner(FEdit).FEDTranslateAccelerator := FEDTranslateAccelerator;
788 TEditDesigner(FEdit).FDebug := FDebug;
789 TEditDesigner(FEdit).FOnMouseMove := FOnMouseMove;
790 TEditDesigner(FEdit).FOnMouseUp := FOnMouseUp;
791 TEditDesigner(FEdit).FOnMouseDown := FOnMouseDown;
792 TEditDesigner(FEdit).FOnKeyUp := FOnKeyUp;
793 TEditDesigner(FEdit).FOnKeyDown := FOnKeyDown;
794 TEditDesigner(FEdit).FOnmouseout := FOnmouseOut;
795 TEditDesigner(FEdit).FOnmouseover := EDOnmouseover;
796 {$ENDIF}
797
798
799 {$IFDEF EDZINDEX}
800 FTZindex := Pointer(TZindex.Create(self));
801 {$ENDIF}
802
803 {$IFDEF EDTABLE}
804 FTtable := Pointer(TTable.Create(self));
805 {$ENDIF}
806
807
808 FIEVersion := ReadRegString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Internet Explorer\', 'Version');
809 if length(FIEVersion) > 0
810 then begin
811 FIE6 := FIEVersion[1] >= '6';
812
813 if (not FIE6)
814 then begin
815 if (FIEVersion[1] < '5') or (FIEVersion[3] < '5')
816 then KSMessageE('This HTML-editor Component '+CrLf+'need IE 5.5 or higher');
817 end;
818 end;
819
820 FWarmingUp := true;
821 AssignDocument; //basic initialisation of MSHTML
822 FWarmingUp := false;
823
824 GetInPlaceActiveObject; //initialise FOleInPlaceActiveObject
825
826 if FShowBorders
827 then CmdSet_B(IDM_SHOWZEROBORDERATDESIGNTIME, true);
828
829 if FEditMode
830 then begin
831 //initialisation of MSHTML edit mode
832
833 {$IFDEF EDLIB}
834 InitializeGenerator(Self);
835 {$ENDIF}
836
837 DOC.designMode := 'On';
838 //CmdSet(IDM_EDITMODE); //Not currently supported - but it works !!
839 end;
840
841 if FAXCtrl = nil //Only do this in VCL mode, the OCX needs a later initialization
842 then EditInitialize;
843end;
844//------------------------------------------------------------------------------
845procedure TEmbeddedED.EditInitialize;
846var
847 aFile: String;
848begin
849 //asm int 3 end; //trap
850
851 if ComponentInDesignMode
852 then exit;
853
854 aFile := '';
855
856 //get a file to open at start-up
857 if Assigned(FOnInitialize)
858 then FOnInitialize(Self, aFile); //get a initial file name
859
860 if FParamLoad and (aFile = '')
861 //if no file yet, look for a param - NB will not work inside an OCX
862 then aFile := Paramstr(1);
863
864 if aFile <> ''
865 then begin
866 if S_OK <> LoadFile(aFile) //load a "command line" / initial file - if any
867 then aFile := '';
868 end;
869
870 if aFile = ''
871 then NewDocument; //load an empty document
872
873 _GetBuildInStyles;
874
875 FSetInitialFocus := true;
876end;
877//------------------------------------------------------------------------------
878procedure TEmbeddedED.SetUserInterfaceValue;
879begin
880 //asm int 3 end; //trap
881
882 FUserInterfaceValue := 0;
883
884 if NoBorder in FUserInterfaceOptions
885 then Inc(FUserInterfaceValue, DOCHOSTUIFLAG_NO3DBORDER);
886
887 if NoScrollBar in FUserInterfaceOptions
888 then Inc(FUserInterfaceValue, DOCHOSTUIFLAG_SCROLL_NO);
889
890 if FlatScrollBar in FUserInterfaceOptions
891 then Inc(FUserInterfaceValue, DOCHOSTUIFLAG_FLAT_SCROLLBAR);
892
893 if DivBlockOnReturn in FUserInterfaceOptions
894 then Inc(FUserInterfaceValue, DOCHOSTUIFLAG_DIV_BLOCKDEFAULT);
895end;
896//------------------------------------------------------------------------------
897procedure TEmbeddedED.SubClassMsHTML;
898begin
899 //asm int 3 end; //trap
900
901 { We hook into the message chain in front of the MSHTML window
902 after the hook is in place all massages send to MSHTML will be passed
903 to EDMessageHandler first }
904
905 if (GetInPlaceActiveObject <> nil) and
906 (FmsHTMLwinHandle <> 0)
907 then begin
908 if EDMessageHandlerPtr <> nil
909 then UnSubClassMsHTML;
910
911 //create handle to EDMessageHandler
912 EDMessageHandlerPtr := MakeObjectInstance(EDMessageHandler);
913
914 //save pointer to the FmsHTMLwinHandle window
915 FmsHTMLwinPtr := Pointer(SetWindowLong(FmsHTMLwinHandle, GWL_WNDPROC, LongInt(EDMessageHandlerPtr)));
916 end;
917end;
918//------------------------------------------------------------------------------
919procedure TEmbeddedED.UnSubClassMsHTML;
920begin
921 //asm int 3 end; //trap
922
923 if (GetInPlaceActiveObject <> nil) and
924 (FmsHTMLwinHandle <> 0) and
925 (EDMessageHandlerPtr <> nil)
926 then begin
927 //restore old MSHTML window as target
928 SetWindowLong(FmsHTMLwinHandle, GWL_WNDPROC, LongInt(FmsHTMLwinPtr));
929
930 FreeObjectInstance(EDMessageHandlerPtr);
931 EDMessageHandlerPtr := nil;
932 end;
933end;
934//------------------------------------------------------------------------------
935procedure TEmbeddedED.SubMessageHandler(var Message: TMessage);
936begin
937 //overridden by derived components
938end;
939
940function TEmbeddedED.SubFocusHandler(fGotFocus: BOOL): HResult;
941//kt added
942begin
943 //overridden by derived components
944end;
945
946//------------------------------------------------------------------------------
947procedure TEmbeddedED.EDMessageHandler(var Message: TMessage);
948var
949 WinMsg: TMsg;
950 handled: boolean;
951 transformed: boolean;
952
953 //----------------------------------------------------------
954 function HandlingDone(handled: Boolean): boolean;
955 begin
956 if handled
957 then Message.Result := 1;
958
959 result := handled;
960 end;
961 //----------------------------------------------------------
962 procedure transformMessage;
963 begin
964 if transformed
965 then exit;
966
967 WinMsg.HWnd := Handle;
968 WinMsg.Message := Message.Msg ;
969 WinMsg.WParam := Message.WParam;
970 WinMsg.LParam := Message.LParam;
971
972 WinMsg.Time := GetMessageTime;
973 GetCursorPos(WinMsg.Pt);
974 transformed := true;
975 end;
976 //----------------------------------------------------------
977begin
978 //asm int 3 end; //trap
979
980 {when key messages arrives heir from a
981 VCL implementation hey they are offset with CN_BASE but can come by
982 a second time with no CN_BASE offset.
983 OCX implementation they are not offset }
984
985 { all messages to MSHTML comes through here - KEEP IT LEAN.
986 if Handled is not set to true then the message is dispatched back to MSHTML. }
987
988 transformed := false;
989 Handled := false;
990
991 if assigned(FMessageHandler) //external assigned message handler
992 then begin
993 FMessageHandler(Self, Message.Msg, Message.WParam, Message.LParam, Message.Result);
994 if Message.Result = 1
995 then exit;
996 end;
997
998 if assigned(FEDMessageHandler) //external assigned message handler
999 then begin
1000 transformMessage;
1001
1002 FEDMessageHandler(WinMsg, handled);
1003 if HandlingDone(handled)
1004 then exit;
1005 end;
1006
1007
1008 {$IFDEF EDTABLE}
1009 //let the "table unit" have a look at the message
1010 if assigned(FTtable) and (Not FDestroyng) and
1011 (TTable(FTtable).CheckMessage(Message))
1012 then exit;
1013 {$ENDIF}
1014
1015
1016 {$IFDEF EDZINDEX}
1017 //let the "UZindex unit" have a look at the message
1018 if assigned(FTZindex) and (Not FDestroyng) and
1019 (TZindex(FTZindex).CheckMessage(Message))
1020 then exit;
1021 {$ENDIF}
1022
1023 SubMessageHandler(Message);
1024 if Message.Result = 1
1025 then exit;
1026
1027
1028 //send the message back to the subclassed MSHTML window
1029 Message.Result := CallWindowProc(FmsHTMLwinPtr, FmsHTMLwinHandle, Message.Msg, Message.WParam, Message.LParam);
1030end;
1031//------------------------------------------------------------------------------
1032function TEmbeddedED.GetWebBrowserConnectionPoint(var CP: ICOnnectionPoint): boolean;
1033var
1034 CPC: IConnectionPointContainer;
1035begin
1036 //asm int 3 end; //trap
1037
1038 TwebBrowser(Self).ControlInterface.QueryInterface(IConnectionPointContainer, CPC);
1039 if assigned(CPC)
1040 then CPC.FindConnectionPoint(DWEBbrowserEvents2, CP);
1041
1042 result := Assigned(CP);
1043end;
1044//------------------------------------------------------------------------------
1045function TEmbeddedED.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
1046 Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
1047var
1048 dps: TDispParams absolute Params;
1049 pDispIds: PDispIdList;
1050 iDispIdsSize: integer;
1051 handled: Boolean;
1052
1053 //-------------------------------------------
1054 procedure BuildPositionalDispIds;
1055 var
1056 i: integer;
1057 begin
1058 pDispIds := nil;
1059 iDispIdsSize := dps.cArgs * SizeOf(TDispId);
1060 GetMem(pDispIds, iDispIdsSize);
1061
1062 // by default, directly arrange in reverse order
1063 for i := 0 to dps.cArgs - 1 do
1064 pDispIds^[i] := dps.cArgs - 1 - i;
1065
1066 if (dps.cNamedArgs > 0) // check for named args
1067 then begin
1068 // parse named args
1069 for i := 0 to dps.cNamedArgs - 1 do
1070 pDispIds^[dps.rgdispidNamedArgs^[i]] := i;
1071 end;
1072 end;
1073 //-------------------------------------------
1074begin
1075 //asm int 3 end; //trap
1076 Result := S_OK;
1077
1078 case Dispid of
1079 DISPID_AMBIENT_DLCONTROL:
1080 if (Flags and DISPATCH_PROPERTYGET <> 0) and (VarResult <> nil)
1081 then begin
1082 PVariant(VarResult)^ := FDownloadControlValue;
1083 Exit;
1084 end;
1085
1086 259: //DWebBrowserEvents2.OnDocumentComplete
1087 if dps.cArgs > 0
1088 then begin
1089 BuildPositionalDispIds;
1090 //call the our DocumentComplete event handler
1091 DocumentComplete(self, //Sender: TObject
1092 IDispatch(dps.rgvarg^[pDispIds^[0]].dispval), //pDisp: IDispatch
1093 POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^, //URL: OleVariant
1094 handled);
1095 FreeMem (pDispIds, iDispIdsSize);
1096 Exit;
1097 end;
1098
1099 104 : //DWebBrowserEvents2.DownloadComplete
1100 begin
1101 EDOnDownloadComplete(Self);
1102 Exit;
1103 end;
1104
1105 DISPID_HTMLWINDOWEVENTS2_ONBLUR:
1106 if dps.cArgs > 0
1107 then begin
1108 BuildPositionalDispIds;
1109 EDOnDocBlur(self, //Sender: TObject
1110 IHTMLEventObj(dps.rgvarg^[pDispIds^[0]].dispval)); //pEvtObj: IHTMLEventObj
1111 FreeMem (pDispIds, iDispIdsSize);
1112 Exit;
1113 end;
1114
1115 DISPID_HTMLWINDOWEVENTS2_ONUNLOAD:
1116 if dps.cArgs > 0
1117 then begin
1118 BuildPositionalDispIds;
1119 EDOnUnloadDoc(self, //Sender: TObject
1120 IHTMLEventObj(dps.rgvarg^[pDispIds^[0]].dispval)); //pEvtObj: IHTMLEventObj
1121 FreeMem (pDispIds, iDispIdsSize);
1122 Exit;;
1123 end;
1124
1125 DISPID_HTMLWINDOWEVENTS2_ONAFTERPRINT:
1126 if dps.cArgs > 0
1127 then begin
1128 BuildPositionalDispIds;
1129 EDAfterPrint(self, //Sender: TObject
1130 IHTMLEventObj(dps.rgvarg^[pDispIds^[0]].dispval)); //pEvtObj: IHTMLEventObj
1131 FreeMem (pDispIds, iDispIdsSize);
1132 Exit;
1133 end;
1134
1135 DISPID_HTMLWINDOWEVENTS2_ONBEFOREPRINT:
1136 if dps.cArgs > 0
1137 then begin
1138 BuildPositionalDispIds;
1139 EDBeforePrint(self, //Sender: TObject
1140 IHTMLEventObj(dps.rgvarg^[pDispIds^[0]].dispval)); //pEvtObj: IHTMLEventObj
1141 FreeMem (pDispIds, iDispIdsSize);
1142 Exit;
1143 end;
1144
1145 DISPID_HTMLDOCUMENTEVENTS2_ONDRAGSTART:
1146 if dps.cArgs > 0
1147 then begin
1148 BuildPositionalDispIds;
1149 EDBeforeDragStart(self, //Sender: TObject
1150 IHTMLEventObj(dps.rgvarg^[pDispIds^[0]].dispval)); //pEvtObj: IHTMLEventObj
1151 FreeMem (pDispIds, iDispIdsSize);
1152 Exit;
1153 end;
1154
1155
1156 DISPID_HTMLELEMENTEVENTS2_ONMOVESTART:
1157 Beep;
1158
1159 (*
1160 //return S_OK for unhandled members of HTMLWindowEvents2
1161 1002, 1003, 1014, 1016, 1017, -2147418102, -2147418111: exit;
1162
1163 //return S_OK for unhandled members of DWebBrowserEvents2
1164 102, 105, 106, 108, 112, 113, 250, 251, 252, 253, 254, 255, 256,
1165 257, 258, 260, 262, 236, 234, 265, 266, 267, 268, 269, 270 : exit;
1166 *)
1167 end; //case
1168
1169 //let TOleControl handle the invoke
1170 Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);
1171end;
1172//------------------------------------------------------------------------------
1173function TEmbeddedED.GetTypeInfoCount(out Count: Integer): HResult;
1174begin
1175 //asm int 3 end; //trap
1176 Result := inherited GetTypeInfoCount(Count);
1177end;
1178//------------------------------------------------------------------------------
1179function TEmbeddedED.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
1180begin
1181 //asm int 3 end; //trap
1182 Result := inherited GetTypeInfo(Index, LocaleID, TypeInfo);
1183end;
1184//------------------------------------------------------------------------------
1185function TEmbeddedED.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
1186begin
1187 //asm int 3 end; //trap
1188 Result := inherited GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs);
1189end;
1190//------------------------------------------------------------------------------
1191function TEmbeddedED.OnChanged(dispid: TDispID): HResult;
1192var
1193 dp: TDispParams;
1194 vResult: OleVariant;
1195begin
1196 //asm int 3 end; //trap
1197
1198 { Dispid = Dispatch identifier of the property that changed,
1199 or DISPID_UNKNOWN if multiple properties have changed. }
1200 if (TwebBrowser(Self).Document <> nil) and (DISPID_READYSTATE = Dispid)
1201 then begin
1202 if SUCCEEDED(Doc.Invoke(DISPID_READYSTATE, GUID_null,
1203 LOCALE_SYSTEM_DEFAULT, DISPATCH_PROPERTYGET,
1204 dp, @vresult, nil, nil))
1205 then FReadyState := Integer(vresult);
1206 end;
1207
1208 result := inherited OnChanged(dispid);
1209end;
1210//------------------------------------------------------------------------------
1211function TEmbeddedED.OnRequestEdit(dispid: TDispID): HResult;
1212begin
1213 //asm int 3 end; //trap
1214 result := inherited OnRequestEdit(dispid);
1215end;
1216//------------------------------------------------------------------------------
1217procedure TEmbeddedED.EDBeforeDragStart(Sender: TObject; const pEvtObj: IHTMLEventObj);
1218var
1219 Done: Boolean;
1220begin
1221 //asm int 3 end; //trap
1222
1223 beep;
1224
1225 if assigned(FonBeforePrint)
1226 then begin
1227 Done := false;
1228 beep;
1229 //FonBeforePrint(self, Done);
1230 if Done
1231 then pEvtObj.returnValue := True;
1232 end;
1233end;
1234//------------------------------------------------------------------------------
1235procedure TEmbeddedED.EDBeforePrint(Sender: TObject; const pEvtObj: IHTMLEventObj);
1236var
1237 Done: Boolean;
1238begin
1239 //asm int 3 end; //trap
1240
1241 if assigned(FonBeforePrint)
1242 then begin
1243 Done := false;
1244 FonBeforePrint(self, Done);
1245 if Done
1246 then pEvtObj.returnValue := True;
1247 end;
1248end;
1249//------------------------------------------------------------------------------
1250procedure TEmbeddedED.EDAfterPrint(Sender: TObject; const pEvtObj: IHTMLEventObj);
1251 { MSHTML stores a copy of the HTML source in a cache from where it is printed.
1252
1253 EDAfterPrint is fired when MSHTML has finished saving the document,
1254 at the state it vas in, into cache }
1255var
1256 Done: Boolean;
1257begin
1258 //asm int 3 end; //trap
1259 FPrintFinished := true;
1260
1261 if assigned(FonAfterPrint)
1262 then begin
1263 Done := false;
1264 FonAfterPrint(self, Done);
1265 if Done
1266 then pEvtObj.returnValue := True;
1267 end;
1268end;
1269//------------------------------------------------------------------------------
1270procedure TEmbeddedED.EDOnUnloadDoc(Sender: TObject; const pEvtObj: IHTMLEventObj);
1271var
1272 Done: Boolean;
1273begin
1274 //asm int 3 end; //trap
1275
1276 FStylesRefreshed := False; //we need to load a fresh set together with the next document
1277
1278 if assigned(FOnUnloadDoc)
1279 then begin
1280 Done := false;
1281 FOnUnloadDoc(self, Done);
1282 if Done
1283 then pEvtObj.returnValue := True;
1284 end;
1285end;
1286//------------------------------------------------------------------------------
1287procedure TEmbeddedED.EDOnDocBlur(Sender: TObject; const pEvtObj: IHTMLEventObj);
1288begin
1289 //asm int 3 end; //trap
1290
1291 if FWarmingUp
1292 then exit;
1293
1294 {$IFDEF EDLIB}
1295 KeepSelection(Self);
1296 {$ENDIF}
1297
1298 {$IFDEF EDTABLE}
1299 if assigned(FTtable) and (Not FDestroyng)
1300 then TTable(FTtable).TblOnBlur;
1301 {$ENDIF}
1302
1303 if Assigned(FOnBlur)
1304 then FOnBlur(Self);
1305end;
1306//------------------------------------------------------------------------------
1307procedure TEmbeddedED.EDOnDownloadComplete(Sender: TObject);
1308var
1309 aURL: OleVariant;
1310 handled: Boolean;
1311begin
1312 //asm int 3 end; //trap
1313
1314 if FRefreshing
1315 //Refresh page and some other things don't result in a Document complete
1316 then begin
1317 FRefreshing := False;
1318
1319 aURL := Doc.URL;
1320 DocumentComplete(Self, nil, aURL, handled);
1321
1322 If Assigned(FOnRefreshEnd)
1323 then FOnRefreshEnd(Self);
1324 end;
1325end;
1326//------------------------------------------------------------------------------
1327procedure TEmbeddedED.WaitAsync;
1328begin
1329 //asm int 3 end; //trap
1330
1331 FWaitMessage := false;
1332
1333 PostMessage(FMainWinHandle, WaitAsync_MESSAGE, 0, 0);
1334
1335 while not FWaitMessage do
1336 SafeYield;
1337end;
1338//------------------------------------------------------------------------------
1339Procedure TEmbeddedED.GetSourceSnapShot;
1340{$IFNDEF EDLIB}
1341 var
1342 TempStream: TMemoryStream;
1343{$ENDIF}
1344begin
1345 //asm int 3 end; //trap
1346
1347 {$IFNDEF EDLIB}
1348 { First we need to force MSHTML to tidy up the source the way it wants.
1349 MSHTML inserts and updates certain elements in the <HEAD> when it saves
1350 the file }
1351
1352 TempStream := TMemoryStream.Create;
1353 try
1354 //just a dummy save
1355 PersistStream.save(TStreamAdapter.Create(TempStream), true);
1356 finally
1357 TempStream.free;
1358 end;
1359 {$ENDIF}
1360
1361 FHTMLImage := KS_Lib.GetHTMLtext(DOC); //Get Snapshot of HTML Source
1362end;
1363//------------------------------------------------------------------------------
1364procedure TEmbeddedED.ShowCaret;
1365begin
1366 //asm int 3 end; //trap
1367 FCaret.Show(0);
1368end;
1369//------------------------------------------------------------------------------
1370procedure TEmbeddedED.GetBaseTag(var BaseTagInDoc: Boolean; var BaseUrl: String);
1371var
1372 aElement: IHTMLElement;
1373 aCollection: IHTMLElementCollection;
1374 aDomNode, HTMLF, HTMLP: IHTMLDomNode;
1375 i: integer;
1376 DOC3: IHTMLDocument3;
1377 S: String;
1378 I2: Integer;
1379 DESIGNTIMEBASEURLfound: Boolean;
1380begin
1381 //asm int 3 end; //trap
1382 { if the source have a <BASE...> tag without a </BASE> tag, IE renders
1383 the source wrongly and we must correct it.
1384
1385 If <BASE> is followed by other tags in the <HEAD> these may end up as
1386 children of <BASE> rather than children of <HEAD>
1387
1388 The problem does not appear if the <BASE...> tag is followed by </BASE>
1389
1390 Parsing trough IHTMLDomNode MSHTML not only it places the body in the
1391 wrong place, but it also duplicates it:
1392
1393 HTML
1394 |-HEAD
1395 | |-TITLE
1396 | |-BASE
1397 | |-META
1398 | |-META
1399 | |-BODY
1400 |-BODY
1401
1402 Parsed trough IHTMLElement MSHTML produces a tree that looks like this:
1403
1404 HTML
1405 |-HEAD
1406 |-TITLE
1407 |-BASE
1408 |-META
1409 |-META
1410 |-BODY
1411
1412
1413 The following code will cleanup a bad example as this:
1414
1415 <html>
1416 <head>
1417 <title>test</title>
1418 <base target="_self" href="URL">
1419 <meta name="1" content="1">
1420 <base target="_self" href="UL">
1421 <meta name="2" content="2">
1422 </head>
1423 <body>
1424 empty
1425 </body>
1426 </html>
1427
1428 }
1429
1430 BaseTagInDoc := false;
1431 DESIGNTIMEBASEURLfound := false;
1432 BaseURL := '';
1433
1434 DOC3 := DOC as IHTMLDocument3;
1435
1436 aCollection := DOC3.getElementsByTagName('BASE') as IHTMLElementCollection;
1437 if aCollection.length > 0
1438 then begin
1439 for i := 0 to aCollection.length - 1 do
1440 begin
1441 aElement := aCollection.item(i, 0) as IHTMLElement;
1442
1443 if not assigned(aElement)
1444 then continue;
1445
1446 // we take the BaseURL from the last found base tag except if
1447 // its a DESIGNTIMEBASEURL
1448 if pos('DESIGNTIMEBASEURL', UpperCase(aElement.outerHTML)) = 0
1449 then begin
1450 BaseURL := (aElement as IHTMLBaseElement).href;
1451 BaseTagInDoc := true;
1452 end
1453 else DESIGNTIMEBASEURLfound := true;
1454
1455 aDomNode := aElement as IHTMLDomNode;
1456 if aDomNode.hasChildNodes
1457 then begin
1458 HTMLP := aDomNode.parentNode;
1459 HTMLF := aDomNode.firstChild;
1460 aDomNode.removeNode(false); //false = do not remove child nodes
1461 HTMLP.insertBefore(aDomNode, HTMLF);
1462 end;
1463
1464 end; //for i := 0 to
1465 end;
1466
1467 if DESIGNTIMEBASEURLfound
1468 then begin
1469 aCollection := DOC3.getElementsByTagName('BASE') as IHTMLElementCollection;
1470 if aCollection.length > 0
1471 then begin
1472 for i := 0 to aCollection.length - 1 do
1473 begin
1474 aElement := aCollection.item(i, 0) as IHTMLElement;
1475
1476 if assigned(aElement) and
1477 (pos('DESIGNTIMEBASEURL', UpperCase(aElement.outerHTML)) > 0)
1478 then begin
1479 //remove any temporary BASE tag
1480 aDomNode := aElement as IHTMLDomNode;
1481 aDomNode.removeNode(false);
1482 end
1483 end;
1484 end;
1485 end;
1486end;
1487//------------------------------------------------------------------------------
1488procedure TEmbeddedED.DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant; var HandlingComplete: Boolean);
1489var
1490 IW: IwebBrowser2;
1491 adoc: IhtmlDocument2;
1492 iDocDisp: IDispatch;
1493
1494 //-----------------------------------------------------------
1495 procedure OpenPointers;
1496 var
1497 FDisplayServices: IDisplayServices;
1498 begin
1499 //asm int 3 end; //trap
1500
1501 {$IFDEF EDDESIGNER}
1502 if assigned(FEdit)
1503 then TEditDesigner(FEdit).Connect(TWebBrowser(self).Document); //Connect EditDesigner
1504 {$ENDIF}
1505
1506 {$IFDEF EDTABLE}
1507 if assigned(FTtable)
1508 then TTable(FTtable).OpenPointers;
1509 {$ENDIF}
1510
1511 FDisplayServices := DOC as IDisplayServices;
1512 OleCheck(FDisplayServices.GetCaret(IHTMLCaret(FCaret)));
1513
1514 OleCheck(FDisplayServices.CreateDisplayPointer(FDisplayPointerStart));
1515 OleCheck(FDisplayServices.CreateDisplayPointer(FDisplayPointerEnd));
1516 OleCheck(FDisplayServices.CreateDisplayPointer(FTMGDisplayPointer)); //kt added
1517
1518 //kt FMarkUpServices := Doc as MSHTML_TLB.IMarkupServices;
1519 FMarkUpServices := Doc as MSHTML_EWB.IMarkupServices; //kt
1520
1521 OleCheck(FMarkUpServices.CreateMarkupPointer(FMarkupPointerStart));
1522 OleCheck(FMarkUpServices.CreateMarkupPointer(FMarkupPointerEnd));
1523
1524 FHighlight := Doc as IHighlightRenderingServices;
1525
1526 FRenderStyle := (TwebBrowser(Self).Document as IHTMLDocument4).createRenderStyle('');
1527
1528 //false turns off (default) black and uses $8A2BE2 as highlight colour
1529 FRenderStyle.Set_defaultTextSelection('false');
1530 FRenderStyle.Set_textBackgroundColor($8A2BE2);
1531 end;
1532 //----------------------------------------------------
1533begin
1534 //asm int 3 end; //trap
1535
1536 { a derived component need a way to know if this DocumentComplete is completely
1537 handled - i.e. when we sets the BaseUrl - or this is a "real" DocumentComplete.
1538 If this eventhandler isn't exited then HandlingComplete is set to false at
1539 the very end }
1540 HandlingComplete := true;
1541
1542 if FWarmingUp
1543 then exit;
1544
1545 //just a test that newer seems to become true
1546 if Fdebug and (FReadyState <> READYSTATE_COMPLETE)
1547 then beep;
1548
1549 iDocDisp := (pDisp as IwebBrowser2).Document;
1550
1551 // NOTE: iDocDisp may be NIL or may be not an HTML document!!!
1552 if (iDocDisp = nil) or
1553 (iDocDisp.QueryInterface(IHTMLDocument2, aDoc) <> S_OK) or
1554 (aDoc <> DOC)
1555 then exit;
1556
1557 ShowCursor(true);
1558
1559 if not FSettingBaseURL
1560 then begin
1561 if not FkeepPath
1562 then begin
1563 FCurrentDocumentPath := GetPersistedFile;
1564 FBaseUrl := _CurDir;
1565 end;
1566
1567 { according to DHTMLEdit specs FBaseURL is set to the loaded files base.
1568 If the loaded file contains a BASE tag then BASEUrl is set accordingly
1569 in InitializeUndoStack }
1570
1571 {$IFDEF EDLIB}
1572 InitializeUndoStack(Self, FBaseTagInDoc, FBaseUrl);
1573 {$ELSE}
1574 GetBaseTag(FBaseTagInDoc, FBaseUrl);
1575 if not BrowseMode
1576 then _CheckGenerator;
1577 {$ENDIF}
1578
1579 {$IFDEF EDUNDO}
1580 if FLocalUndo
1581 then OpenChangeLog;
1582 {$ENDIF}
1583 end;
1584
1585 FkeepPath := false;
1586
1587
1588 //restore WYSIWYG scroll position if needed
1589 if FScrollTop > 0
1590 then ScrollDoc(FScrollTop);
1591
1592 OpenPointers;
1593
1594 if FEditMode
1595 then begin
1596 if FShowDetails
1597 then begin
1598 {$IFDEF EDGLYPHS}
1599 ShowDefaultGlyphs(Self);
1600 {$ELSE}
1601 CmdSet(IDM_SHOWALLTAGS);
1602 {$ENDIF}
1603 end;
1604
1605 //kt if F2DPosition
1606 //kt then CmdSet_B(IDM_2D_POSITION, true);
1607
1608 //kt if FLiveResize
1609 //kt then CmdSet_B(IDM_LIVERESIZE, true);
1610
1611 //set cursor to beginning of document
1612 SetCursorAtElement(DOC.elementFromPoint(1,1), ELEM_ADJ_AfterBegin);
1613 end;
1614
1615 HookEvents;
1616
1617 if FSettingBaseURL //nothing more to do
1618 then begin
1619 FSettingBaseURL := false;
1620 exit;
1621 end;
1622
1623 if FLoadFromString
1624 then begin
1625 FLoadFromString := false;
1626 FHTMLImage := ''; //a document loaded from a string is always dirty
1627
1628 if FEditMode
1629 then ClearUndoStack; //we cant allow old undo's after loading a "new" document
1630 end
1631 else begin
1632 if FEditMode
1633 then GetSourceSnapShot;
1634 end;
1635
1636 //if we have a user created event handler call it
1637 if assigned(FOnDocumentComplete)
1638 then FOnDocumentComplete(Self);
1639
1640 HandlingComplete := false;
1641end;
1642//------------------------------------------------------------------------------
1643procedure TEmbeddedED.HookEvents;
1644var
1645 aCPC: IConnectionPointContainer;
1646 aCP: IConnectionPoint;
1647 aCookie: Integer;
1648begin
1649 //asm int 3 end; //trap
1650
1651 Doc.parentWindow.QueryInterface(IConnectionPointContainer, aCPC);
1652
1653 //this events is automatically released when the document is unloaded
1654 aCPC.FindConnectionPoint(HTMLWindowEvents2, aCP);
1655 aCP.Advise(self, aCookie); //send events to TEmbeddedED.Invoke
1656
1657 {$IFDEF EDZINDEX}
1658 if Assigned(FTZindex)
1659 then TZindex(FTZindex).HookEvents;
1660 {$ENDIF}
1661
1662 //IpropertyNotifySink is automatic connected, so we do nothing here
1663end;
1664//------------------------------------------------------------------------------
1665function TEmbeddedED.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT;
1666begin
1667 //Called from MSHTML to display a context menu
1668 //asm int 3 end; //trap
1669
1670 if Assigned(FOnShowContextmenu)
1671 then begin
1672 Result := FOnSHowContextmenu(dwID, ppt, pcmdtreserved, pdispreserved);
1673 if Result = S_OK
1674 then exit;
1675 end
1676 else Result := S_FALSE;
1677
1678 if assigned(FOnShowContextmenuEx)
1679 then FOnShowContextmenuEx(Self, ppt^.X, ppt^.Y);
1680
1681 if (FContextMenu.Items.count > 0)
1682 then begin
1683 Result := S_OK;
1684 FContextMenu.Popup(ppt^.X, ppt^.Y);
1685 end;
1686end;
1687//------------------------------------------------------------------------------
1688function TEmbeddedED.GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT;
1689begin
1690 //Retrieves the UI capabilities of the MSHTML host
1691 //asm int 3 end; //trap
1692
1693 pInfo.cbSize := SizeOf(pInfo);
1694 pInfo.dwFlags := FUserInterfaceValue;
1695
1696 pInfo.dwDoubleClick := DOCHOSTUIDBLCLK_DEFAULT;
1697 Result:=S_OK;
1698end;
1699//------------------------------------------------------------------------------
1700function TEmbeddedED.ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject; const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame; const pDoc: IOleInPlaceUIWindow): HRESULT;
1701begin
1702 //Allows the host to replace the MSHTML menus and toolbars
1703 //asm int 3 end; //trap
1704 Result := S_FALSE;
1705end;
1706//------------------------------------------------------------------------------
1707function TEmbeddedED.HideUI: HRESULT;
1708begin
1709 //Called when MSHTML removes its menus and toolbars
1710 //asm int 3 end; //trap
1711 Result := E_NOTIMPL;
1712end;
1713//------------------------------------------------------------------------------
1714procedure TEmbeddedED._UpdateUI;
1715begin
1716 //asm int 3 end; //trap
1717 UpdateUI;
1718end;
1719//------------------------------------------------------------------------------
1720function TEmbeddedED.UpdateUI: HRESULT;
1721begin
1722 //Notifies the host that the command state has changed
1723 //asm int 3 end; //trap
1724
1725 Result := S_OK;
1726
1727 if (FReadyState = READYSTATE_COMPLETE) and (not FWarmingUp) and Showing
1728 then begin
1729 if FSetInitialFocus
1730 then begin
1731 SetFocusToDoc;
1732 FSetInitialFocus := false;
1733 end;
1734
1735 GetElementUnderCaret;
1736
1737 if Assigned(FOnDisplayChanged)
1738 then FOnDisplayChanged(self);
1739 end;
1740end;
1741//------------------------------------------------------------------------------
1742function TEmbeddedED.EnableModeless(const fEnable: BOOL): HRESULT;
1743begin
1744 //asm int 3 end; //trap
1745 Result := E_NOTIMPL;
1746end;
1747//------------------------------------------------------------------------------
1748function TEmbeddedED.OnDocWindowActivate(const fActivate: BOOL): HRESULT;
1749begin
1750 //Called from the MSHTML implementation of IOleInPlaceActiveObject.OnDocWindowActivate
1751 //asm int 3 end; //trap
1752 Result := E_NOTIMPL;
1753end;
1754//------------------------------------------------------------------------------
1755function TEmbeddedED.OnFrameWindowActivate(const fActivate: BOOL): HRESULT;
1756begin
1757 //Called from the MSHTML implementation of IOleInPlaceActiveObject.OnFrameWindowActivate
1758 //asm int 3 end; //trap
1759 Result := E_NOTIMPL;
1760end;
1761//------------------------------------------------------------------------------
1762function TEmbeddedED.ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT;
1763begin
1764 //Called from the MSHTML implementation of IOleInPlaceActiveObject.ResizeBorder
1765 //asm int 3 end; //trap
1766 Result := E_NOTIMPL;
1767end;
1768//------------------------------------------------------------------------------
1769function TEmbeddedED.TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT;
1770begin
1771 //asm int 3 end; //trap
1772 { Called by MSHTML when IOleInPlaceActiveObject.TranslateAccelerator or
1773 IOleControlSite.TranslateAccelerator is called }
1774 //called by VCL
1775 //called by OCX
1776
1777 { by OCX this is called from:
1778 from: if FOleInPlaceActiveObject.TranslateAccelerator(WinMsg) = S_OK
1779 in: procedure TOleControl.WndProc(var Message: TMessage);
1780
1781 after this call comes calls to:
1782 TEmbeddedED._TranslateAccelerator
1783 TEditDesigner.TranslateAccelerator
1784 TEmbeddedED.OleControlSite_TranslateAccelerator
1785 }
1786
1787 Result := E_NOTIMPL;
1788 { if we return S_OK then no further call to other "translate accelerator" occurs
1789 because TOleControl.WndProc doesn't delegate the message further up the chain}
1790end;
1791//------------------------------------------------------------------------------
1792function TEmbeddedED.GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HRESULT;
1793begin
1794 //Returns the registry key under which MSHTML stores user preferences
1795 //asm int 3 end; //trap
1796 pchKey := nil;
1797 Result := E_NOTIMPL;
1798end;
1799//------------------------------------------------------------------------------
1800function TEmbeddedED.GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HRESULT;
1801begin
1802 { Called by MSHTML when it is being used as a drop target to allow the host
1803 to supply an alternative IDropTarget }
1804 //asm int 3 end; //trap
1805
1806 {$IFDEF EDDRAGDROP}
1807 result := InitializeDropTarget(Self, pDropTarget, ppDropTarget);
1808 {$ELSE}
1809 Result := E_NOTIMPL;
1810 {$ENDIF}
1811end;
1812//------------------------------------------------------------------------------
1813function TEmbeddedED.GetExternal(out ppDispatch: IDispatch): HRESULT;
1814begin
1815 { Called by MSHTML to obtain the host's IDispatch interface.
1816 There is a sample on how to use it here:
1817 http://www.euromind.com/iedelphi/embeddedwb/ongetexternal.htm }
1818 //asm int 3 end; //trap
1819
1820 ppDispatch := nil;
1821 Result := E_NOTIMPL;
1822end;
1823//------------------------------------------------------------------------------
1824function TEmbeddedED.TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HRESULT;
1825var
1826 Changed: boolean;
1827 URL: string;
1828begin
1829 { Called by MSHTML to allow the host an opportunity to modify the URL to be loaded
1830 NB TranslateUrl is not called when you use Navigate or Navigate2 but only when a
1831 hyperlink is clicked }
1832 //asm int 3 end; //trap
1833
1834 if Assigned(FOnTranslateURL)
1835 then begin
1836 Changed := False;
1837 URL := OleStrToString(pchURLIn);
1838 FOnTranslateURL(Self, URL, Changed);
1839 if Changed
1840 then begin
1841 ppchURLOut := StringToOleStr(URL);
1842 Result := S_OK;
1843 end
1844 else Result := S_FALSE;
1845 end
1846 else begin
1847 ppchURLOut := nil;
1848 Result := S_FALSE;
1849 end;
1850end;
1851//------------------------------------------------------------------------------
1852function TEmbeddedED.FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT;
1853begin
1854 { Called on the host by MSHTML to allow the host to replace MSHTML's data object.
1855 Returns S_OK if the data object is replaced, or S_FALSE if it's not replaced.
1856
1857 Although the documentation does not explicitly mention it, it will only be
1858 called in paste situations }
1859 //asm int 3 end; //trap
1860
1861 ppDORet := nil;
1862 Result := S_FALSE;
1863end;
1864//------------------------------------------------------------------------------
1865function TEmbeddedED.QueryService(const rsid, iid: TGuid; out Obj): HResult;
1866begin
1867 //asm int 3 end; //trap
1868 IUnknown(obj) := nil;
1869
1870 if IsEqualGUID(rsid, SID_SHTMLEDitHost) and FEditMode
1871 then result := TEditHost(FEditHost).QueryService(rsid, iid, IUnknown(obj))
1872 else begin
1873 if Assigned(FOnQueryService)
1874 then Result := FOnQueryService(rsid, iid, IUnknown(obj))
1875 else Result := E_NOINTERFACE;
1876 end;
1877end;
1878//------------------------------------------------------------------------------
1879function TEmbeddedED.LoadFromStrings(aStrings: TStrings): HResult;
1880begin
1881 //asm int 3 end; //trap
1882
1883 result := LoadFromString(aStrings.Text);
1884end;
1885//------------------------------------------------------------------------------
1886function TEmbeddedED.LoadFromString(aString: String): HResult;
1887{$IFNDEF EDMONIKER}
1888var
1889 aHandle: THandle;
1890 aStream: IStream;
1891{$ENDIF}
1892begin
1893 //asm int 3 end; //trap
1894
1895 FLoadFromString := true;
1896
1897 {$IFDEF EDMONIKER}
1898 FKeepPath := True;
1899 result := LoadFromStringMoniker(Self, aString);
1900 {$ELSE}
1901 FCurrentDocumentPath := '';
1902 aHandle := GlobalAlloc(GPTR, Length(aString) + 1);
1903 try
1904 if aHandle <> 0
1905 then begin
1906 Move(aString[1], PChar(aHandle)^, Length(aString) + 1);
1907 CreateStreamOnHGlobal(aHandle, FALSE, aStream);
1908 result := LoadFromIStream(aStream);
1909 end
1910 else result := S_false;
1911 finally
1912 GlobalFree(aHandle);
1913 end;
1914 {$ENDIF}
1915end;
1916//------------------------------------------------------------------------------
1917{$IFNDEF EDMONIKER}
1918 function TEmbeddedED.LoadFromIStream(aIStream: IStream): HResult;
1919 begin
1920 //asm int 3 end; //trap
1921
1922 if not DocumentIsAssigned
1923 then AssignDocument;
1924
1925 FReadyState := 0;
1926 Result := PersistStream.Load(aIStream);
1927
1928 WaitForDocComplete;
1929 end;
1930{$ENDIF}
1931//------------------------------------------------------------------------------
1932procedure TEmbeddedED._CheckGenerator(MainCheck: Boolean = true);
1933begin
1934 //asm int 3 end; //trap
1935
1936 {$IFDEF EDLIB}
1937 if MainCheck
1938 then CheckGenerator(Self);
1939 {$ENDIF}
1940end;
1941//------------------------------------------------------------------------------
1942function TEmbeddedED.GetDocumentHTML: String;
1943begin
1944 //asm int 3 end; //trap
1945
1946 if ComponentInDesignMode or (TwebBrowser(Self).Document = nil)
1947 then Result := ''
1948 else begin
1949 _CheckGenerator(false);
1950 result := GetDocHTML(DOC);
1951 end;
1952end;
1953//------------------------------------------------------------------------------
1954procedure TEmbeddedED.SetDocumentHTML(NewHTML: String);
1955begin
1956 //asm int 3 end; //trap
1957
1958 if ComponentInDesignMode
1959 then exit;
1960
1961 if DOC = nil then //kt
1962 exit; //kt
1963
1964 //this is to avoid a very rear AV error
1965 (Doc.selection as IHTMLSelectionObject).empty;
1966 GetElementUnderCaret;
1967
1968 if S_OK = (DOC as IPersistMoniker).IsDirty
1969 // avoid, question about save file from MSHTML
1970 then cmdSet_B(IDM_SETDIRTY, false);
1971
1972 LoadFromString(NewHTML);
1973
1974 //now The document must be dirty !
1975 CmdSet_B(IDM_SETDIRTY, true);
1976 FHTMLImage := '';
1977end;
1978//------------------------------------------------------------------------------
1979procedure TEmbeddedED.AssignDocument;
1980var
1981 Ov: OleVariant;
1982begin
1983 //asm int 3 end; //trap
1984 if TwebBrowser(Self).Document = nil
1985 then begin
1986 HandleNeeded; //or a hidden MSHTML wont respond
1987
1988 Ov := AboutBlank;
1989
1990 FReadyState := 0;
1991 Navigate2(Ov); //this will run asynchronously and call OnDocumentComplete
1992
1993 WaitForDocComplete;
1994 //For some reason, with IE8, OnDocumentComplete is not getting fired...
1995 FRefreshing := true; //kt added
1996 EDOnDownloadComplete(self); //kt added... correct???
1997 end;
1998end;
1999//------------------------------------------------------------------------------
2000function TEmbeddedED.Go(Url: String): HResult;
2001const
2002 FileSlash = 'file://';
2003var
2004 aURLPath: string;
2005
2006 {$IFNDEF EDMONIKER}
2007 FBindCtx: IBindCtx;
2008 aURLMoniker: IMoniker;
2009 {$ENDIF}
2010
2011 //--------------------------------------
2012 function DropFilePart(S: String): String;
2013 begin
2014 result := AnsiLowerCase(S);
2015 if Pos(FileSlash, result) = 1
2016 then Delete(result, 1, length(FileSlash));
2017
2018 result := StringReplace(result, '\', '/', [rfReplaceAll]);
2019
2020 if Length(result) < 3
2021 then exit;
2022
2023 if pos('//', result) = 1
2024 then result := AfterTokenNr(result, '/', 4)
2025
2026 else if result[2] = ':'
2027 then delete(result, 1, 3);
2028 end;
2029 //--------------------------------------
2030begin
2031 //asm int 3 end; //trap
2032
2033 result := S_FALSE;
2034 FBaseURL := '';
2035
2036 {$IFDEF EDMONIKER}
2037 LoadFromEDMoniker(self, URL, '');
2038 {$ELSE}
2039 //Navigate(Url); //this is a bit unstable here so we use a URLmoniker instead
2040 OleCheck(CreateBindCtx(0, FBindCtx));
2041 CreateURLMoniker(nil, StringToOleStr(URL), aURLMoniker);
2042
2043 FReadyState := 0; //make sure WaitForDocComplete don't return immediately
2044 result := (DOC as IPersistMoniker).Load(false, aURLMoniker, FBindCtx, STGM_READ);
2045
2046 WaitForDocComplete;
2047 {$ENDIF}
2048
2049 //se if we got to the target
2050 aURLPath := GetPersistedFile;
2051
2052 if pos(DropFilePart(URL), DropFilePart(aURLPath)) = 1
2053 then begin
2054 result := S_OK;
2055
2056 //set BASEUrl according to the DHTMLEdit specs.
2057 FBaseURL := aURLPath;
2058 Delete(FBaseURL, LastDelimiter('\/', FBaseURL)+1, Length(FBaseURL));
2059 end
2060 else begin //just in case
2061 if FDebug
2062 then KSMessageE('Wrong URL reached'+DblCrLf+
2063 'Target:'+Crlf+URL+DblCrLf+
2064 'Reached:'+Crlf+ DOC.URL, 'Go-error');
2065 end;
2066end;
2067//------------------------------------------------------------------------------
2068function TEmbeddedED.GetDirty: boolean;
2069begin
2070 //asm int 3 end; //trap
2071
2072 if (TwebBrowser(Self).Document = nil) or (not FeditMode)
2073 then begin
2074 result := false;
2075 exit;
2076 end;
2077
2078 Result := S_OK = (DOC as IPersistMoniker).IsDirty;
2079
2080 { IPersistStream.IsDirty only reports that the document has been changed since
2081 it was read / last saved.
2082 Sometimes it don't know that a change have been changed back
2083 - if you make some text bold and then undo it back to normal again then
2084 IPersistStream knows that the document isn't dirty
2085 - but if you doesn't undo the bold operation but change the text back to normal
2086 again then IPersistStream reports the document dirty although its really clean }
2087
2088 if result
2089 then begin
2090 { We cant completely trust it if IPersistStream reports the document dirty.
2091 So we compare the original image with the actual image of HTML source }
2092
2093 result := (not AnsiSameText(FHTMLImage, KS_Lib.GetHTMLtext(DOC)));
2094
2095 If not result
2096 { no need to spend time repeating GetHTMLtext more often than necessary
2097 so we sync IPersistMoniker.IsDirty with the real world }
2098 then cmdSet_B(IDM_SETDIRTY, false);
2099 end;
2100end;
2101//------------------------------------------------------------------------------
2102procedure TEmbeddedED.SetDirty(_dirty: boolean);
2103begin
2104 //asm int 3 end; //trap
2105 if TwebBrowser(Self).Document <> nil
2106 then begin
2107 cmdSet_B(IDM_SETDIRTY, _dirty); // Update IPersist**.IsDirty
2108
2109 if not _dirty //we have just set dirty to clean
2110 { We really only need to get a new FHTMLImage if the current one is
2111 dirty - but it doesn't harm to set it again if its clean }
2112 then FHTMLImage := KS_Lib.GetHTMLtext(DOC);
2113 end;
2114end;
2115//------------------------------------------------------------------------------
2116function TEmbeddedED.QueryStatus(cmdID: CMDID): OLECMDF;
2117var
2118 Cmd: OLECMD;
2119 Handled: boolean;
2120
2121 //----------------------------------------------------
2122 function DoQerry: OLECMDF;
2123 begin
2124 //asm int 3 end; //trap
2125 Cmd.CmdID := cmdID;
2126 if S_OK = CmdTarget.QueryStatus(@CGID_MSHTML, 1, @Cmd, Nil)
2127 then Result := Cmd.cmdf
2128 else result := 0; //not supported
2129 end;
2130 //----------------------------------------------------
2131begin
2132 //asm int 3 end; //trap
2133 { 7 = OLECMDF_SUPPORTED or OLECMDF_ENABLED or OLECMDF_LATCHED
2134 3 = OLECMDF_SUPPORTED or OLECMDF_ENABLED }
2135
2136 result := 0;
2137 if TwebBrowser(Self).Document <> nil
2138 then begin
2139 //we need to catch a few special commands here
2140 case cmdID of
2141 IDM_SHOWZEROBORDERATDESIGNTIME:
2142 begin //MSHTML don't remember this setting
2143 if FShowZeroBorderAtDesignTime
2144 then result := 7
2145 else result := 3;
2146 end;
2147
2148 IDM_CONSTRAIN:
2149 begin
2150 if FConstrain
2151 then result := 7
2152 else result := 3;
2153 end;
2154
2155 IDM_Undo, IDM_Redo, IDM_DROP_UNDO_PACKAGE, IDM_DROP_REDO_PACKAGE, IDM_LocalUndoManager:
2156 begin
2157 {$IFDEF EDUNDO}
2158 if FTUndo <> nil
2159 then begin
2160 result := TUndo(FTUndo).QueryStatus(cmdID);
2161 exit;
2162 end;
2163 {$ENDIF}
2164
2165 if (cmdID = IDM_Undo) or (cmdID = IDM_Redo)
2166 then result := DoQerry;
2167 //else result := 0
2168 end;
2169
2170 IDM_NUDGE_ELEMENT, DECMD_LOCK_ELEMENT, DECMD_BRING_ABOVE_TEXT, DECMD_BRING_FORWARD, DECMD_BRING_TO_FRONT, DECMD_SEND_BELOW_TEXT, DECMD_SEND_TO_BACK, DECMD_SEND_BACKWARD:
2171 begin
2172 {$IFDEF EDZINDEX}
2173 if FTZindex <> nil
2174 then result := TZindex(FTZindex).QueryStatus(cmdID);
2175 {$ELSE}
2176 //else result := 0
2177 {$ENDIF}
2178 end;
2179
2180 else begin
2181 Handled := false;
2182
2183 {$IFDEF EDTABLE}
2184 if assigned(FTtable)
2185 then result := TTable(FTtable).TableQeryCommand(cmdID, Handled, self);
2186 {$ENDIF}
2187
2188 if not Handled
2189 then result := DoQerry;
2190 end
2191 end;
2192 end;
2193end;
2194//------------------------------------------------------------------------------
2195function TEmbeddedED.ExecCommand(cmdID: KS_Lib.CMDID; cmdexecopt: OLECMDEXECOPT; var pInVar: OleVariant): OleVariant;
2196begin
2197 //asm int 3 end; //trap
2198 DoCommand(cmdID, cmdexecopt, pInVar, result);
2199end;
2200//-----------------------------------------------------------------------------
2201function TEmbeddedED.DoCommand(cmdID: KS_Lib.CMDID): HResult;
2202begin
2203 //asm int 3 end; //trap
2204 result := DoCommand(cmdID, OLECMDEXECOPT_DODEFAULT);
2205end;
2206//------------------------------------------------------------------------------
2207function TEmbeddedED.DoCommand(cmdID: KS_Lib.CMDID; cmdexecopt: OLECMDEXECOPT): HResult;
2208begin
2209 //asm int 3 end; //trap
2210 result := DoCommand(cmdID, cmdexecopt, POlevariant(Nil)^);
2211end;
2212//-----------------------------------------------------------------------------
2213function TEmbeddedED.DoCommand(cmdID: KS_Lib.CMDID; cmdexecopt: OLECMDEXECOPT; var pInVar: OleVariant): HResult;
2214begin
2215 //asm int 3 end; //trap
2216 result := DoCommand(cmdID, cmdexecopt, pInVar, POlevariant(Nil)^);
2217end;
2218//-----------------------------------------------------------------------------
2219function TEmbeddedED.DoCommand(cmdID: KS_Lib.CMDID; cmdexecopt: OLECMDEXECOPT; var pInVar, pOutVar: OleVariant): HResult;
2220const
2221 SetError: Boolean = true;
2222var
2223 BoolInd: Boolean;
2224 Handled: Boolean;
2225 //OvParam: OleVariant;
2226
2227 //------------------------------------------------------------------
2228 procedure TestResult(aResult: HResult; acceptError: Longint = 0);
2229 begin
2230 if FDebug and (aResult <> S_OK) and (aResult <> acceptError)
2231 then begin
2232 {$IFNDEF EDTABLE}
2233 if (cmdID = IDM_RestoreSystemCursor) or (cmdID = IDM_STRIPCELLFORMAT)
2234 then exit;
2235 {$ENDIF}
2236
2237 KSMessageI('cmdID: '+IntTostr(cmdID), 'MSHTML command failed');
2238 end;
2239 end;
2240 //------------------------------------------------------------------
2241 function _DoCommand(acceptError: Longint = 0): HResult;
2242 begin
2243 Result := CmdTarget.Exec(@CGID_MSHTML, cmdID, cmdexecopt, pInVar, pOutVar);
2244 // For some reason, IE returns not supported if the user cancels. !!
2245 // and we cant use OLECMDERR_E_CANCELED to avoid that problem
2246 TestResult(Result, acceptError);
2247 end;
2248 //------------------------------------------------------------------
2249 function TestBoolInd(DoSetError: Boolean = false): Boolean;
2250 begin
2251 result := (@pInVar <> nil) and (TVariantArg(pInVar).VT = VT_BOOL);
2252 if result
2253 then BoolInd := pInVar
2254 else begin
2255 if DoSetError
2256 then FLastError := 'pInVar must be of type boolean';
2257 end;
2258 end;
2259 //------------------------------------------------------------------
2260begin
2261 //asm int 3 end; //trap
2262 result := S_FALSE;
2263
2264
2265 if TwebBrowser(Self).Document = nil
2266 then begin
2267 AssignDocument;
2268
2269 if not DocumentIsAssigned
2270 then begin
2271 if FDebug
2272 then KSMessageI('DOC not assigned', 'MSHTML command skipped');
2273 exit;
2274 end;
2275 end;
2276
2277
2278
2279 //we need to catch some commands here
2280 case cmdID of
2281
2282 IDM_SHOWZEROBORDERATDESIGNTIME:
2283 begin //MSHTML don't remember this setting
2284 if TestBoolInd
2285 then begin
2286 result := _DoCommand;
2287 if result = S_OK
2288 then FShowZeroBorderAtDesignTime := BoolInd;
2289 end
2290 else begin
2291 result := _DoCommand;
2292 if result = S_OK
2293 then FShowZeroBorderAtDesignTime := not FShowZeroBorderAtDesignTime;
2294 end;
2295 TestResult(Result);
2296 end;
2297
2298 IDM_SAVEAS: // IDM_SAVE is not supported by MSHTML
2299 begin
2300 result := _DoCommand(Integer($80040103)); //The dialog was cancelled
2301 if (result = S_OK) and FEditMode //we did a save
2302 then FHTMLImage := KS_Lib.GetHTMLtext(DOC); //get image of original source
2303 end;
2304
2305 IDM_CONSTRAIN:
2306 begin
2307 FConstrain := not FConstrain;
2308 result := S_OK;
2309 end;
2310
2311 IDM_Undo, IDM_Redo, IDM_DROP_UNDO_PACKAGE, IDM_DROP_REDO_PACKAGE, IDM_LocalUndoManager:
2312 begin
2313 {$IFDEF EDUNDO}
2314 if FTUndo <> nil
2315 then begin
2316 TestBoolInd;
2317 result := TUndo(FTUndo).DoCommand(cmdID, BoolInd, FEdit, Handled);
2318 if not Handled
2319 then result := _DoCommand;
2320 end
2321 else result := _DoCommand;
2322 {$ELSE}
2323 result := _DoCommand;
2324 {$ENDIF}
2325
2326 TestResult(Result);
2327 end;
2328
2329 IDM_NUDGE_ELEMENT, DECMD_LOCK_ELEMENT, DECMD_BRING_ABOVE_TEXT, DECMD_BRING_FORWARD, DECMD_BRING_TO_FRONT, DECMD_SEND_BELOW_TEXT, DECMD_SEND_TO_BACK, DECMD_SEND_BACKWARD:
2330 begin
2331 {$IFDEF EDZINDEX}
2332 if FTZindex <> nil
2333 then result := TZindex(FTZindex).ZindexCommand(cmdID, pInVar);
2334 {$ELSE}
2335 //else result := S_FALSE
2336 {$ENDIF}
2337 end;
2338
2339 KS_TEST: result := KSTest(pInVar, pOutVar);
2340
2341 else begin
2342 handled := false;
2343 {$IFDEF EDTABLE}
2344 if assigned(FTtable)
2345 then result := TTable(FTtable).TableCommand(cmdID, pInVar, Handled, self);
2346 {$ENDIF}
2347
2348 if handled
2349 then TestResult(Result)
2350 else begin
2351 result := _DoCommand;
2352 exit;
2353 end;
2354 end;
2355 end;
2356
2357 if result = S_OK
2358 then UpdateUI; //or buttons might jump out briefly
2359end;
2360//-----------------------------------------------------------------------------
2361function TEmbeddedED.CmdSet(cmdID: KS_Lib.CMDID): HResult;
2362begin
2363 //asm int 3 end; //trap
2364 result := DoCommand(cmdID, OLECMDEXECOPT_DODEFAULT);
2365end;
2366//-----------------------------------------------------------------------------
2367function TEmbeddedED.CmdSet(cmdID: KS_Lib.CMDID; var pInVar: OleVariant): HResult;
2368begin
2369 //asm int 3 end; //trap
2370 result := DoCommand(cmdID, OLECMDEXECOPT_DODEFAULT, pInVar, POlevariant(Nil)^);
2371end;
2372//-----------------------------------------------------------------------------
2373function TEmbeddedED.CmdSet_B(cmdID: KS_Lib.CMDID; pIn: Boolean): HResult;
2374var
2375 Ov: OleVariant;
2376begin
2377 //asm int 3 end; //trap
2378 Ov := pIn;
2379 result := DoCommand(cmdID, OLECMDEXECOPT_DODEFAULT, Ov, POlevariant(Nil)^);
2380end;
2381//-----------------------------------------------------------------------------
2382function TEmbeddedED.CmdSet_S(cmdID: KS_Lib.CMDID; pIn: String): HResult;
2383var
2384 Ov: OleVariant;
2385begin
2386 //asm int 3 end; //trap
2387 Ov := pIn;
2388 result := DoCommand(cmdID, OLECMDEXECOPT_DODEFAULT, Ov, POlevariant(Nil)^);
2389end;
2390//-----------------------------------------------------------------------------
2391function TEmbeddedED.CmdSet_I(cmdID: KS_Lib.CMDID; pIn: Integer): HResult;
2392var
2393 Ov: OleVariant;
2394begin
2395 //asm int 3 end; //trap
2396 Ov := pIn;
2397 result := DoCommand(cmdID, OLECMDEXECOPT_DODEFAULT, Ov, POlevariant(Nil)^);
2398end;
2399//------------------------------------------------------------------------------
2400function TEmbeddedED.WaitForDocComplete: Boolean;
2401var
2402 I: Cardinal;
2403begin
2404 //asm int 3 end; //trap
2405
2406 I := getTickCount + 20000;
2407 result := true;
2408
2409 if TwebBrowser(Self).Document = nil //avoid deadlock
2410 then exit;
2411
2412 if FReadyState = READYSTATE_COMPLETE
2413 then begin
2414 if FDebug
2415 then beep;
2416 exit;
2417 end;
2418
2419 While FReadyState <> READYSTATE_COMPLETE do //wait until DHTMLedit is ready
2420 begin
2421 if getTickCount > I
2422 then begin
2423 result := false;
2424 if FDebug
2425 then KSMessageE('Dead lock break in WaitForDocComplete');
2426
2427 break; //avoid dead lock - break loop after 20 sec.
2428 end
2429 else SafeYield;
2430 end;
2431end;
2432//------------------------------------------------------------------------------
2433function TEmbeddedED.EndCurrentDocDialog(var mr: Integer; CancelPosible: Boolean = False; SkipDirtyCheck: Boolean = False): HResult;
2434var
2435 Buttons: Integer;
2436 NotDirty: Boolean;
2437begin
2438 //asm int 3 end; //trap
2439
2440 result := S_OK;
2441
2442 if SkipDirtyCheck
2443 then begin
2444 NotDirty := true;
2445 //avoid complains from MSHTML when loading new file - if DOC is dirty
2446 cmdSet_B(IDM_SETDIRTY, false);
2447 end
2448 else NotDirty := not GetDirty;
2449
2450
2451 if NotDirty //current file is clean
2452 then begin //just delete backup
2453 if Length(FCurBackFile) > 0
2454 then DeleteFile(FCurBackFile); //works only for users with delete right
2455 //other users leave the bak-file behind
2456 mr := -1;
2457 end
2458 else begin //current file is dirty
2459 if CancelPosible
2460 then Buttons := MB_YESNOCANCEL
2461 else Buttons := MB_YESNO;
2462
2463 mr := KSQuestion('Document changed.'+DblCrLf+
2464 'Save changes ?', '', MB_ICONQUESTION or Buttons);
2465
2466 if mr = IDCANCEL //skip the ending document process
2467 then Result := S_False
2468
2469 else if mr = IDNO //skip saving
2470 then begin //Don't save - just restore old file from backup
2471 if DocIsPersist //if file created then get backup
2472 then begin
2473 if Assigned(FBeforeCloseFile)
2474 then FBeforeCloseFile(Self, FCurrentDocumentPath);
2475
2476 if GetBackup //restore original file from backup
2477 then begin
2478 DeleteFile(FCurBackFile);
2479 FCurBackFile := '';
2480 end;
2481 end;
2482
2483 //avoid complains from MSHTML when loading new file - if DOC is dirty
2484 cmdSet_B(IDM_SETDIRTY, false)
2485 end;
2486 end;
2487end;
2488//------------------------------------------------------------------------------
2489function TEmbeddedED.EndCurrentDoc(CancelPosible: Boolean = False; SkipDirtyCheck: Boolean = False): HResult;
2490var
2491 mr: Integer;
2492begin
2493 //asm int 3 end; //trap
2494
2495 Result := EndCurrentDocDialog(mr, CancelPosible, SkipDirtyCheck);
2496 if mr = IDYES
2497 then begin
2498 result := SaveFile;
2499
2500 if Assigned(FBeforeCloseFile)
2501 then FBeforeCloseFile(Self, FCurrentDocumentPath);
2502 end;
2503end;
2504//------------------------------------------------------------------------------
2505Function TEmbeddedED.GetBackup: Boolean;
2506begin
2507 //asm int 3 end; //trap
2508 //restore backup copy to current file (skip any changes)
2509
2510 if DocIsPersist and (length(FCurBackFile) > 0)
2511 then result := FileCopy(FCurBackFile, FCurrentDocumentPath)
2512 else result := True;
2513end;
2514//-----------------------------------------------------------------------------
2515function TEmbeddedED.CreateBackUp: Boolean;
2516begin
2517 //asm int 3 end; //trap
2518 if FCreateBakUp
2519 then begin
2520 FCurBackFile := ChangeFileExt(FCurrentDocumentPath, '.bak');
2521 result := FileCopy(FCurrentDocumentPath, FCurBackFile);
2522 if not result
2523 then FCurBackFile := '';
2524 end
2525 else result := false;;
2526end;
2527//-----------------------------------------------------------------------------
2528function TEmbeddedED.GetCharset: string;
2529begin
2530 //asm int 3 end; //trap
2531
2532 {$IFDEF EDLIB}
2533 result := _GetCharset;
2534 {$ELSE}
2535 result := 'windows-1252'; //resort to default value
2536 {$ENDIF}
2537end;
2538//-----------------------------------------------------------------------------
2539function TEmbeddedED.EmptyDoc: String;
2540var
2541 BodyContetn: string;
2542begin
2543 //asm int 3 end; //trap
2544
2545 if Get_UseDivOnCarriageReturn
2546 then BodyContetn := '<DIV>&nbsp;</DIV>'
2547 else BodyContetn := '<P>&nbsp;</P>';
2548
2549 result := '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">'+CrLf+
2550 '<HTML><HEAD><TITLE>No Title</TITLE>'+
2551 '<META http-equiv=Content-Type content="text/html; charset='+ GetCharset +'">'+
2552 '<META content="'+ GetGenerator +'" name=GENERATOR>'+
2553 '</HEAD>' +
2554 '<BODY>'+ BodyContetn +'</BODY></HTML>';
2555end;
2556//-----------------------------------------------------------------------------
2557function TEmbeddedED.NewDocument: HResult;
2558begin
2559 //asm int 3 end; //trap
2560
2561 if TwebBrowser(Self).Document = nil
2562 then AssignDocument
2563 else begin
2564 if EndCurrentDoc(CancelPosible, FSkipDirtyCheck) <> S_OK
2565 then begin
2566 Result := S_False;
2567 exit;
2568 end;
2569 end;
2570
2571 Result := LoadFromString(EmptyDoc);
2572
2573 GetSourceSnapShot;
2574
2575 FBaseURL := ''; //set to empty string just like DHTMLEdit
2576end;
2577//------------------------------------------------------------------------------
2578procedure TEmbeddedED.SetShowDetails(vIn: Boolean);
2579begin
2580 //asm int 3 end; //trap
2581 FShowDetails := vIn;
2582
2583 {$IFDEF EDGLYPHS}
2584 _SetShowDetails(FShowDetails, Self);
2585 {$ELSE}
2586 if DocumentIsAssigned
2587 then begin
2588 if ShowDetails
2589 then CmdSet(IDM_SHOWALLTAGS)
2590 else CmdSet(IDM_EMPTYGLYPHTABLE);
2591 end;
2592 {$ENDIF}
2593end;
2594//------------------------------------------------------------------------------
2595function TEmbeddedED.GetDocTitle: string;
2596begin
2597 //asm int 3 end; //trap
2598 if TwebBrowser(Self).Document <> nil
2599 then result := DOC.Title
2600 else result := '';
2601end;
2602//------------------------------------------------------------------------------
2603procedure TEmbeddedED.SetDocTitle(NewTitle: String);
2604begin
2605 { MSHTML always creates an implicit empty title element, so you can
2606 safely assign a text to it }
2607 //asm int 3 end; //trap
2608 if TwebBrowser(Self).Document <> nil
2609 then DOC.Set_title(NewTitle);
2610end;
2611//------------------------------------------------------------------------------
2612function TEmbeddedED.GetDOC: IHTMLDocument2;
2613begin
2614 //asm int 3 end; //trap
2615 if TwebBrowser(Self).Document = nil
2616 then result := nil
2617 else result := TwebBrowser(Self).Document as IHTMLDocument2;
2618end;
2619//------------------------------------------------------------------------------
2620function TEmbeddedED.DocumentIsAssigned: Boolean;
2621begin
2622 //asm int 3 end; //trap
2623 result := TwebBrowser(Self).Document <> nil;
2624end;
2625//------------------------------------------------------------------------------
2626function TEmbeddedED.GetInPlaceActiveObject: IOleInPlaceActiveObject;
2627var
2628 aHandle: Windows.Hwnd;
2629begin
2630 //asm int 3 end; //trap
2631 { this function is called from initializeEditor, so FmsHTMLwinHandle is assured
2632 to be available at the time we got an document to operate on }
2633
2634 if FOleInPlaceActiveObject <> nil
2635 then begin
2636 result := FOleInPlaceActiveObject;
2637 exit;
2638 end;
2639
2640 if ControlInterface <> nil
2641 then OleCheck(ControlInterface.QueryInterface(IOleInPlaceActiveObject, FOleInPlaceActiveObject))
2642 else begin
2643 result := nil;
2644 exit;
2645 end;
2646
2647 //first get the "Shell Embedding" window
2648 OleCheck(FOleInPlaceActiveObject.GetWindow(FMainWinHandle));
2649
2650 //then get the "Shell DocObject View" window
2651 aHandle := FindWindowEx(FMainWinHandle, 0, 'Shell DocObject View', nil);
2652
2653 //now get the mshtml components main window
2654 FmsHTMLwinHandle := FindWindowEx(aHandle, 0, 'Internet Explorer_Server', nil);
2655
2656 result := FOleInPlaceActiveObject;
2657end;
2658//------------------------------------------------------------------------------
2659function TEmbeddedED.GetCmdTarget: IOleCommandTarget;
2660begin
2661 //asm int 3 end; //trap
2662 if TwebBrowser(Self).Document = nil
2663 then result := nil
2664 else result := TwebBrowser(Self).Document as IOleCommandTarget;
2665end;
2666//------------------------------------------------------------------------------
2667function TEmbeddedED.GetPersistStream: IPersistStreamInit;
2668begin
2669 //asm int 3 end; //trap
2670
2671 { In a Microsoft Visual C++ WebBrowser host or similar application, when you
2672 call the QueryInterface method for the IPersistStreamInit interface on a
2673 FRAME in a FRAMESET, it returns E_NOINTERFACE. When you query for other
2674 standard persistence interfaces (IPersistStream, IPersistFile, IPersistMemory),
2675 you receive the same error.}
2676
2677 if TwebBrowser(Self).Document = nil
2678 then result := nil
2679 else result := TwebBrowser(Self).Document as IPersistStreamInit;
2680end;
2681//------------------------------------------------------------------------------
2682function TEmbeddedED.GetPersistFile: IPersistFile;
2683begin
2684 //asm int 3 end; //trap
2685 if TwebBrowser(Self).Document = nil
2686 then result := nil
2687 else result := TwebBrowser(Self).Document as IPersistFile;
2688end;
2689//------------------------------------------------------------------------------
2690procedure TEmbeddedED.PrintDocument(var withUI: OleVariant);
2691begin
2692 //asm int 3 end; //trap
2693 if withUI
2694 then DoCommand(IDM_PRINT, OLECMDEXECOPT_PROMPTUSER)
2695 else DoCommand(IDM_PRINT, OLECMDEXECOPT_DONTPROMPTUSER);
2696end;
2697//------------------------------------------------------------------------------
2698procedure TEmbeddedED.Refresh;
2699var
2700 Rect: TRect;
2701begin
2702 //asm int 3 end; //trap
2703 //DoCommand(IDM_REFRESH); //this reloads the document
2704
2705 {DHTML Edit docs says:
2706 This method redraws the current document, including the latest changes.
2707 You can use this method to redisplay a document if a series of edits have left
2708 the document in a state that is hard to read.
2709
2710 If you are hosting a DHTML Editing control on a Web page, and if the control is
2711 hidden, you can also use this method to load a document into a DHTML Editing control.
2712 By default, the window object's onload event does not load documents into hidden
2713 controls.
2714
2715 The Refresh method does not reread information from a file. If the current document
2716 references an external file, such as an applet or an image, and that file has changed,
2717 the change is not displayed by the Refresh method. To see changes in external files,
2718 use the LoadURL or LoadDocument method.
2719
2720 The Refresh method sets the isDirty property to False. - the later seems not
2721 to be true ! }
2722
2723 { NB the undo stack isn't cleared so DHTML Editing doesn't reload the document
2724 in any way }
2725
2726
2727 //this is a guess
2728 Rect := BoundsRect;
2729 InvalidateRect(FmsHTMLwinHandle, @Rect, true);
2730end;
2731//------------------------------------------------------------------------------
2732function TEmbeddedED.Get_Busy: Boolean;
2733begin
2734 //asm int 3 end; //trap
2735 result := TWebBrowser(self).busy;
2736end;
2737//------------------------------------------------------------------------------
2738function TEmbeddedED.CmdGet(cmdID: KS_Lib.CMDID): OleVariant;
2739begin
2740 //asm int 3 end; //trap
2741 if S_OK <> DoCommand(cmdID, OLECMDEXECOPT_DODEFAULT, POlevariant(Nil)^, Result)
2742 then Result := false;
2743end;
2744//------------------------------------------------------------------------------
2745function TEmbeddedED.CmdGet(cmdID: KS_Lib.CMDID; pInVar: OleVariant): OleVariant;
2746begin
2747 //asm int 3 end; //trap
2748 if S_OK <> DoCommand(cmdID, OLECMDEXECOPT_DODEFAULT, pInVar, Result)
2749 then Result := false;
2750end;
2751//------------------------------------------------------------------------------
2752function TEmbeddedED.GetBuildInStyles: String;
2753begin
2754 //asm int 3 end; //trap
2755
2756 { because we need this list each time we load a new document we store it
2757 in FInternalStyles }
2758 if Length(FInternalStyles) = 0
2759 then _GetBuildInStyles;
2760
2761 result := FInternalStyles;
2762end;
2763//------------------------------------------------------------------------------
2764procedure TEmbeddedED._GetBuildInStyles;
2765var
2766 ov: OleVariant;
2767 I: Integer;
2768 StrCount: Integer;
2769 Ps: PSafeArray;
2770 Warr: array of WideString;
2771begin
2772 //asm int 3 end; //trap
2773
2774 FStyles.Clear;
2775
2776 TVariantArg(ov).VT := VT_ARRAY;
2777 FInternalStyles := '';
2778
2779 if (QueryStatus(IDM_GETBLOCKFMTS) and OLECMDF_ENABLED) = 0
2780 then begin
2781 TVariantArg(Ov).VT := VT_EMPTY; //D6 throws an error if we don't do this ?
2782 exit;
2783 end;
2784
2785 Ov := CmdGet(IDM_GETBLOCKFMTS);
2786
2787 { now we can get the returned strings either via API-calls or by
2788 direct handling of the SafeArray pointed to by VarRange.
2789
2790 API-calls are a bit slower but easy - the backside is that
2791 SafeArrays stay a mystery to you
2792
2793 Direct handling involves much coding but executes faster
2794
2795 In both cases Delphi destroys the SafeArray fore you when it
2796 get out of scope. }
2797
2798 //this is the direct handling of the SafeArray
2799 //************************************************
2800
2801 //get a pointer to the SafeArray
2802 Ps := TVariantArg(ov).pArray;
2803 if Ps = nil
2804 then exit;
2805
2806 //Get number of strings in the SafeArray
2807 StrCount := TSAFEARRAYBOUND(Ps.rgsabound).cElements;
2808 //make room fore all the strings in our WideString array
2809 SetLength(Warr, StrCount);
2810 try
2811 //lock the SafeArray = no risk of memory reallocation during copy
2812 Inc(Ps.cLocks);
2813 //copy OleStrings to WideString array
2814 //Ps.pvData points to start of the SafeArrays Data-segment
2815 //Ps.cbElements = size of each record = a PWideChar
2816 CopyMemory (@Warr[0], Ps.pvData, StrCount * 4 {Ps.cbElements});
2817 //result := StrCount > 0;
2818 finally
2819 Dec(Ps.cLocks); //unlock the SafeArray
2820 end;
2821
2822 for I := 0 to StrCount -1 do
2823 FStyles.Add(Warr[I]); //get each string from the WideString array
2824
2825 FInternalStyles := FStyles.Text;
2826
2827 TVariantArg(Ov).VT := VT_EMPTY; //D6 throws an error if we don't do this ?
2828
2829
2830 {
2831 //this is the the API way of doing the same task as above
2832 //************************************************
2833 //get a pointer to the SafeArray
2834 Ps := TVariantArg(ov).pArray;
2835 sCommands := '';
2836 for I := VarArrayLowBound(ov, 1) to VarArrayHighBound(ov, 1) do
2837 begin
2838 //get each string from the SafeArray
2839 SafeArrayGetElement(Ps, I, Pw);
2840 aList.Add(Pw);
2841 end;
2842 }
2843end;
2844//------------------------------------------------------------------------------
2845function TEmbeddedED.GetStyles: String;
2846begin
2847 //asm int 3 end; //trap
2848 result := '';
2849
2850 if FStylesRefreshed
2851 then result := FStyles.Text
2852 else begin
2853 FStylesRefreshed := true;
2854
2855 if Length(FInternalStyles) = 0
2856 then _GetBuildInStyles;
2857
2858 {$IFDEF EDLIB}
2859 MergeExterNalStyles(Self, FInternalStyles);
2860 {$ELSE}
2861 FStyles.Text := FInternalStyles;
2862 {$ENDIF}
2863 end;
2864
2865 result := FStyles.Text;
2866end;
2867//------------------------------------------------------------------------------
2868function TEmbeddedED.GetExternalStyles: String;
2869begin
2870 //asm int 3 end; //trap
2871
2872 {$IFDEF EDLIB}
2873 if Length(FExternalStyles) = 0
2874 then _GetExternalStyles(Self);
2875 {$ENDIF}
2876
2877 result := FExternalStyles;
2878end;
2879//------------------------------------------------------------------------------
2880function TEmbeddedED.SetStyle(aStyleName: string): HResult;
2881var
2882 aElement: IHTMLElement;
2883 aStyle: String;
2884 aIndex: Integer;
2885 I: Integer;
2886 aTagName: String;
2887 SelStart, SelEnd: Integer;
2888
2889 //--------------------------------------------
2890 procedure ClearAllTags;
2891 var
2892 aElement: IHTMLElement;
2893 TagText: String;
2894 aTag: string;
2895 S, S2: String;
2896 aDomNode: IHTMLDomNode;
2897 BreakLoop: Boolean;
2898 BreakTagInserted: Boolean;
2899 begin
2900
2901 BreakTagInserted := False;
2902 aElement := GetFirstSelElement;
2903 DebugString := aElement.OuterHTML;
2904
2905 while true do
2906 begin
2907 if not Assigned(aElement)
2908 then break;
2909
2910// aElement.ClassName := 'KS_DeleteMe'; // RHR
2911//kt aElement._className := 'KS_DeleteMe'; // RHR
2912 aElement.className := 'KS_DeleteMe'; // kt
2913 aElement := GetNextSelElement;
2914 end;
2915
2916
2917 //now delete marked elements
2918 aElement := GetFirstSelElement;
2919 DebugString := aElement.OuterHTML;
2920
2921 while true do
2922 begin
2923 if not Assigned(aElement)
2924 then break;
2925
2926 // if aElement.ClassName = 'KS_DeleteMe' RHR
2927 //kt if aElement._ClassName = 'KS_DeleteMe'
2928 if aElement.className = 'KS_DeleteMe' //kt
2929 then begin
2930 aDomNode := aElement as IHTMLDomNode;
2931 aDomNode.removeNode(false); //false = do not remove child nodes
2932 end
2933 else break; //end of element to delete reached
2934
2935 aElement := GetNextSelElement;
2936 end;
2937
2938 //now delete marked elements
2939 aElement := GetFirstSelElement;
2940 DebugString := aElement.OuterHTML;
2941 end;
2942 //--------------------------------------------
2943 procedure ClearClassStyles;
2944 var
2945 I: Integer;
2946 begin
2947 //loop trough all selected elements and remove known "tagName:className"
2948 aElement := GetFirstSelElement;
2949 DebugString := aElement.outerHTML;
2950
2951 while assigned(aElement) do
2952 begin
2953 //kt if Length(aElement._className) > 0 // RHR
2954 if Length(aElement.className) > 0 // kt
2955 then begin
2956 //kt if FStyles.Find(aElement.tagName + '.' + aElement._className, I) // RHR
2957 if FStyles.Find(aElement.tagName + '.' + aElement.className, I) // kt
2958 then aElement.removeAttribute('className', 0);
2959 end;
2960
2961 aElement := GetNextSelElement;
2962 end;
2963 end;
2964 //--------------------------------------------
2965begin
2966 //asm int 3 end; //trap
2967 result := S_false;
2968
2969 if not FStyles.Find(aStyleName, aIndex)
2970 then exit; //unknown style
2971
2972 { As we added our style sheet-classes to FStyles we marked the
2973 FStyles's objet with 1 >> FStyles.AddObject(S, TObject(1))
2974 Now we can distinguish between build in styles and external styles. }
2975
2976 if FStyles.Objects[aIndex] = nil //this is an internal style
2977 then begin
2978 if (QueryStatus(IDM_BLOCKFMT) and OLECMDF_ENABLED) = 0
2979 then exit;
2980
2981 BeginUndoUnit('Set internal Style');
2982 try
2983 //First remove any class style as MSHTML doesn't do that
2984 ClearClassStyles;
2985 //let MSHTML handle build in styles
2986 result := CmdSet_S(IDM_BLOCKFMT, aStyleName);
2987
2988 { Style = Normal has different effect depending on the settings of
2989 UseDivOnCarriageReturn. If set the selected text will be "packed"
2990 into DIV tags, and if not set it will be P tags that encapsulates
2991 the selection }
2992 finally
2993 EndUndoBlock(result);
2994 end;
2995
2996 exit;
2997 end;
2998
2999
3000 //handle our style-sheet classes
3001 I := pos('.', aStyleName);
3002 if I > 0
3003 then begin
3004 aTagName := copy(aStyleName, 1, I -1);
3005 aStyle := copy(aStyleName, I+1, Length(aStyleName));
3006
3007 { loop trough all selected elements with aTagName
3008 and set className := aStyle }
3009
3010 aElement := GetFirstSelElement;//(aTagName);
3011
3012 if assigned(aElement)
3013 then begin
3014 BeginUndoUnit('Set external Style');
3015 try
3016 while assigned(aElement) do
3017 begin
3018 {$IFDEF EDLIB}
3019 //substitute old tag with new tag
3020 ChangeTag(DOC, aElement, aTagName);
3021 {$ENDIF}
3022
3023 //kt aElement._className := aStyle; // RHR
3024 aElement.className := aStyle; // kt
3025 aElement := GetNextSelElement(aTagName);
3026 end;
3027
3028 result := S_OK;
3029 finally
3030 EndUndoBlock(result);
3031 end;
3032 end;
3033 end
3034 else begin
3035 //this must be an error
3036 end;
3037end;
3038//------------------------------------------------------------------------------
3039function TEmbeddedED.QueryEnabled(cmdID: KS_Lib.CMDID): Boolean;
3040begin
3041 //asm int 3 end; //trap
3042 Result := (QueryStatus(cmdID) and OLECMDF_ENABLED) = OLECMDF_ENABLED;
3043end;
3044//------------------------------------------------------------------------------
3045function TEmbeddedED.QueryLatched(cmdID: KS_Lib.CMDID): Boolean;
3046var
3047 dwStatus : OLECMDF;
3048begin
3049 //asm int 3 end; //trap
3050 dwStatus := QueryStatus(cmdID);
3051
3052 Result := (dwStatus and OLECMDF_LATCHED) = OLECMDF_LATCHED;
3053end;
3054//------------------------------------------------------------------------------
3055function TEmbeddedED._CurFileName: string;
3056begin
3057 //asm int 3 end; //trap
3058 result := FCurrentDocumentPath;
3059 if Length(result) > 0
3060 then Delete(result, 1, LastDelimiter('\/', result)); //drop path
3061end;
3062//------------------------------------------------------------------------------
3063function TEmbeddedED._CurDir: string;
3064begin
3065 //asm int 3 end; //trap
3066 result := FCurrentDocumentPath;
3067 if (Length(result) > 0) and
3068 (S_OK = IsFilePath(result, result))
3069 then Delete(result, LastDelimiter('\/', result)+1, length(result)); //drop file
3070end;
3071//------------------------------------------------------------------------------
3072function TEmbeddedED.GetOleobject: IOleobject;
3073begin
3074 //asm int 3 end; //trap
3075 {$IFDEF VER120} result := TwebBrowser(Self).Application_ as IOleobject; // Delphi 4.0
3076 {$ELSE} result := TwebBrowser(Self).Application as IOleobject;
3077 {$ENDIF}
3078end;
3079//------------------------------------------------------------------------------
3080procedure TEmbeddedED.SetFocusToDoc;
3081begin
3082 //asm int 3 end; //trap
3083 if TwebBrowser(Self).Document <> nil
3084 then GetOleobject.DoVerb(OLEIVERB_UIACTIVATE, nil, self as IOleClientSite, 0, Handle, GetClientRect);
3085end;
3086//------------------------------------------------------------------------------
3087procedure TEmbeddedED.SetBaseURL(const Value: String);
3088 //---------------------------------------
3089 function ValidFilePath(aPath: string): Boolean;
3090 var
3091 I: Integer;
3092 begin
3093 I := LastDelimiter('.\:', aPath);
3094
3095 result := (I > 0) and //we have a path
3096 ((aPath[I] = '\') or //it ends with backslash
3097 (aPath[I] = '.')); //we found a trailing file name
3098 end;
3099 //---------------------------------------
3100begin
3101 //asm int 3 end; //trap
3102
3103 if ComponentInDesignMode
3104 then begin
3105 FBaseURL := '';
3106 exit;
3107 end;
3108
3109 {$IFDEF EDMONIKER}
3110 {Setting BASEURL in the middle of an edit session has the side effect that the
3111 MSHTML UNDO stack is cleared.
3112
3113 DHTMLEdit behaves even worse. The document is reloaded from disk causing all
3114 non saved changes to be lost without any warning }
3115
3116 if AnsiSameText(FBaseURL, Value)//don't waist time setting the same BASEUrl
3117 then exit;
3118
3119 if FBaseTagInDoc
3120 then exit; { a base tag in the document will override a BASEUrl
3121 so don't waist time trying }
3122
3123 //check for trailing backslash in a file path
3124 if (pos('\', Value) > 0) and //this is a file path
3125 (Not ValidFilePath(Value))
3126 then KsMessageI('SetBaseURL: Bad value')
3127 else begin
3128 FBaseURL := Value;
3129 FSettingBaseURL := true;
3130 SetBase_Url(Self);
3131 end;
3132 {$ELSE}
3133 NotImplemented('SetBaseURL');
3134 {$ENDIF}
3135end;
3136//------------------------------------------------------------------------------
3137function TEmbeddedED.GetBaseURL: String;
3138begin
3139 //asm int 3 end; //trap
3140 if ComponentInDesignMode
3141 then result := '' //always blank in design mode
3142 else result := FBaseURL;
3143end;
3144//------------------------------------------------------------------------------
3145function TEmbeddedED.GetBaseElement(var aBaseElement: IHTMLBaseElement): boolean;
3146var
3147 aCollection: IHTMLElementCollection;
3148begin
3149 //asm int 3 end; //trap
3150 aCollection := (DOC as IHTMLDocument3).getElementsByTagName('BASE') as IHTMLElementCollection;
3151 if aCollection.length < 1
3152 then result := false
3153 else begin
3154 aBaseElement := aCollection.item(0, 0) as IHTMLBaseElement;
3155 result := true;
3156 end;
3157end;
3158//------------------------------------------------------------------------------
3159function TEmbeddedED.GetActualAppName: string;
3160begin
3161 //asm int 3 end; //trap - not used
3162 Result := TheActualAppName;
3163end;
3164//------------------------------------------------------------------------------
3165procedure TEmbeddedED.SetActualAppName(const Value: string);
3166begin
3167 //asm int 3 end; //trap
3168 TheActualAppName := Value;
3169end;
3170//------------------------------------------------------------------------------
3171procedure TEmbeddedED.SetBrowseMode(const Value: WordBool);
3172begin
3173 //asm int 3 end; //trap
3174 FEditMode := not Value;
3175
3176 if TwebBrowser(Self).Document <> nil
3177 then begin
3178 if FEditMode
3179 then DOC.designMode := 'On'
3180 else DOC.designMode := 'Off';
3181 end;
3182end;
3183//------------------------------------------------------------------------------
3184function TEmbeddedED.GetBrowseMode: WordBool;
3185begin
3186 //asm int 3 end; //trap
3187 result := not FEditMode;
3188end;
3189//------------------------------------------------------------------------------
3190procedure TEmbeddedED.GetElementUnderCaret;
3191var
3192 aSel: IHTMLSelectionObject;
3193 aDispatch: IDispatch;
3194
3195 //------------------------------
3196 procedure GetSelection;
3197 begin
3198 aSel := Doc.selection;
3199 if assigned(aSel)
3200 then
3201 try //?????
3202 aDispatch := aSel.createRange;
3203 Except
3204 end;
3205
3206 if assigned(aDispatch)
3207 then begin
3208 if supports(aSel.createRange, IHTMLTxtRange, FActualTxtRange)
3209 then begin
3210 FActualElement := FActualTxtRange.ParentElement;
3211 FActualRangeIsText := True;
3212 end;
3213 end
3214 else begin
3215 //last chance to ensure a valid TextRange
3216 try
3217 FActualTxtRange := (DOC.body as IHTMLBodyElement).createTextRange;
3218 FActualTxtRange.Collapse(true); //move to start of aTxtRange / document
3219 except;
3220 FActualTxtRange := nil;
3221 end;
3222 end;
3223 end;
3224 //------------------------------
3225begin
3226 //asm int 3 end; //trap
3227 FLength := -1;
3228 FFirstElement := 0;
3229 FLastElement := 0;
3230
3231 if (FReadyState <> READYSTATE_COMPLETE)
3232 then exit;
3233
3234 FActualControlRange := nil;
3235 FActualTxtRange := nil;
3236
3237 aSel := DOC.Selection;
3238
3239 FSelectionType := aSel.type_;
3240
3241 if SameText(FSelectionType, 'None')
3242 then begin
3243 GetSelection;
3244 FSelection := false;
3245 end
3246
3247 else if SameText(FSelectionType, 'Text')
3248 then begin
3249 GetSelection;
3250 FSelection := true;
3251 end
3252
3253 else if SameText(FSelectionType, 'Control')
3254 then begin
3255 FSelection := true;
3256 FActualElement := nil;
3257
3258 if assigned(aSel)
3259 then begin
3260 if supports(aSel.createRange, IHTMLControlRange, FActualControlRange)
3261 then begin
3262 FActualElement := FActualControlRange.commonParentElement;
3263 FActualRangeIsText := False;
3264 FActualTxtRange := (DOC.body as IHTMLBodyElement).createTextRange;
3265
3266 OleCheck(FMarkupPointerStart.MoveAdjacentToElement(FActualElement, ELEM_ADJ_BeforeBegin));
3267 OleCheck(FMarkupPointerEnd.MoveAdjacentToElement(FActualElement, ELEM_ADJ_AfterEnd));
3268
3269 //move rang in place
3270 OleCheck(FMarkUpServices.MoveRangeToPointers(FMarkupPointerStart, FMarkupPointerEnd, FActualTxtRange));
3271
3272 //FActualTxtRange.MoveToElementText(FActualElement);
3273 end;
3274 end
3275 else GetSelection;
3276 end;
3277end;
3278//------------------------------------------------------------------------------
3279function TEmbeddedED.GetActualElement: IHTMLElement;
3280begin
3281 //asm int 3 end; //trap
3282 if (not assigned(FActualElement)) or
3283 (FActualElement.OuterHTML = '') // or we might get into troubles after
3284 then GetElementUnderCaret; // deletion of a element
3285
3286 result := FActualElement;
3287end;
3288//------------------------------------------------------------------------------
3289function TEmbeddedED.GetActualTxtRange: IHTMLTxtRange;
3290begin
3291 //asm int 3 end; //trap
3292 if not assigned(FActualTxtRange) // or we might get into troubles after
3293 then GetElementUnderCaret; // deletion of a element
3294
3295 result := FActualTxtRange;
3296end;
3297//------------------------------------------------------------------------------
3298function TEmbeddedED.GetActualControlRange: IHTMLControlRange;
3299begin
3300 //asm int 3 end; //trap
3301 result := FActualControlRange;
3302end;
3303//------------------------------------------------------------------------------
3304Procedure TEmbeddedED.GetSelStartElement;
3305var
3306 aTxtRange: IHTMLTxtRange;
3307begin
3308 //asm int 3 end; //trap
3309 aTxtRange := FActualTxtRange.duplicate;
3310 aTxtRange.Collapse(True); //start of selection
3311 FStartElementSourceIndex := aTxtRange.ParentElement.SourceIndex;
3312end;
3313//------------------------------------------------------------------------------
3314Procedure TEmbeddedED.GetSelEndElement;
3315var
3316 aTxtRange: IHTMLTxtRange;
3317begin
3318 //asm int 3 end; //trap
3319 aTxtRange := FActualTxtRange.duplicate;
3320 aTxtRange.Collapse(False); //end of selection
3321 FEndElementSourceIndex := aTxtRange.ParentElement.SourceIndex;
3322end;
3323//------------------------------------------------------------------------------
3324function TEmbeddedED.GetElementNr(ElementNumber: Integer): IHTMLElement;
3325var
3326 aItem: Integer;
3327begin
3328 //asm int 3 end; //trap
3329 aItem := FFirstElement + ElementNumber;
3330 Result := FElementCollection.item(aItem, null) as IHTMLElement;
3331 DebugString := Result.OuterHTML;
3332end;
3333//------------------------------------------------------------------------------
3334function TEmbeddedED.GetSelLength: Integer;
3335var
3336 aElement: IHTMLElement;
3337 PrevElement: IHTMLElement;
3338 I: Integer;
3339begin
3340 //asm int 3 end; //trap
3341 if FLength < 0 //not yet initialised
3342 then begin
3343 GetSelStartElement; //get element at start selection
3344 GetSelEndElement; //get element at end selection
3345
3346 FElementCollection := FActualElement.all as IHTMLElementCollection;
3347 FLength := FElementCollection.length;
3348
3349 if FLength < FEndElementSourceIndex - FStartElementSourceIndex
3350 {sometimes i.e. if all cells in a table is selected only the last
3351 element is returned in the ElementCollection :-(
3352 But luckily FStartElementSourceIndex and FEndElementSourceIndex
3353 is correctly computed }
3354 then begin
3355 FElementCollection := DOC.all as IHTMLElementCollection;
3356 FLength := FElementCollection.length;
3357 end;
3358
3359 if FLength = 0 //only one element selected
3360 then begin
3361 FFirstElement := 0;//FStartElementSourceIndex;
3362 FLastElement := 0;//FStartElementSourceIndex;
3363 Result := FLength;
3364 exit;
3365 end;
3366
3367 { the collection may contain more elements than selected.
3368 return only elements that are inside the selection }
3369
3370 //Find first element inside selection
3371 for I := 0 to FLength -1 do
3372 begin
3373 aElement := FElementCollection.item(i, null) as IHTMLElement;
3374 { the first element sometimes have an sourceindex of one higher
3375 than FStartElementSourceIndex ? so break on <= }
3376 if FStartElementSourceIndex <= aElement.SourceIndex
3377 then begin
3378 FFirstElement := I; //first element inside selection
3379 break;
3380 end;
3381 PrevElement := aElement;
3382 end;
3383
3384 //certain elements must be kept together
3385 if (FFirstElement > 0) and (not KeepLI) and
3386 SameText(PrevElement.tagName, 'LI')
3387 then Dec(FFirstElement);
3388
3389
3390
3391 //Find last element inside selection
3392 for I := FLength -1 downto 0 do
3393 begin
3394 aElement := FElementCollection.item(i, null) as IHTMLElement;
3395 if FEndElementSourceIndex = aElement.SourceIndex
3396 then begin
3397 FLastElement := I; //last element inside selection
3398 break;
3399 end;
3400 end;
3401
3402 if FLastElement = FFirstElement
3403 then FLength := 0 //there is 1 element in the collection
3404 else FLength := FLastElement - FFirstElement;// +1;
3405
3406 end;
3407
3408 Result := FLength;
3409end;
3410//------------------------------------------------------------------------------
3411procedure TEmbeddedED.GetSelParentElement;
3412begin
3413 //asm int 3 end; //trap
3414 FActualElement := FActualElement.ParentElement;
3415 FActualTxtRange.MoveToElementText(FActualElement);
3416 FActualTxtRange.Select;
3417 FLength := -1;
3418end;
3419//------------------------------------------------------------------------------
3420function TEmbeddedED._GetNextItem(const aTag: String = ''): IHTMLElement;
3421var
3422 aElement: IHTMLElement;
3423
3424 //-----------------------
3425 Function LastElementsParents: boolean;
3426 begin
3427 LastElementsParents := False;
3428 //we might find the searched element higher up the chain
3429
3430 while not SameText(aElement.tagName, cBODY) do
3431 begin
3432 aElement := aElement.parentElement;
3433 if SameText(aElement.tagName, aTag)
3434 then begin //we found it :-)
3435 _GetNextItem := aElement;
3436 LastElementsParents := true;
3437 break;
3438 end;
3439 end;
3440 end;
3441 //-----------------------
3442begin
3443 //asm int 3 end; //trap
3444 if sameText('LI', aTag)
3445 then KeepLI := True
3446 else KeepLI := false;
3447
3448 {FLength = -1 means the GetLength function isn't initialised yet}
3449 if (FLength > -1) and (FTagNumber >{=} FLength) //no more tags in collection
3450 then begin
3451 Result := Nil;
3452 exit;
3453 end;
3454
3455 if GetSelLength = 0 //if GetLength isn't initialised yet it happens now
3456 then begin
3457 //only one element is selected
3458 if (System.length(aTag) = 0) or
3459 AnsiSameText(aTag, FActualElement.tagName)
3460 then Result := FActualElement
3461 else begin
3462 Result := Nil;
3463 aElement := FActualElement;
3464 LastElementsParents;
3465 end;
3466 inc(FTagNumber);
3467 exit;
3468 end;
3469
3470 //get next element from collection
3471 Result := GetElementNr(FTagNumber);
3472 inc(FTagNumber);
3473
3474 if (System.Length(aTag) = 0) or //no filter
3475 (AnsiSameText(aTag, Result.tagName)) //tag is filtered - but match tag name
3476 then exit;
3477
3478
3479 //the first tag might not fully contain the searched tag
3480
3481 if FTagNumber = 1 //it is the first tag [ 0 incremented ]
3482 then begin
3483 aElement := Result;
3484 if LastElementsParents
3485 then exit;
3486 end;
3487
3488
3489 //loop tag collection looking fore a matching tag
3490 while true do
3491 begin
3492 if FTagNumber > FLength //no more tags in collection
3493 then begin
3494 Result := Nil;
3495 Break;
3496 end;
3497
3498 //get next element from collection
3499 Result := GetElementNr(FTagNumber);
3500 inc(FTagNumber);
3501
3502 if Assigned(Result) and AnsiSameText(aTag, Result.tagName)
3503 then Break;
3504 end;
3505end;
3506//------------------------------------------------------------------------------
3507Function TEmbeddedED.GetFirstSelElement(const aTag: String = ''): IHTMLElement;
3508begin
3509 //asm int 3 end; //trap
3510 FTagNumber := 0;
3511 FLength := - 1;
3512 Result := _GetNextItem(aTag);
3513end;
3514//------------------------------------------------------------------------------
3515Function TEmbeddedED.GetNextSelElement(const aTag: String = ''): IHTMLElement;
3516begin
3517 //asm int 3 end; //trap
3518 Result := _GetNextItem(aTag);
3519end;
3520//------------------------------------------------------------------------------
3521Function TEmbeddedED.GetSelText: String;
3522begin
3523 //asm int 3 end; //trap
3524 if FActualRangeIsText
3525 Then Result := Trim(FActualTxtRange.Text)
3526 else result := '';
3527end;
3528//------------------------------------------------------------------------------
3529Function TEmbeddedED.IsSelType(aType: string): boolean;
3530begin
3531 //asm int 3 end; //trap
3532 result := SameText(aType, FSelectionType);
3533end;
3534//------------------------------------------------------------------------------
3535procedure TEmbeddedED.KeepSelectionVisible;
3536begin
3537 //asm int 3 end; //trap
3538 { after pasting text into a textrang the screen selection is cleared. }
3539
3540 FMarkUpServices.MoveRangeToPointers(FMarkupPointerStart, FMarkupPointerEnd, FActualTxtRange);
3541 SelectActualTextrange;
3542end;
3543//------------------------------------------------------------------------------
3544function TEmbeddedED.GetSelParentElementType(const aType: string; aMessage: string = ''): IHTMLElement;
3545begin
3546 //asm int 3 end; //trap
3547
3548 //go up to the aType-tag
3549 GetParentElemetType(FActualElement, aType, Result);
3550
3551 if SameText(Result.tagName, cBODY) and (not SameText(cBODY, aType))
3552 then begin
3553 result := Nil;
3554 if System.length(aMessage) > 0
3555 then KSMessageI(aMessage);
3556 end;
3557end;
3558//------------------------------------------------------------------------------
3559Function TEmbeddedED.IsSelElementID(const ID: String): Boolean;
3560begin
3561 //asm int 3 end; //trap
3562 Result := assigned(FActualElement) and AnsiSameText(FActualElement.ID, ID)
3563end;
3564//------------------------------------------------------------------------------
3565Function TEmbeddedED.IsSelElementClassName(const ClassName: String): Boolean;
3566begin
3567 //asm int 3 end; //trap
3568 //kt Result := AnsiSameText(FActualElement._ClassName, ClassName) // RHR
3569 Result := AnsiSameText(FActualElement.className, ClassName) // kt
3570end;
3571//------------------------------------------------------------------------------
3572Function TEmbeddedED.IsSelElementTagName(const TagName: String): Boolean;
3573begin
3574 //asm int 3 end; //trap
3575 Result := AnsiSameText(FActualElement.TagName, TagName)
3576end;
3577//------------------------------------------------------------------------------
3578Function TEmbeddedED.IsSelElementInVisible: Boolean;
3579begin
3580 //.asm int 3 end; //trap
3581 result := SameText(FActualElement.Style.display, 'none')
3582end;
3583//------------------------------------------------------------------------------
3584function TEmbeddedED.IsSelElementAbsolute: boolean;
3585begin
3586 //.asm int 3 end; //trap - not used
3587 result := SameText(FActualElement.Style.Position, 'absolute')
3588end;
3589//------------------------------------------------------------------------------
3590procedure TEmbeddedED.MakeSelElementVisible(Show: boolean);
3591begin
3592 //asm int 3 end; //trap
3593 if Show
3594 then FActualElement.Style.display := ''
3595 else FActualElement.Style.display := 'none';
3596end;
3597//------------------------------------------------------------------------------
3598procedure TEmbeddedED.TrimSelection;
3599//remove any leading / trailing spaces from the selection.
3600var
3601 S: String;
3602begin
3603 //asm int 3 end; //trap
3604 //beware Selection can contain selected elements ie. end wit an IMG tag
3605
3606 S := FActualTxtRange.htmlText;
3607
3608 //selection of spaces normaly only ocoures trailing, but just in case
3609 while (System.length(S) > 0) and (S[1] = #32) do
3610 begin
3611 FActualTxtRange.MoveStart('character', 1);
3612 Delete(S, 1, 1);
3613 end;
3614
3615 while (System.length(S) > 0) and (S[System.Length(S)] = #32) do
3616 begin
3617 FActualTxtRange.MoveEnd('character', -1);
3618 Delete(S, System.Length(S), 1);
3619 end;
3620end;
3621//------------------------------------------------------------------------------
3622procedure TEmbeddedED.SelectActualTextrange;
3623begin
3624 //asm int 3 end; //trap
3625 FActualTxtRange.Select;
3626end;
3627//------------------------------------------------------------------------------
3628procedure TEmbeddedED.SelectElement(aElement: IhtmlElement);
3629begin
3630 //asm int 3 end; //trap
3631
3632 if not assigned(aElement)
3633 then exit;
3634
3635 FActualElement := aElement;
3636
3637 FActualRangeIsText := False;
3638 if not assigned(FActualTxtRange)
3639 then FActualTxtRange := (DOC.body as IHTMLBodyElement).createTextRange;
3640 FActualTxtRange.MoveToElementText(FActualElement);
3641
3642 FActualTxtRange.Select;
3643
3644 if length(FActualElement.InnerHTML) = 0
3645 then begin
3646 if SetCursorAtElement(aElement, ELEM_ADJ_BeforeBegin)
3647 then ShowCursor(true);
3648 end;
3649end;
3650//------------------------------------------------------------------------------
3651function TEmbeddedED.SetCursorAtElement(aElement: IhtmlElement; ADJACENCY:_ELEMENT_ADJACENCY): Boolean;
3652begin
3653 //asm int 3 end; //trap
3654
3655 result := false;
3656 if not assigned(aElement)
3657 then exit;
3658
3659 if S_OK = FMarkupPointerStart.MoveAdjacentToElement(aElement, ADJACENCY)
3660 then begin
3661 FDisplayPointerStart.SetDisplayGravity(DISPLAY_GRAVITY_NextLine);
3662 if S_OK = FDisplayPointerStart.MoveToMarkupPointer(FMarkupPointerStart, nil)
3663 then result := S_OK = FCaret.MoveCaretToPointer(FDisplayPointerStart, 0, CARET_DIRECTION_SAME);
3664 end;
3665end;
3666//------------------------------------------------------------------------------
3667procedure TEmbeddedED.CollapseActualTextrange(Start: boolean);
3668begin
3669 //.asm int 3 end; //trap - not used
3670 FActualTxtRange.Collapse(Start);
3671end;
3672//------------------------------------------------------------------------------
3673function TEmbeddedED._LoadFile(aFileName: String): HResult;
3674var
3675 OldFilePath: String;
3676begin
3677 //asm int 3 end; //trap
3678 if TwebBrowser(Self).Document <> nil
3679 then begin
3680 FReadyState := 0;
3681 OldFilePath := FCurrentDocumentPath;
3682 FCurrentDocumentPath := aFileName;
3683
3684 Result := PersistFile.Load(StringToOleStr(aFileName),
3685 STGM_READWRITE or STGM_SHARE_DENY_NONE);
3686
3687 { PersistStream.Load causes a DocumentComplete event with the last known URL
3688 Typically this is about:blank }
3689
3690 WaitForDocComplete;
3691
3692 if result <> S_OK
3693 then FCurrentDocumentPath := OldFilePath;
3694 end
3695 else result := S_false;
3696end;
3697//------------------------------------------------------------------------------
3698function TEmbeddedED.LoadFile(var aFileName: String): HResult;
3699begin
3700 //asm int 3 end; //trap
3701 result := LoadFile(aFileName, false);
3702end;
3703//------------------------------------------------------------------------------
3704function TEmbeddedED.LoadFile(var aFileName: String; PromptUser: boolean): HResult;
3705var
3706 S: String;
3707
3708 //---------------------------------------------
3709 function GetFileName(Var aFileName: String): Boolean;
3710 var
3711 aOpenDlg: TOpenDialog;
3712 begin
3713 aOpenDlg := TOpenDialog.Create(Nil);
3714 try
3715 aOpenDlg.Filter := aFilter;
3716 aOpenDlg.Filename := aFileName;
3717 aOpenDlg.Options := [ofEnableSizing, ofFileMustExist];
3718
3719 if aOpenDlg.Execute
3720 then begin
3721 aFileName := aOpenDlg.FileName;
3722 Result := true;
3723 end
3724 else result := false;
3725 finally
3726 aOpenDlg.free;
3727 end;
3728 end;
3729 //----------------------------------------------
3730 function DoLocalFile: HResult;
3731 begin
3732 if (not PromptUser) and
3733 FileExists(aFileName)
3734 then result := _LoadFile(aFileName)
3735 else begin
3736 if GetFileName(aFileName)
3737 then Result := _LoadFile(aFileName)
3738 else result := S_false;
3739 end;
3740 end;
3741 //----------------------------------------------
3742begin
3743 //asm int 3 end; //trap
3744
3745 result := EndCurrentDoc(CancelPosible, FSkipDirtyCheck);
3746
3747 if result = S_OK
3748 then begin
3749 if pos('file://', LowerCase(aFileName)) = 1
3750 then begin
3751 //we have a file protocol path
3752 if IsFilePath(aFileName, S) = S_OK
3753 then begin
3754 aFileName := S;
3755 if FileExists(aFileName)
3756 then result := _LoadFile(aFileName)
3757 else result := DoLocalFile;
3758
3759 if result = S_OK
3760 then Delete(aFileName, LastDelimiter('\/', aFileName)+1, Length(aFileName));
3761 end;
3762 end
3763
3764 else if (pos('http://', LowerCase(aFileName)) = 1) or (pos('www.', LowerCase(aFileName)) = 1)
3765 then begin
3766 //we have a http protocol path
3767 Result := GO(aFileName);
3768 end
3769
3770 else begin
3771 result := DoLocalFile;
3772 if result = S_OK
3773 then Delete(aFileName, LastDelimiter('\/', aFileName)+1, Length(aFileName));
3774 end;
3775
3776 if result = S_OK
3777 then begin
3778 if Assigned(FAfterLoadFile)
3779 then FAfterLoadFile(Self, FCurrentDocumentPath);
3780 end;
3781 end;
3782end;
3783//------------------------------------------------------------------------------
3784function TEmbeddedED.DocIsPersist: boolean;
3785var
3786 Pw: PWideChar;
3787begin
3788 //asm int 3 end; //trap
3789 if TwebBrowser(Self).Document <> nil
3790 then result := S_OK = PersistFile.GetCurFile(Pw)
3791 else result := false;
3792end;
3793//------------------------------------------------------------------------------
3794Function TEmbeddedED.GetPersistedFile: String;
3795var
3796 Pw: PWideChar;
3797begin
3798 //asm int 3 end; //trap
3799 // just return the BaseURL if we have a htttp path or a local file path
3800
3801 if TwebBrowser(Self).Document <> nil
3802 then begin
3803 if S_OK = PersistFile.GetCurFile(Pw) //this also tests for persisted file
3804 then begin
3805 result := Pw;
3806
3807 if (length(result) > 0) and
3808 (pos('file://', result) = 1) //we have a file protocol path
3809 then begin
3810 //.asm int 3 end; //trap
3811 delete(result, 1, 7);
3812 end;
3813
3814 result := StringReplace(result, '/', '\', [rfReplaceAll]);
3815 end
3816
3817 else begin //the document is not a persisted file
3818 result := DOC.URL;
3819
3820 //drop bookmark - just in case
3821 Delete(result, LastDelimiter('#', result), length(result));
3822
3823
3824 { this is a special case - normally only in case of a "preview browser where
3825 the document content is feed in via DocumentHTML - causing the documents
3826 file path to become about:blank
3827 If the real document pat is set via SetDocumentPath we can use that in stead
3828 of about:blank}
3829 If SameText(result, AboutBlank) //and (Length(FDocumentPath) > 0)
3830 then result := '';//FDocumentPath;
3831 end;
3832 end
3833 else result := '';
3834
3835
3836{ LocationName: the name of the resource currently displayed in the Web browser control.
3837 If the resource is an HTML page from the Web, LocationName is the title of that page.
3838 If the resource is a folder or file on the local network or on a disk,
3839 LocationName is the full UNC name of the folder or file. }
3840end;
3841//------------------------------------------------------------------------------
3842function TEmbeddedED.GetSaveFileName(var aFile: string): HResult;
3843var
3844 aSaveDlg: TSaveDialog;
3845begin
3846 //asm int 3 end; //trap
3847 aSaveDlg := TSaveDialog.Create(Nil);
3848 try
3849 aSaveDlg.DefaultExt := 'htm';
3850 aSaveDlg.Filter := aFilter;
3851 aSaveDlg.InitialDir := ExtractFilePath(aFile);
3852 aSaveDlg.Filename := aFile;
3853 aSaveDlg.Options := [ofOverwritePrompt, ofPathMustExist, ofNoReadOnlyReturn, ofEnableSizing];
3854
3855 if aSaveDlg.Execute
3856 then begin
3857 aFile := aSaveDlg.Filename;
3858 result := S_OK;
3859 end
3860 else begin
3861 aFile := '';
3862 result := S_false;
3863 end;
3864 finally
3865 aSaveDlg.free;
3866 end;
3867end;
3868//------------------------------------------------------------------------------
3869procedure TEmbeddedED.AfterFileSaved;
3870begin
3871 //asm int 3 end; //trap
3872 if Assigned(FAfterSaveFile)
3873 then FAfterSaveFile(Self);
3874end;
3875//------------------------------------------------------------------------------
3876function TEmbeddedED.SaveFile: HResult;
3877begin
3878 //asm int 3 end; //trap
3879 result := DoSaveFile;
3880
3881 if result = S_OK
3882 then AfterFileSaved;
3883end;
3884//------------------------------------------------------------------------------
3885function TEmbeddedED._DoSaveFile: HResult;
3886Const
3887 ClearDirtyFlag: boolean = true;
3888begin
3889 //asm int 3 end; //trap
3890
3891 _CheckGenerator(False);
3892
3893 if DocIsPersist //DOC is file based
3894 then Result := PersistFile.Save(Nil, ClearDirtyFlag)
3895 else Result := PersistFile.Save(StringToOleStr(FCurrentDocumentPath), ClearDirtyFlag);
3896
3897 if result = S_OK
3898 then FHTMLImage := KS_Lib.GetHTMLtext(DOC); //Get SnapShot of current HTML Source
3899end;
3900//------------------------------------------------------------------------------
3901function TEmbeddedED.DoSaveFile: HResult;
3902var
3903 IsPersist: Boolean;
3904begin
3905 //asm int 3 end; //trap
3906
3907 IsPersist := DocIsPersist; //DOC is file based
3908
3909 if (not IsDirty) and IsPersist and (not (GetAsyncKeyState(VK_CONTROL) < 0))
3910 then begin
3911 result := S_OK; //no need to save a clean file
3912 exit;
3913 end;
3914
3915 result := S_false;
3916
3917 if (TwebBrowser(Self).Document = nil) or (not FEditMode)
3918 then exit;
3919
3920 if Assigned(FBeforeSaveFile)
3921 then begin
3922 FBeforeSaveFile(Self);
3923 //WaitForDocComplete; //just in case the document was changed
3924 end;
3925
3926 if IsPersist or
3927 ((Length(FCurrentDocumentPath) > 0) and fileExists(FCurrentDocumentPath))
3928 then result := _DoSaveFile
3929 else result := SaveFileAs;
3930end;
3931//------------------------------------------------------------------------------
3932function TEmbeddedED.SaveFileAs(aFile: string = ''): HResult;
3933begin
3934 //asm int 3 end; //trap
3935 result := DoSaveFileAs(aFile);
3936
3937 if result = S_OK
3938 then AfterFileSaved;
3939end;
3940//------------------------------------------------------------------------------
3941function TEmbeddedED.DoSaveFileAs(aFile: String): HResult;
3942Const
3943 ClearDirtyFlag: boolean = true;
3944var
3945 DoSave: boolean;
3946begin
3947 //asm int 3 end; //trap
3948 if (TwebBrowser(Self).Document = nil) or (not FEditMode)
3949 then begin
3950 result := S_false;
3951 exit;
3952 end;
3953
3954 if length(aFile) > 0
3955 then begin
3956 { this wont work because the MSHTML dialog always shows up
3957 Ov := aFile;
3958 result := DoCommand(IDM_SAVEAS, OLECMDEXECOPT_DONTPROMPTUSER, Ov); }
3959
3960
3961 { this gives the user a Delphi save dialog }
3962 If FileExists(aFile)
3963 then DoSave := IDYES = KSQuestion(aFile + ' already exists.' +CrLf+
3964 'Do you want to replace it?', '',
3965 MB_ICONWARNING or MB_YESNO)
3966 else begin
3967 ForceDirectories(ExtractFilePath(aFile));
3968 DoSave := true;
3969 end;
3970
3971 if DoSave
3972 then begin
3973 _CheckGenerator(false);
3974 Result := PersistFile.Save(StringToOleStr(aFile), false);
3975 end
3976 else Result := E_ABORT;
3977 end
3978 else begin
3979 {this gives the user MSHTML's own save dialog }
3980 _CheckGenerator(false);
3981 result := CmdSet(IDM_SAVEAS);
3982 end;
3983
3984 if result = S_OK //file was saved successfully
3985 then begin
3986 FCurrentDocumentPath := GetPersistedFile;
3987 { we need to re-parse the DOC from the new path
3988 this also get us a new FHTMLImage !
3989
3990 FBASEUrl is set as a result to _LoadFile ! }
3991
3992 result := _LoadFile(FCurrentDocumentPath);
3993
3994 if FCurBackFile <> ChangeFileExt(FCurrentDocumentPath, '.bak')
3995 then begin
3996 Sysutils.DeleteFile(FCurBackFile);
3997 CreateBackUp;
3998 end;
3999 end;
4000end;
4001//------------------------------------------------------------------------------
4002procedure TEmbeddedED.SetLiveResize(const Value: Boolean);
4003var
4004 Ov: OleVariant;
4005begin
4006 //asm int 3 end; //trap
4007 FLiveResize := Value;
4008 if TwebBrowser(Self).Document <> nil
4009 then begin
4010 Ov := FLiveResize;
4011 CmdSet(IDM_LIVERESIZE, Ov);
4012 end;
4013end;
4014//------------------------------------------------------------------------------
4015procedure TEmbeddedED.Set2DPosition(const Value: Boolean);
4016var
4017 Ov: OleVariant;
4018begin
4019 //asm int 3 end; //trap
4020 F2DPosition := Value;
4021 if TwebBrowser(Self).Document <> nil
4022 then begin
4023 Ov := F2DPosition;
4024 CmdSet(IDM_2D_POSITION, Ov);
4025 end;
4026end;
4027//------------------------------------------------------------------------------
4028function TEmbeddedED.GetMSHTMLwinHandle: Hwnd;
4029begin
4030 //asm int 3 end; //trap
4031 //get the DHTMLedit component's main window handle
4032
4033 if FOleInPlaceActiveObject = nil
4034 then GetInPlaceActiveObject;
4035
4036 result := FmsHTMLwinHandle;
4037end;
4038//------------------------------------------------------------------------------
4039procedure TEmbeddedED.ScrollDoc(Pos: Integer);
4040begin
4041 //asm int 3 end; //trap
4042 if (TwebBrowser(Self).Document <> nil) and (Pos > 0)
4043 then begin
4044 (Doc.Body as IHTMLElement2).ScrollTop := Pos;
4045 FScrollTop := 0;
4046 end;
4047end;
4048//------------------------------------------------------------------------------
4049procedure TEmbeddedED.SetMouseElement(P: Tpoint; aWinHandle: Hwnd = 0);
4050begin
4051 //asm int 3 end; //trap
4052 if aWinHandle > 0
4053 { MouseClickOnElement is in screen coordinate,
4054 change it to DHTML window coordinate }
4055 then Windows.ScreenToClient(aWinHandle, P);
4056
4057 FActualElement := DOC.elementFromPoint(P.x, P.y);
4058
4059 FActualRangeIsText := False;
4060 if not assigned(FActualTxtRange)
4061 then FActualTxtRange := (DOC.body as IHTMLBodyElement).createTextRange;
4062 FActualTxtRange.MoveToElementText(FActualElement);
4063end;
4064//------------------------------------------------------------------------------
4065Function TEmbeddedED.RemoveElementID(const TagID: String): Boolean;
4066var
4067 MarkUp: IMarkupServices;
4068 aElement: IHTMLElement;
4069 I: Integer;
4070begin
4071 //asm int 3 end; //trap
4072 MarkUp := Doc as IMarkupServices;
4073 Result := False;
4074
4075 for i := 0 to FLength - 1 do
4076 begin
4077 aElement := GetElementNr(i);
4078
4079 if not assigned(aElement)
4080 then continue;
4081
4082 if AnsiSameText(TagID, aElement.ID)
4083 then begin
4084 Markup.RemoveElement(aElement);
4085 Result := True;
4086 end;
4087 end;
4088end;
4089//------------------------------------------------------------------------------
4090procedure TEmbeddedED.ShowHighlight(pIRange: IHTMLTxtRange = nil);
4091var
4092 aTxtRange: IHTMLTxtRange;
4093begin
4094 //asm int 3 end; //trap
4095
4096 if pIRange = nil
4097 then begin
4098 aTxtRange := (DOC.body as IHTMLBodyElement).createTextRange;
4099 aTxtRange.moveToElementText(FActualElement);
4100 end
4101 else aTxtRange := pIRange.duplicate;
4102
4103 FMarkUpServices.MovePointersToRange(aTxtRange, FMarkupPointerStart, FMarkupPointerEnd);
4104
4105 //kt FDisplayPointerStart.MoveToMarkupPointer(FMarkupPointerStart as MSHTML_TLB.IMarkupPointer, nil);
4106 FDisplayPointerStart.MoveToMarkupPointer(FMarkupPointerStart as MSHTML_EWB.IMarkupPointer, nil); //kt
4107 //ktFDisplayPointerEnd.MoveToMarkupPointer(FMarkupPointerEnd as MSHTML_TLB.IMarkupPointer, nil);
4108 FDisplayPointerEnd.MoveToMarkupPointer(FMarkupPointerEnd as MSHTML_EWB.IMarkupPointer, nil); //kt
4109
4110 if assigned(FHighlightSegment)
4111 then HideHighlight;
4112
4113 FHighlight.AddSegment(FDisplayPointerStart, FDisplayPointerEnd, FRenderStyle, FHighlightSegment);
4114end;
4115//------------------------------------------------------------------------------
4116procedure TEmbeddedED.HideHighlight;
4117begin
4118 //asm int 3 end; //trap
4119 if assigned(FHighlightSegment)
4120 then FHighlight.RemoveSegment(FHighlightSegment);
4121end;
4122//------------------------------------------------------------------------------
4123function TEmbeddedED.MovePointersToRange(const aRange: IHTMLTxtRange): HResult;
4124begin
4125 //.asm int 3 end; //trap
4126 Result := FMarkUpServices.MovePointersToRange(aRange, FMarkupPointerStart, FMarkupPointerEnd);
4127end;
4128//------------------------------------------------------------------------------
4129function TEmbeddedED.MovePointersToSel: HResult;
4130begin
4131 //.asm int 3 end; //trap
4132 Result := MovePointersToRange(FActualTxtRange);
4133end;
4134//------------------------------------------------------------------------------
4135function TEmbeddedED.CreateElement(const tagID: _ELEMENT_TAG_ID; var NewElement: IHTMLElement; const aTxtRange: IHTMLTxtRange = nil; const Attributes: string = ''): HResult;
4136begin
4137 //asm int 3 end; //trap
4138 //attributes form:
4139
4140 {$IFDEF EDLIB}
4141 if aTxtRange = nil
4142 then result := EDLIB.CreateElement(DOC, tagID, NewElement, FActualTxtRange, Attributes)
4143 else result := EDLIB.CreateElement(DOC, tagID, NewElement, aTxtRange, Attributes);
4144 {$ELSE}
4145 result := S_False;
4146 {$ENDIF}
4147end;
4148//------------------------------------------------------------------------------
4149function TEmbeddedED.InsertElementAtCursor(var aElement: IHTMLElement; const aTxtRange: IHTMLTxtRange = nil): HResult;
4150begin
4151 //asm int 3 end; //trap
4152 { The returned IHTMLTxtRange contains the new tag - if its not a control ??}
4153
4154 {$IFDEF EDLIB}
4155 Result := EDLIB.InsertElementAtCursor(DOC, aElement, aTxtRange);
4156 {$ELSE}
4157 result := S_False;
4158 {$ENDIF}
4159end;
4160//------------------------------------------------------------------------------
4161function TEmbeddedED.CreateMetaTag(var aMetaElement: IHTMLMetaElement): HResult;
4162begin
4163 //asm int 3 end; //trap
4164 {$IFDEF EDLIB}
4165 Result := EDLIB.CreateMetaTag(DOC, aMetaElement);
4166 {$ELSE}
4167 result := S_False;
4168 {$ENDIF}
4169end;
4170//------------------------------------------------------------------------------
4171function TEmbeddedED.MoveTextRangeToPointer(aTxtRange: IHTMLTxtRange = nil): IHTMLTxtRange;
4172begin
4173 //asm int 3 end; //trap
4174 if assigned(aTxtRange)
4175 then begin
4176 FMarkUpServices.MoveRangeToPointers(FMarkupPointerStart, FMarkupPointerEnd, aTxtRange);
4177 result := aTxtRange;
4178 end
4179 else begin
4180 FMarkUpServices.MoveRangeToPointers(FMarkupPointerStart, FMarkupPointerEnd, FActualTxtRange);
4181 result := FActualTxtRange;
4182 end;
4183end;
4184//------------------------------------------------------------------------------
4185procedure TEmbeddedED.SetDebug(value: Boolean);
4186begin
4187 //asm int 3 end; //trap
4188 FDebug := value;
4189end;
4190//------------------------------------------------------------------------------
4191function TEmbeddedED.GetCurrentFontName: string;
4192var
4193 FontName: variant;
4194begin
4195 //asm int 3 end; //trap
4196 result := ''; // FontName not found
4197
4198 if QueryEnabled(IDM_FONTNAME)
4199 then begin
4200 FontName := CmdGet(IDM_FONTNAME);
4201 if VarType(FontName) = varOleStr
4202 then result := FontName
4203 else; //multiple element selection
4204 end;
4205end;
4206//------------------------------------------------------------------------------
4207function TEmbeddedED.GetFontNameIndex(aList: String): Integer;
4208var
4209 FontName: variant;
4210 //I: Integer;
4211 list: TStringlist;
4212begin
4213 //asm int 3 end; //trap
4214 result := -1; // FontName not found
4215
4216 if QueryEnabled(IDM_FONTNAME)
4217 then begin
4218 FontName := CmdGet(IDM_FONTNAME);
4219 if VarType(FontName) = varOleStr
4220 then begin
4221 list := TStringlist.Create;
4222 try
4223 list.Text := aList;
4224 result := List.IndexOf(FontName);
4225 finally
4226 list.free;
4227 end;
4228 end
4229 else; //multiple element selection
4230 end;
4231end;
4232//------------------------------------------------------------------------------
4233function EnumFontsProc(var LogFont: TLogFont; var Metric: TTextMetric; FontType: Integer; Data: Pointer): Integer; stdcall;
4234var
4235 St: TStrings;
4236 aFaceName: string;
4237begin
4238 //asm int 3 end; //trap
4239 St := TStrings(Data);
4240 aFaceName := LogFont.lfFaceName;
4241
4242 if (St.Count = 0) or
4243 (AnsiCompareText(St[St.Count-1], aFaceName) <> 0)
4244 then St.Add(aFaceName);
4245
4246 Result := 1;
4247end;
4248//------------------------------------------------------------------------------
4249function TEmbeddedED.GetFonts: String;
4250var
4251 DC: HDC;
4252 LFont: TLogFont;
4253begin
4254 //asm int 3 end; //trap
4255
4256 if FFonts = nil
4257 then begin
4258 FFonts := TStringList.Create;
4259 DC := GetDC(GetMSHTMLwinHandle);
4260 try
4261 FFonts.Add('Default');
4262 FillChar(LFont, sizeof(LFont), 0);
4263 LFont.lfCharset := DEFAULT_CHARSET;
4264 //we send the resulting fontlist (FFonts) to EnumFontsProc as a param
4265 EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, LongInt(FFonts), 0);
4266 TStringList(FFonts).Sorted := TRUE;
4267 finally
4268 ReleaseDC(0, DC);
4269 end;
4270 end;
4271
4272 Result := FFonts.Text;
4273
4274 //just a test
4275 if (Screen.Fonts.text <> result) and //this seem newer to be true !
4276 FDebug
4277 then beep;
4278end;
4279//------------------------------------------------------------------------------
4280function TEmbeddedED.GetFontSizeIndex(const aList: String; var Changed: String): Integer;
4281var
4282 vo: OleVariant;
4283 aCurStyle: IHTMLCurrentStyle;
4284 s: String;
4285
4286 //------------------------------------------------
4287 function GetBaseSize: string;
4288 begin
4289 result := '1 ( 8 pt)' +CrLf +
4290 '2 (10 pt)' +CrLf +
4291 '3 (12 pt)' +CrLf +
4292 '4 (14 pt)' +CrLf +
4293 '5 (18 pt)' +CrLf +
4294 '6 (24 pt)' +CrLf +
4295 '7 (36 pt)';
4296 end;
4297 //------------------------------------------------
4298begin
4299 //asm int 3 end; //trap
4300
4301 result := -1; //no size found
4302
4303 if Length(aList) = 0
4304 then Changed := GetBaseSize
4305 else Changed := '';
4306
4307 if not QueryEnabled(IDM_FONTSIZE)
4308 then exit;
4309
4310
4311 Vo := CmdGet(IDM_FONTSIZE); //this gets the standard size 1-7 in stead of
4312 if VarType(vo) = VarInteger //x-small and the like
4313 then begin
4314 result := Vo-1;
4315 exit;
4316 end;
4317
4318 if FActualElement = nil
4319 then exit;
4320
4321 aCurStyle := (FActualElement as IHTMLElement2).Get_CurrentStyle;
4322
4323 S := aCurStyle.Get_fontSize;
4324 if S <> ''
4325 then begin
4326 Changed := GetBaseSize +CrLf + S;
4327 result := 7;
4328 end;
4329end;
4330//------------------------------------------------------------------------------
4331function TEmbeddedED.GetStylesIndex: Integer;
4332var
4333 S: String;
4334begin
4335 //asm int 3 end; //trap
4336
4337 if QueryEnabled(IDM_BLOCKFMT)
4338 then begin
4339 {$IFDEF EDLIB}
4340 S := getFontStyle(Self);
4341 {$ELSE}
4342 S := CmdGet(IDM_BLOCKFMT);
4343 {$ENDIF}
4344
4345 if not FStyles.Find(S, result)
4346 then result := -1;
4347 end
4348 else result := -1;
4349end;
4350//------------------------------------------------------------------------------
4351function TEmbeddedED.GetStylesIndex(aList: String): Integer;
4352//this is only to keep compatibility with OCX ver 1.0
4353var
4354 S: String;
4355 List: TStringList;
4356 //aElement: IhtmlElement;
4357begin
4358 //asm int 3 end; //trap
4359 //Available styles
4360
4361 if QueryEnabled(IDM_BLOCKFMT)
4362 then begin
4363 {$IFDEF EDLIB}
4364 S := getFontStyle(Self);
4365 {$ELSE}
4366 S := CmdGet(IDM_BLOCKFMT);
4367 {$ENDIF}
4368
4369 List := TStringList.Create;
4370 try
4371 List.Text := aList;
4372 result := List.IndexOf(S);
4373 finally
4374 List.free;
4375 end
4376 end
4377 else result := -1;
4378end;
4379//------------------------------------------------------------------------------
4380procedure TEmbeddedED.SyncDOC(HTML: string; SelStart, SelEnd: Integer);
4381var
4382 Generator: Boolean;
4383begin
4384 //asm int 3 end; //trap
4385
4386 {$IFDEF EDPARSER}
4387 {$IFDEF EDLIB}
4388 Generator := true;
4389 {$ENDIF}
4390
4391 //place the cursor at same pos in WYSIWY as in the string
4392 KSIEParser.SyncDOC(Self, HTML, SelStart, SelEnd, Generator);
4393 {$ENDIF}
4394end;
4395//------------------------------------------------------------------------------
4396function TEmbeddedED.SelectedDocumentHTML(var SelStart, SelEnd: Integer): String;
4397var
4398 Generator: Boolean;
4399begin
4400 //asm int 3 end; //trap
4401
4402 {$IFDEF EDPARSER}
4403 {$IFDEF EDLIB}
4404 Generator := true;
4405 {$ENDIF}
4406
4407 //place the cursor at same pos in WYSIWY as in the string
4408 Result := KSIEParser.SelectedDocumentHTML(Self, SelStart, SelEnd, Generator);
4409 {$ELSE}
4410 SelStart := -1;
4411 SelEnd := -1;
4412 Result := KS_Lib.GetHTMLtext(DOC);
4413 {$ENDIF}
4414end;
4415//------------------------------------------------------------------------------
4416function TEmbeddedED.GetSelStartEnd(Var SelStart, SelEnd: Integer): boolean;
4417begin
4418 //asm int 3 end; //trap
4419 result :=
4420 (S_OK = FMarkUpServices.MovePointersToRange(ActualTextRange, FMarkupPointerStart, FMarkupPointerEnd)) and
4421 //get selection in a reselectable form
4422 (S_OK = (FMarkupPointerStart as IMarkupPointer2).GetMarkupPosition(SelStart)) and
4423 (S_OK = (FMarkupPointerEnd as IMarkupPointer2).GetMarkupPosition(SelEnd));
4424end;
4425//------------------------------------------------------------------------------
4426function TEmbeddedED.SetSelStartEnd(SelStart, SelEnd: Integer): boolean;
4427var
4428 aMarkupContainer: IMarkupContainer;
4429begin
4430 //asm int 3 end; //trap
4431
4432 if (SelStart > 0) and (SelEnd > 0)
4433 then begin
4434 //Restore selected TextRange
4435 aMarkupContainer := Doc as IMarkupContainer;
4436 if (S_OK = (FMarkupPointerStart as IMarkupPointer2).MoveToMarkupPosition(aMarkupContainer, SelStart)) and
4437 (S_OK = (FMarkupPointerEnd as IMarkupPointer2).MoveToMarkupPosition(aMarkupContainer, SelEnd)) and
4438 (S_OK = FMarkupServices.MoveRangeToPointers(FMarkupPointerStart, FMarkupPointerEnd, ActualTxtRange))
4439 then ActualTxtRange.select;
4440 result := true;
4441 end
4442 else result := false;
4443end;
4444//------------------------------------------------------------------------------
4445function TEmbeddedED.ISEmptyParam(value: Olevariant): Boolean;
4446begin
4447 //asm int 3 end; //trap
4448 result := (TVarData(value).VType = varError) and
4449 (TVarData(value).VError = $80020004);
4450end;
4451//------------------------------------------------------------------------------
4452function TEmbeddedED.GetPrintFileName: String;
4453var
4454 aFileName: String;
4455
4456 //---------------------------------------
4457 function ValidFileName(aPath: string): Boolean;
4458 var
4459 I: Integer;
4460 begin
4461 I := LastDelimiter('.\:', aPath);
4462
4463 result := (I > 0) and //we have a path
4464 ((aPath[I] = '\') or //it ends with backslash
4465 (aPath[I] = '.')); //we found a trailing file name
4466 end;
4467 //---------------------------------------
4468begin
4469 //asm int 3 end; //trap
4470
4471 if length(CurFileName) > 0
4472 then result := CurFileName
4473 else begin
4474 if ValidFileName(FBaseUrl)
4475 then result := FBaseUrl
4476 else result := '';
4477 end;
4478end;
4479//------------------------------------------------------------------------------
4480function TEmbeddedED.GetLastError: string;
4481begin
4482 //asm int 3 end; //trap
4483 result := FLastError;
4484end;
4485//------------------------------------------------------------------------------
4486function TEmbeddedED.OpenChangeLog: HResult;
4487begin
4488 //asm int 3 end; //trap
4489 {$IFDEF EDUNDO}
4490 result := UUndo.OpenChangeLog(self, FTUndo);
4491 {$ELSE}
4492 result := S_OK;
4493 {$ENDIF}
4494end;
4495//------------------------------------------------------------------------------
4496procedure TEmbeddedED.WaitAsyncMessage(var Msg: Tmessage);
4497begin
4498 //asm int 3 end; //trap
4499 FWaitMessage := true;
4500end;
4501//------------------------------------------------------------------------------
4502function TEmbeddedED.BeginUndoUnit(aTitle: String = 'Default'): HResult;
4503begin
4504 //asm int 3 end; //trap
4505
4506 if FLocalUndo
4507 then begin
4508 {$IFDEF EDUNDO}
4509 if FTUndo <> nil
4510 then result := TUndo(FTUndo).BeginUndoUnit(aTitle)
4511 else result := S_False;
4512 {$ENDIF}
4513 end
4514 else begin
4515 {$IFDEF EDLIB}
4516 result := EDLIB.BeginUndoUnit(Self, aTitle);
4517 {$ELSE}
4518 result := S_False;
4519 {$ENDIF}
4520 end;
4521end;
4522//------------------------------------------------------------------------------
4523function TEmbeddedED.EndUndoUnit: HResult;
4524begin
4525 //asm int 3 end; //trap
4526
4527 if FLocalUndo
4528 then begin
4529 if FTUndo <> nil
4530 then begin
4531 {$IFDEF EDUNDO}
4532 TUndo(FTUndo).EndUndoBlock;
4533 result := S_OK;
4534 {$ENDIF}
4535 end
4536 else result := S_False;
4537 end
4538 else begin
4539 {$IFDEF EDLIB}
4540 result := EDLIB.EndUndoUnit(Self);
4541 {$ELSE}
4542 result := S_False;
4543 {$ENDIF}
4544 end;
4545end;
4546//------------------------------------------------------------------------------
4547procedure TEmbeddedED.LoadURL(url: String);
4548var
4549 aFileName: String;
4550begin
4551 // just DHTML Compatibility
4552 //asm int 3 end; //trap
4553
4554 aFileName := url;
4555 if Length(aFileName) = 0
4556 then begin
4557 if length(ActualAppName) = 0 //only set default one time
4558 then ActualAppName := LowerCase(ExtractFileName(GetModuleName));
4559
4560 aFileName := KSInputQuery(ActualAppName, 'URL:', 'http://', 40);
4561 if (length(aFileName) = 0) or (aFileName = 'http://')
4562 then exit;
4563 end;
4564
4565 LoadFile(aFileName, False);
4566end;
4567//------------------------------------------------------------------------------
4568procedure TEmbeddedED.LoadDocument(var pathIn, promptUser: OleVariant);
4569var
4570 aFileName: String;
4571 aPrompt: boolean;
4572begin
4573 // just DHTML Compatibility
4574 //asm int 3 end; //trap
4575 try
4576 if VarType(pathIn) = varOleStr
4577 then aFileName := pathIn
4578 else aFileName := '';
4579
4580 if VarType(promptUser) = varBoolean
4581 then aPrompt := promptUser
4582 else aPrompt := true;
4583
4584 LoadFile(aFileName, aPrompt);
4585 pathIn := aFileName;
4586 except
4587 //just catch any error
4588 end;
4589end;
4590//------------------------------------------------------------------------------
4591procedure TEmbeddedED.SaveDocument(var pathIn, promptUser: OleVariant);
4592var
4593 aFileName: string;
4594 aPrompt: boolean;
4595begin
4596 // just DHTML Compatibility
4597 //asm int 3 end; //trap
4598 try
4599 aFileName := pathIn;
4600 aPrompt := promptUser;
4601 if aPrompt
4602 then begin
4603 if GetSaveFileName(aFileName) <> S_OK
4604 then exit;
4605 end;
4606
4607 if sameText(aFileName, FCurrentDocumentPath)
4608 then SaveFile
4609 else SaveFileAs(aFileName);
4610 pathIn := aFileName;
4611 except
4612 //catch any error
4613 end;
4614end;
4615//------------------------------------------------------------------------------
4616procedure TEmbeddedED.FContextMenuClicked(Sender: TObject);
4617begin
4618 //asm int 3 end; //trap
4619 if assigned(FOnContextMenuAction)
4620 then FOnContextMenuAction(Self, (Sender as TMenuItem).Tag);
4621end;
4622//------------------------------------------------------------------------------
4623procedure TEmbeddedED.SetContextMenu(var menuStrings, menuStates: OleVariant);
4624var
4625 Ps: PSafeArray;
4626 Pw: PWideChar;
4627 aState: OLE_TRISTATE;
4628 I: Integer;
4629 aCaption: string;
4630 NewMenuItem: TMenuItem;
4631begin
4632 // just DHTML Compatibility
4633 //asm int 3 end; //trap
4634
4635 FContextMenu.Items.Clear;
4636
4637 try
4638 if (VarArrayLowBound(menuStrings, 1) < 0) or
4639 (VarArrayLowBound(menuStates, 1) < 0) or
4640 (VarArrayHighBound(menuStrings, 1) <> VarArrayHighBound(menuStates, 1))
4641 then exit;
4642
4643 Ps := TVariantArg(menuStrings).pArray;
4644 for I := VarArrayLowBound(menuStrings, 1) to VarArrayHighBound(menuStrings, 1) do
4645 begin
4646 //add a new menu item to the popup menu
4647 NewMenuItem := TMenuItem.Create(nil);
4648 NewMenuItem.OnClick := FContextMenuClicked;
4649 NewMenuItem.Tag := I;
4650
4651 //get each string from the SafeArray
4652 SafeArrayGetElement(Ps, I, Pw);
4653 aCaption := OleStrToString(Pw);
4654 //blank menu item = separator in Context Menu
4655 if aCaption = '' //we need - in a TPopUpmenu as separator
4656 then NewMenuItem.Caption := '-'
4657 else NewMenuItem.Caption := aCaption;
4658
4659 FContextMenu.Items.Add(NewMenuItem);
4660 end;
4661
4662 Ps := TVariantArg(menuStates).pArray;
4663 for I := VarArrayLowBound(menuStates, 1) to VarArrayHighBound(menuStates, 1) do
4664 begin
4665 //get each string from the SafeArray
4666 SafeArrayGetElement(Ps, I, aState);
4667 case aState of // 0= Unchecked 1=Checked 2=Grayed
4668 0: {Nop};
4669 1: FContextMenu.Items[I].Checked := True;
4670 2: FContextMenu.Items[I].Enabled := false;
4671 end;
4672 end;
4673 except
4674 //just catch any error
4675 end;
4676end;
4677//------------------------------------------------------------------------------
4678procedure TEmbeddedED.SetGridX(const Value: integer);
4679begin
4680 //asm int 3 end; //trap
4681 FGridX := Value;
4682 if assigned(FEditHost)
4683 then TEditHost(FEditHost).FGridX := FGridX;
4684end;
4685//------------------------------------------------------------------------------
4686procedure TEmbeddedED.SetGridY(const Value: integer);
4687begin
4688 //asm int 3 end; //trap
4689 FGridY := Value;
4690 if assigned(FEditHost)
4691 then TEditHost(FEditHost).FGridY := FGridY;
4692end;
4693//------------------------------------------------------------------------------
4694procedure TEmbeddedED.SetSnapEnabled(const Value: Boolean);
4695begin
4696 //asm int 3 end; //trap
4697 FSnapEnabled := Value;
4698 if assigned(FEditHost)
4699 then TEditHost(FEditHost).FSnapEnabled := FSnapEnabled;
4700end;
4701//------------------------------------------------------------------------------
4702function TEmbeddedED.Get_AbsoluteDropMode: Boolean;
4703begin
4704 //asm int 3 end; //trap
4705 result := FAbsoluteDropMode;
4706end;
4707//------------------------------------------------------------------------------
4708function TEmbeddedED.Get_ShowBorders: WordBool;
4709begin
4710 //asm int 3 end; //trap
4711 result := FShowBorders;
4712end;
4713//------------------------------------------------------------------------------
4714procedure TEmbeddedED.Set_AbsoluteDropMode(const Value: Boolean);
4715begin
4716 //asm int 3 end; //trap
4717 FAbsoluteDropMode := value;
4718end;
4719//------------------------------------------------------------------------------
4720function TEmbeddedED.GetAppearance(aType: TUserInterfaceOption): TDHTMLEDITAPPEARANCE;
4721begin
4722 //asm int 3 end; //trap
4723
4724 if aType in FUserInterfaceOptions
4725 then result := DEAPPEARANCE_FLAT
4726 else result := DEAPPEARANCE_3D;
4727end;
4728//------------------------------------------------------------------------------
4729function TEmbeddedED.Get_Appearance: TDHTMLEDITAPPEARANCE;
4730begin
4731 //asm int 3 end; //trap
4732
4733 result := GetAppearance(NoBorder);
4734end;
4735//------------------------------------------------------------------------------
4736procedure TEmbeddedED.Set_Appearance(const Value: TDHTMLEDITAPPEARANCE);
4737begin
4738 //asm int 3 end; //trap
4739
4740 if value <> Get_Appearance
4741 then begin
4742 if value = DEAPPEARANCE_FLAT
4743 then Include(FUserInterfaceOptions, NoBorder)
4744 else Exclude(FUserInterfaceOptions, NoBorder);
4745 end;
4746end;
4747//------------------------------------------------------------------------------
4748function TEmbeddedED.Get_ScrollbarAppearance: TDHTMLEDITAPPEARANCE;
4749begin
4750 //asm int 3 end; //trap
4751
4752 result := GetAppearance(FlatScrollBar);
4753end;
4754//------------------------------------------------------------------------------
4755procedure TEmbeddedED.Set_ScrollbarAppearance(const Value: TDHTMLEDITAPPEARANCE);
4756begin
4757 //asm int 3 end; //trap
4758
4759 if value <> Get_ScrollbarAppearance
4760 then begin
4761 if value = DEAPPEARANCE_FLAT
4762 then Include(FUserInterfaceOptions, FlatScrollBar)
4763 else Exclude(FUserInterfaceOptions, FlatScrollBar);
4764 end;
4765end;
4766//------------------------------------------------------------------------------
4767function TEmbeddedED.Get_Scrollbars: WordBool;
4768begin
4769 //asm int 3 end; //trap
4770 result := not(NoScrollBar in FUserInterfaceOptions);
4771end;
4772//------------------------------------------------------------------------------
4773procedure TEmbeddedED.Set_Scrollbars(const Value: WordBool);
4774begin
4775 //asm int 3 end; //trap
4776
4777 if value <> Get_Scrollbars
4778 then begin
4779 if value
4780 then Exclude(FUserInterfaceOptions, NoScrollBar)
4781 else Include(FUserInterfaceOptions, NoScrollBar);
4782 end;
4783end;
4784//------------------------------------------------------------------------------
4785procedure TEmbeddedED.Set_ShowBorders(const Value: WordBool);
4786begin
4787 //asm int 3 end; //trap
4788
4789 if value <> FShowBorders
4790 then begin
4791 FShowBorders := value;
4792
4793 if not ComponentInDesignMode
4794 then CmdSet_B(IDM_SHOWZEROBORDERATDESIGNTIME, FShowBorders);
4795 end;
4796end;
4797//------------------------------------------------------------------------------
4798function TEmbeddedED.Get_UseDivOnCarriageReturn: WordBool;
4799begin
4800 //asm int 3 end; //trap
4801 result := DivBlockOnReturn in FUserInterfaceOptions;
4802end;
4803//------------------------------------------------------------------------------
4804procedure TEmbeddedED.Set_UseDivOnCarriageReturn(const Value: WordBool);
4805begin
4806 //asm int 3 end; //trap
4807
4808 if value <> Get_UseDivOnCarriageReturn
4809 then begin
4810 if value
4811 then Include(FUserInterfaceOptions, DivBlockOnReturn)
4812 else Exclude(FUserInterfaceOptions, DivBlockOnReturn);
4813 end;
4814end;
4815//------------------------------------------------------------------------------
4816function TEmbeddedED.KSTEst(var pInVar, pOutVar: OleVariant): HResult;
4817 //call edit.CmdGet(KS_TEST, ov);
4818var
4819 sFindThis: string;
4820 //kt FP: MSHTML_TLB.IMarkupPointer; //points to end of searched string - if found
4821 FP: MSHTML_EWB.IMarkupPointer; //points to end of searched string - if found
4822 FMarkupContainer: IMarkupContainer;
4823begin
4824 //asm int 3 end; //trap
4825
4826 {$IFDEF EDLIB}
4827 sFindThis := InputBox('Search', 'Please enter the string to search for...', '');
4828 if length(sFindThis) = 0
4829 then exit;
4830
4831 FMarkupContainer := Doc as IMarkupContainer;
4832
4833 //Search from start of document
4834 OleCheck(FMarkupPointerStart.MoveToContainer(FMarkupContainer, Integer(True)));
4835 //Search to end of document
4836 OleCheck(FMarkupPointerEnd.MoveToContainer(FMarkupContainer, Integer(False)));
4837
4838 if S_OK = EDFindText(Self, FMarkupPointerStart, FMarkupPointerEnd, sFindThis, FP)
4839 then begin
4840 if S_OK = EDInsertText(Self, FP, '--Found It--')
4841 then KSMessageI('Did the insert...')
4842 else KSMessageI('Insert failed...');
4843 end
4844 else KSMessageI('Could not locate ' + sFindThis + '.');
4845 {$ENDIF}
4846end;
4847//------------------------------------------------------------------------------
4848function TEmbeddedED.OnControlInfoChanged: HResult;
4849begin
4850 //asm int 3 end; //trap
4851 Result := E_NOTIMPL;
4852end;
4853//------------------------------------------------------------------------------
4854function TEmbeddedED.LockInPlaceActive(fLock: BOOL): HResult;
4855begin
4856 //asm int 3 end; //trap
4857 Result := E_NOTIMPL;
4858end;
4859//------------------------------------------------------------------------------
4860function TEmbeddedED.GetExtendedControl(out disp: IDispatch): HResult;
4861begin
4862 //asm int 3 end; //trap
4863 Result := E_NOTIMPL;
4864end;
4865//------------------------------------------------------------------------------
4866function TEmbeddedED.TransformCoords(var ptlHimetric: TPoint; var ptfContainer: TPointF; flags: Longint): HResult;
4867begin
4868 //asm int 3 end; //trap
4869 Result := E_NOTIMPL;
4870end;
4871//------------------------------------------------------------------------------
4872function TEmbeddedED.OleControlSite_TranslateAccelerator(msg: PMsg; grfModifiers: Longint): HResult;
4873begin
4874 //asm int 3 end; //trap
4875
4876 { KEYMOD_SHIFT = 0x00000001,
4877 KEYMOD_CONTROL = 0x00000002,
4878 KEYMOD_ALT = 0x00000004
4879
4880 S_OK, The container processed the message.
4881 S_FALSE, The container did not process the message.
4882 This value must also be returned in all other error cases
4883 besides E_NOTIMPL.
4884
4885 E_NOTIMPL, The container does not implement accelerator support. }
4886
4887 { we handle Accelerators in IDOCHOSTUIHANDLER:TranslateAccelerator witch
4888 is called before this function.
4889
4890 After the call to IDOCHOSTUIHANDLER:TranslateAccelerator
4891 IHtmlEditDesigner.TranslateAccelerator is called.
4892
4893 If MSHTML handle the key we don't come here ! }
4894
4895 Result := E_NOTIMPL;
4896end;
4897//------------------------------------------------------------------------------
4898function TEmbeddedED.OnFocus(fGotFocus: BOOL): HResult;
4899begin
4900 //asm int 3 end; //trap
4901
4902 { Each time the WebBrowser gains focus we hook its window and we unhook
4903 the window again when the WebBrowser loses focus.
4904 This makes all messages send to MSHTML flow trough EDMessageHandler before
4905 MSHTML get a chance to handle them }
4906
4907 if fGotFocus
4908 then SubClassMsHTML
4909 else UnSubClassMsHTML;
4910
4911 //ktResult := S_OK;
4912 Result := S_OK or SubFocusHandler(fGotFocus); //kt
4913end;
4914//------------------------------------------------------------------------------
4915function TEmbeddedED.ShowPropertyFrame: HResult;
4916begin
4917 //asm int 3 end; //trap
4918 Result := E_NOTIMPL;
4919end;
4920//------------------------------------------------------------------------------
4921function TEmbeddedED.IsSelElementLocked: boolean;
4922begin
4923 //asm int 3 end; //trap
4924
4925 {$IFDEF EDZINDEX}
4926 result := TZindex(FTZindex).IsSelElementLocked;
4927 {$ELSE}
4928 result := false;
4929 {$ENDIF}
4930end;
4931//------------------------------------------------------------------------------
4932procedure TEmbeddedED.EDOnMouseOver(const pEvtObj: IHTMLEventObj);
4933begin
4934 //asm int 3 end; //trap
4935 {$IFDEF EDTABLE}
4936 if assigned(FTtable) and FEditMode
4937 then TTable(FTtable).TblOnmouseover(pEvtObj);
4938 {$ENDIF}
4939
4940 if Assigned(FOnmouseover)
4941 then FOnmouseover(self);
4942end;
4943//------------------------------------------------------------------------------
4944procedure TEmbeddedED.NotImplemented(S: String);
4945begin
4946 //asm int 3 end; //trap
4947 KSMessageW(S + DblCrLf + 'is not implemented');
4948end;
4949//------------------------------------------------------------------------------
4950function TEmbeddedED.EndUndoBlock(aResult: HResult): HResult;
4951begin
4952 //asm int 3 end; //trap
4953
4954 result := S_OK;
4955
4956 if aResult = S_OK
4957 then EndUndoUnit //no errors in the calling procedure, just close undo block
4958 else begin
4959 //the calling procedure had an error, so we need to clean up after it
4960
4961 {$IFDEF EDUNDO}
4962 if assigned(FTUndo)
4963 then begin
4964 result := TUndo(FTUndo).CleanUpUndoBlock;
4965 exit;
4966 end;
4967 {$ENDIF}
4968
4969
4970 //we are using MSHTMLs UNDO stack
4971
4972 {$IFDEF EDLIB}
4973 result := CleanUpMSHTMLUndoBlock(Self);
4974 {$ELSE}
4975 result := CmdSet(IDM_Undo);
4976 {$ENDIF}
4977 end;
4978end;
4979//------------------------------------------------------------------------------
4980function TEmbeddedED.ClearUndoStack: HResult;
4981begin
4982 //asm int 3 end; //trap
4983
4984 result := S_OK;
4985
4986 if not FEditMode
4987 then exit;
4988
4989 if FLocalUndo
4990 then begin
4991 {$IFDEF EDUNDO}
4992 if FTUndo <> nil
4993 then result := TUndo(FTUndo).ClearStack;
4994 exit;
4995 {$ENDIF}
4996 end;
4997
4998 //we are using MSHTMLs UNDO stack
4999
5000 {$IFDEF EDLIB}
5001 result := ClearMSHTMLStack(Self);
5002 {$ELSE}
5003 result := S_FALSE;
5004 {$ENDIF}
5005end;
5006//------------------------------------------------------------------------------
5007function TEmbeddedED.CaretIsVisible: Boolean;
5008var
5009 Visible: Integer;
5010begin
5011 //asm int 3 end; //trap
5012 FCaret.IsVisible(Visible);
5013 result := Visible <> 0;
5014end;
5015//------------------------------------------------------------------------------
5016procedure TEmbeddedED.Accept(const URL: String; var Accept: Boolean);
5017begin
5018 //asm int 3 end; //trap
5019 Accept := true;
5020end;
5021//------------------------------------------------------------------------------
5022{$IFDEF EDDRAGDROP}
5023//------------------------------------------------------------------------------
5024function TEmbeddedED.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
5025begin
5026 //asm int 3 end; //trap
5027 if FMSHTMLDropTarget <> nil //just re delegate to MSHTML
5028 then result := FMSHTMLDropTarget.DragEnter(dataObj, grfKeyState, pt, dwEffect)
5029 else result := E_UNEXPECTED;
5030end;
5031//------------------------------------------------------------------------------
5032function TEmbeddedED.DragLeave: HResult;
5033begin
5034 //asm int 3 end; //trap
5035 if FMSHTMLDropTarget <> nil //just re delegate to MSHTML
5036 then result := FMSHTMLDropTarget.DragLeave
5037 else result := E_UNEXPECTED;
5038end;
5039//------------------------------------------------------------------------------
5040function TEmbeddedED._DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
5041begin
5042 //asm int 3 end; //trap
5043 if FMSHTMLDropTarget <> nil //just re delegate to MSHTML
5044 then result := FMSHTMLDropTarget.DragOver(grfKeyState, pt, dwEffect)
5045 else result := E_UNEXPECTED;
5046end;
5047//------------------------------------------------------------------------------
5048function TEmbeddedED.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
5049var
5050 ProxyDataObj: TDataObjectProxy;
5051begin
5052 //asm int 3 end; //trap
5053
5054 result := S_OK;
5055
5056 if (not FAbsoluteDropMode) or (FMSHTMLDropTarget = nil)
5057 then begin
5058 result := E_UNEXPECTED;
5059 exit;
5060 end;
5061
5062 if dataObj <> nil
5063 then begin
5064 ProxyDataObj := TDataObjectProxy.Create(dataObj, DOC, FmsHTMLwinHandle, pt);
5065 try
5066 //just re delegate to MSHTML
5067 result := FMSHTMLDropTarget.Drop(ProxyDataObj, grfKeyState, pt, dwEffect);
5068 finally
5069 WaitAsync;
5070 ProxyDataObj.free;
5071 end;
5072 end;
5073
5074end;
5075//------------------------------------------------------------------------------
5076{$ENDIF} //{$IFDEF EDDRAGDROP}
5077//------------------------------------------------------------------------------
5078procedure TEmbeddedED.Set_LocalUndo(const Value: WordBool);
5079begin
5080 //asm int 3 end; //trap
5081
5082 {$IFDEF EDUNDO}
5083 if Value = FLocalUndo
5084 then exit;
5085
5086 FLocalUndo := Value;
5087 if(not ComponentInDesignMode) and DocumentIsAssigned
5088 then SetLocalUndo(Self, FTUndo, Value);
5089 {$ELSE}
5090 if ComponentInDesignMode
5091 then FLocalUndo := false
5092 else begin
5093 if value
5094 then NotImplemented('Set LocalUndo');
5095 end;
5096 {$ENDIF}
5097end;
5098//------------------------------------------------------------------------------
5099function TEmbeddedED._QueryStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: POleCmd; CmdText: POleCmdText): HResult;
5100begin
5101 //asm int 3 end; //trap
5102 result := S_OK;
5103end;
5104//------------------------------------------------------------------------------
5105function TEmbeddedED.Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD; const vaIn: OleVariant; var vaOut: OleVariant): HResult;
5106var
5107 FCancel: Boolean;
5108begin
5109 //asm int 3 end; //trap
5110
5111 if CmdGroup = nil
5112 then begin
5113 Result := OLECMDERR_E_UNKNOWNGROUP;
5114 exit;
5115 end
5116 else Result := OLECMDERR_E_NOTSUPPORTED;
5117
5118
5119 if IsEqualGuid(cmdGroup^, CGID_DocHostCommandHandler)
5120 then begin
5121 case nCmdID of
5122
5123 6041 {F5}, 6042 {ContextMenu}, 2300 {IDM_REFRESH}:
5124 begin
5125 FCancel := False;
5126 If Assigned(FOnRefreshBegin)
5127 then FOnRefreshBegin(Self, nCmdID, FCancel);
5128
5129 if FCancel
5130 then Result := S_OK
5131 else FRefreshing := true;
5132 end;
5133 end;
5134 end;
5135end;
5136{IOleCommandTarget END}
5137//------------------------------------------------------------------------------
5138function TEmbeddedED.GetGenerator: string;
5139begin
5140 //asm int 3 end; //trap
5141
5142 result := FGenerator;
5143end;
5144//------------------------------------------------------------------------------
5145procedure TEmbeddedED.Set_Generator(const Value: String);
5146begin
5147 //asm int 3 end; //trap
5148
5149 if Value = FGenerator
5150 then exit;
5151
5152 {$IFDEF EDLIB}
5153 FGenerator := Value
5154 {$ELSE}
5155 NotImplemented('Set Generator');
5156 {$ENDIF}
5157end;
5158//------------------------------------------------------------------------------
5159function TEmbeddedED.PrintPreview(value: Olevariant): HResult;
5160var
5161 aResult: TPrintSetup;
5162 B: Boolean;
5163 CmdOpt: Cardinal;
5164begin
5165 //asm int 3 end; //trap
5166
5167 {$IFDEF EDPRINT}
5168 if ISEmptyParam(value)
5169 then begin
5170 aResult[0] := '';
5171 aResult[1] := '0';
5172 B := true;
5173 end
5174 else B := VariantArrayToPrintSetup(Value, aResult);
5175
5176 if B and
5177 PrintPreview(aResult)
5178 then result := S_OK
5179 else result := S_FALSE;
5180
5181 {$ELSE}
5182 if value
5183 then result := DoCommand(IDM_PRINTPREVIEW, OLECMDEXECOPT_PROMPTUSER)
5184 else result := DoCommand(IDM_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER);
5185 {$ENDIF}
5186end;
5187//------------------------------------------------------------------------------
5188function TEmbeddedED.PrintEx(value: Olevariant; Showdlg: boolean): HResult;
5189var
5190 aResult: TPrintSetup;
5191begin
5192 //asm int 3 end; //trap
5193 {$IFDEF EDPRINT}
5194 if VariantArrayToPrintSetup(Value, aResult) and
5195 Print(aResult, Showdlg)
5196 then result := S_OK
5197 else result := S_FALSE;
5198 {$ENDIF}
5199end;
5200//------------------------------------------------------------------------------
5201function TEmbeddedED.Print(value: TPrintSetup; Showdlg: boolean = false): Boolean;
5202const
5203 NotPreView: Boolean = False;
5204begin
5205 //asm int 3 end; //trap
5206 {$IFDEF EDPRINT}
5207 result := SetPrintTemplate(value) and
5208 DoPrint(NotPreView, Doc, Showdlg, GetPrintFileName);
5209 {$ENDIF}
5210end;
5211//------------------------------------------------------------------------------
5212function TEmbeddedED.PrintPreview(value: TPrintSetup): Boolean;
5213const
5214 PreView: Boolean = true;
5215 NoShowdlg: Boolean = False;
5216begin
5217 //asm int 3 end; //trap
5218
5219 {$IFDEF EDPRINT}
5220 result := SetPrintTemplate(value) and
5221 DoPrint(PreView, Doc, NoShowdlg, GetPrintFileName);
5222 {$ENDIF}
5223end;
5224//------------------------------------------------------------------------------
5225
5226initialization
5227 OleInitialize(nil);
5228 TheActualAppName := '';
5229
5230
5231finalization
5232 try
5233 OleUninitialize;
5234 except
5235 end;
5236
5237end.
5238
5239
5240
5241
Note: See TracBrowser for help on using the repository browser.