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