[541] | 1 | //*************************************************************
|
---|
| 2 | // TEwbCore *
|
---|
| 3 | // *
|
---|
| 4 | // Freeware Component *
|
---|
| 5 | // For Delphi *
|
---|
| 6 | // by *
|
---|
| 7 | // Per Lindso Larsen *
|
---|
| 8 | // Developing Team: *
|
---|
| 9 | // Eran Bodankin (bsalsa) -(bsalsa@gmail.com) *
|
---|
| 10 | // Serge Voloshenyuk (SergeV@bsalsa.com) *
|
---|
| 11 | // Thomas Stutz (smot777@yahoo.com *
|
---|
| 12 | // *
|
---|
| 13 | // Documentation and updated versions: *
|
---|
| 14 | // *
|
---|
| 15 | // http://www.bsalsa.com *
|
---|
| 16 | //*************************************************************
|
---|
| 17 | {LICENSE:
|
---|
| 18 | THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
|
---|
| 19 | EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
|
---|
| 20 | WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
|
---|
| 21 | YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
|
---|
| 22 | AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
|
---|
| 23 | AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
|
---|
| 24 | OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
|
---|
| 25 | OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
|
---|
| 26 | INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
|
---|
| 27 | OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
|
---|
| 28 | AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY
|
---|
| 29 | DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.
|
---|
| 30 |
|
---|
| 31 | You may use/change/modify the component under 4 conditions:
|
---|
| 32 | 1. In your web site, add a link to "http://www.bsalsa.com"
|
---|
| 33 | 2. In your application, add credits to "Embedded Web Browser"
|
---|
| 34 | 3. Mail me (bsalsa@gmail.com) any code change in the unit for the benefit
|
---|
| 35 | of the other users.
|
---|
| 36 | 4. Please, consider donation in our web site!
|
---|
| 37 | {*******************************************************************************}
|
---|
| 38 |
|
---|
| 39 |
|
---|
| 40 | unit EwbCore;
|
---|
| 41 |
|
---|
| 42 | interface
|
---|
| 43 |
|
---|
| 44 | {$I EWB.inc}
|
---|
| 45 |
|
---|
| 46 | uses
|
---|
| 47 | {$IFDEF DELPHI6_UP}Variants, {$ENDIF}
|
---|
| 48 | Dialogs, Windows, Messages, Classes, MSHTML_EWB, EWBAcc, Controls, Forms,
|
---|
| 49 | ExtCtrls, ActiveX, ShlObj, SHDocVw_EWB, UrlMon, IEConst;
|
---|
| 50 |
|
---|
| 51 | type
|
---|
| 52 | TCustomEmbeddedWB = class;
|
---|
| 53 |
|
---|
| 54 | TOleCmdArray = array of TOleCmd;
|
---|
| 55 | TDragDropHandlingType = (
|
---|
| 56 | ddtMS, // Microsoft implementation
|
---|
| 57 | ddtMy, // TCustomEmbeddedWB event handlers
|
---|
| 58 | ddtCustom, // granted by user in OnGetDropTarget event handler
|
---|
| 59 | ddtNo // No drag and drop
|
---|
| 60 | );
|
---|
| 61 | TDocDesignMode = (ddmOn, ddmOff, ddmInherit, ddmUnknown);
|
---|
| 62 |
|
---|
| 63 | TIEPopupMenu = (
|
---|
| 64 | rcmDefault,
|
---|
| 65 | rcmImage,
|
---|
| 66 | rcmControl,
|
---|
| 67 | rcmTable,
|
---|
| 68 | rcmSelText,
|
---|
| 69 | rcmAnchor,
|
---|
| 70 | rcmUnKnown,
|
---|
| 71 | rcmImageArt,
|
---|
| 72 | rcmImgDynSrc,
|
---|
| 73 | rcmDebug,
|
---|
| 74 | rcmAll
|
---|
| 75 | );
|
---|
| 76 | TIEPopupMenus = set of TIEPopupMenu;
|
---|
| 77 |
|
---|
| 78 | TIEPopupMenuItem = (
|
---|
| 79 | rcsBack,
|
---|
| 80 | rcsForward,
|
---|
| 81 | rcsSavePageBkg,
|
---|
| 82 | rcsSetAsBkg,
|
---|
| 83 | rcsCopyBkg,
|
---|
| 84 | rcsSetAsDeskT,
|
---|
| 85 | rcsSelectAll,
|
---|
| 86 | rcsPaste,
|
---|
| 87 | rcsCreateSC,
|
---|
| 88 | rcsAddToFav,
|
---|
| 89 | rcsEncoding,
|
---|
| 90 | rcsRefresh,
|
---|
| 91 | rcsViewSource,
|
---|
| 92 | rcsProperties,
|
---|
| 93 | rcsPrint,
|
---|
| 94 | rcsOpenNWindow,
|
---|
| 95 | rcsOpenLink
|
---|
| 96 | );
|
---|
| 97 | TIEPopupMenuItems = set of TIEPopupMenuItem;
|
---|
| 98 |
|
---|
| 99 | {============================================================================}
|
---|
| 100 | { Controlling Download and Execution }
|
---|
| 101 | { http://msdn.microsoft.com/en-us/library/aa770041.aspx }
|
---|
| 102 | { TDownloadControlOption = (
|
---|
| 103 | DLCTL_DLIMAGES, DLCTL_VIDEOS, DLCTL_BGSOUNDS,
|
---|
| 104 | DLCTL_NO_SCRIPTS, DLCTL_NO_JAVA,
|
---|
| 105 | DLCTL_NO_RUNACTIVEXCTLS, DLCTL_NO_DLACTIVEXCTLS,
|
---|
| 106 | DLCTL_DOWNLOADONLY,
|
---|
| 107 | DLCTL_NO_FRAMEDOWNLOAD,
|
---|
| 108 | DLCTL_RESYNCHRONIZE,
|
---|
| 109 | DLCTL_PRAGMA_NO_CACHE,
|
---|
| 110 | DLCTL_NO_BEHAVIORS, DLCTL_NO_METACHARSET,
|
---|
| 111 | DLCTL_URL_ENCODING_DISABLE_UTF8, DLCTL_URL_ENCODING_ENABLE_UTF8,
|
---|
| 112 | DLCTL_FORCEOFFLINE, DLCTL_NO_CLIENTPULL,
|
---|
| 113 | DLCTL_SILENT, DLCTL_OFFLINE);
|
---|
| 114 | }
|
---|
| 115 | TDownloadControlOption = (
|
---|
| 116 | DownloadImages, DownloadVideos, DownloadBGSounds, DontExecuteScripts,
|
---|
| 117 | DontExecuteJava, DontExecuteActiveX, DontDownloadActiveX,
|
---|
| 118 | DownloadButDontDisplay, DontDownloadFrame, CheckPageResynchronize,
|
---|
| 119 | DownloadAndIgnoreCache, DontDownloadBehaviors, SuppressedMetaCharset,
|
---|
| 120 | DisableUrlIfEncodingUTF8, EnableUrlIfEncodingUTF8,
|
---|
| 121 | ForceOfflineMode, DontPerformClientPull, DownloadInSilentMode, WorkOffline);
|
---|
| 122 | TDownloadControlOptions = set of TDownloadControlOption;
|
---|
| 123 |
|
---|
| 124 | { Doc Host Flags:
|
---|
| 125 | http://msdn.microsoft.com/en-us/library/aa753277.aspx }
|
---|
| 126 | { TUserInterfaceOption = (DIALOG, DISABLE_HELP_MENU, NO3DBORDER,
|
---|
| 127 | SCROLL_NO, DISABLE_SCRIPT_INACTIVE, OPENNEWWIN, DISABLE_OFFSCREEN,
|
---|
| 128 | FLAT_SCROLLBAR, DIV_BLOCKDEFAULT, ACTIVATE_CLIENTHIT_ONLY,
|
---|
| 129 | OVERRIDEBEHAVIORFACTORY,
|
---|
| 130 | CODEPAGELINKEDFONTS, URL_ENCODING_DISABLE_UTF8,
|
---|
| 131 | URL_ENCODING_ENABLE_UTF8,
|
---|
| 132 | ENABLE_FORMS_AUTOCOMPLETE, ENABLE_INPLACE_NAVIGATION,
|
---|
| 133 | IME_ENABLE_RECONVERSION,
|
---|
| 134 | THEME, NOTHEME, NOPICS, NO3DOUTERBORDER, DISABLE_EDIT_NS_FIXUP,
|
---|
| 135 | LOCAL_MACHINE_ACCESS_CHECK, DISABLE_UNTRUSTEDPROTOCOL,
|
---|
| 136 | HOST_NAVIGATES, ENABLE_REDIRECT_NOTIFICATION, USE_WINDOWLESS_SELECTCONTROL,
|
---|
| 137 | USE_WINDOWED_SELECTCONTROL, ENABLE_ACTIVEX_INACTIVATE_MODE);
|
---|
| 138 | }
|
---|
| 139 | TUserInterfaceOption = (DisableTextSelect, DisableHelpMenu, DontUse3DBorders,
|
---|
| 140 | DontUseScrollBars, PostponeScriptUntilActive, ForceOpenNewWindow,
|
---|
| 141 | Reserved_OFFSCREEN,
|
---|
| 142 | ForceFlatScrollBars, InsertDivTagOnEditMode, ActivateUIOnlyOnDocClick,
|
---|
| 143 | ConsultBeforeRetrievingBehavior,
|
---|
| 144 | CheckFontSupportsCodePage, DisableSubmitUrlInUTF8,
|
---|
| 145 | EnableSubmitUrlInUTF8,
|
---|
| 146 | EnablesFormsAutoComplete, ForceSameWindowNavigation,
|
---|
| 147 | EmableImeLocalLanguages,
|
---|
| 148 | EnableThemes, DisableThemes, DisablePicsRatings, DisableFrameSetBorder,
|
---|
| 149 | DisablesAutoNameSpaceCorrection,
|
---|
| 150 | DisableLocalFileAccess, DisableUntrustedProtocol,
|
---|
| 151 | CheckNavigationDelegatedToHost, EnableRedirectNotification, EnableDomWindlessControls,
|
---|
| 152 | EnableWindowedControls, ForceUserActivationOnActiveXJava);
|
---|
| 153 | TUserInterfaceOptions = set of TUserInterfaceOption;
|
---|
| 154 |
|
---|
| 155 | {events}
|
---|
| 156 | TMenuPreprocess = procedure(Sender: TObject; ID: DWORD; Menu: HMENU; const Context: IDispatch) of object;
|
---|
| 157 |
|
---|
| 158 | TEWBNotifyEvent = procedure(Sender: TObject; var Rezult: HRESULT) of object;
|
---|
| 159 | TBoolQueryEvent = procedure(Sender: TObject; var Value: BOOL) of object;
|
---|
| 160 | TMaskedCtrlCharEvent = procedure(Sender: TCustomEmbeddedWB; MaskedChar: Char) of object;
|
---|
| 161 | TOMWindowMoveEvent = procedure(Sender: TCustomEmbeddedWB; cx, cy: Integer) of object;
|
---|
| 162 |
|
---|
| 163 | {IDocHostShowUI Interface}
|
---|
| 164 | TShowHelpEvent = function(Sender: TObject; HWND: THandle; pszHelpFile: POleStr; uCommand: Integer;
|
---|
| 165 | dwData: Longint; ptMouse: TPoint;
|
---|
| 166 | var pDispatchObjectHit: IDispatch): HRESULT of object;
|
---|
| 167 | TShowMessageEvent = function(Sender: TObject; HWND: THandle;
|
---|
| 168 | lpstrText: POleStr; lpstrCaption: POleStr; dwType: Longint; lpstrHelpFile: POleStr;
|
---|
| 169 | dwHelpContext: Longint; var plResult: LRESULT): HRESULT of object;
|
---|
| 170 | {IDocHostUIHandler Interface}
|
---|
| 171 | TEnableModelessEvent = procedure(Sender: TCustomEmbeddedWB; const fEnable: BOOL) of object;
|
---|
| 172 | TFilterDataObjectEvent = procedure(Sender: TCustomEmbeddedWB; const pDO: IDataObject;
|
---|
| 173 | var ppDORet: IDataObject) of object;
|
---|
| 174 | TGetDropTargetEvent = procedure(Sender: TCustomEmbeddedWB; var DropTarget: IDropTarget) of object;
|
---|
| 175 | TGetExternalEvent = procedure(Sender: TCustomEmbeddedWB; var ppDispatch: IDispatch) of object;
|
---|
| 176 | TGetHostInfoEvent = procedure(Sender: TCustomEmbeddedWB; var pInfo: TDOCHOSTUIINFO) of object;
|
---|
| 177 | TGetOptionKeyPathEvent = procedure(Sender: TCustomEmbeddedWB; var pchKey: POleStr) of object;
|
---|
| 178 | TOnActivateEvent = procedure(Sender: TCustomEmbeddedWB; const fActivate: BOOL) of object;
|
---|
| 179 | TResizeBorderEvent = procedure(Sender: TCustomEmbeddedWB; const prcBorder: PRect;
|
---|
| 180 | const pUIWindow: IOleInPlaceUIWindow;
|
---|
| 181 | const fRameWindow: BOOL) of object;
|
---|
| 182 | TShowContextMenuEvent = procedure(Sender: TCustomEmbeddedWB; const dwID: DWORD; const ppt: PPOINT;
|
---|
| 183 | const CommandTarget: IUnknown; const Context: IDispatch; var Result: HRESULT) of object;
|
---|
| 184 | TShowUIEvent = procedure(Sender: TCustomEmbeddedWB; const dwID: DWORD; const
|
---|
| 185 | pActiveObject: IOleInPlaceActiveObject;
|
---|
| 186 | const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
|
---|
| 187 | const pDoc: IOleInPlaceUIWindow; var Rezult: HRESULT) of object;
|
---|
| 188 | TTranslateAcceleratorEvent = procedure(Sender: TCustomEmbeddedWB; const lpMsg: PMSG;
|
---|
| 189 | const pguidCmdGroup: PGUID;
|
---|
| 190 | const nCmdID: DWORD; var Done: Boolean) of object;
|
---|
| 191 | TTranslateUrlEvent = procedure(Sender: TCustomEmbeddedWB; const pchURLIn: POleStr;
|
---|
| 192 | var ppchURLOut: WideString) of object;
|
---|
| 193 |
|
---|
| 194 | {$IFDEF USE_IOLECOMMANDTARGET}
|
---|
| 195 | TRefreshEvent = procedure(Sender: TCustomEmbeddedWB; CmdID: Integer; var Cancel: Boolean) of object;
|
---|
| 196 | {$ENDIF}
|
---|
| 197 | {INewWindowManager Interface}
|
---|
| 198 | TEvaluateNewWindowEvent = procedure(Sender: TCustomEmbeddedWB; pszUrl, pszName,
|
---|
| 199 | pszUrlContext, pszFeatures: LPCWSTR;
|
---|
| 200 | fReplace: BOOL; dwFlags, dwUserActionTime: DWORD; var Rezult: HRESULT) of object;
|
---|
| 201 | {IDownloadManager Interface}
|
---|
| 202 | TDownloadEvent = procedure(Sender: TCustomEmbeddedWB; pmk: IMoniker; pbc: IBindCtx;
|
---|
| 203 | dwBindVerb: DWORD;
|
---|
| 204 | grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders: PWideChar;
|
---|
| 205 | pszRedir: PWidechar; uiCP: UINT; var Rezult: HRESULT) of object;
|
---|
| 206 | {IAuthenticate Interface}
|
---|
| 207 | TAuthenticateEvent = procedure(Sender: TCustomEmbeddedWB; var hwnd: HWnd;
|
---|
| 208 | var szUserName, szPassWord: WideString; var Rezult: HRESULT) of object;
|
---|
| 209 | {IZoomEvents Interface}
|
---|
| 210 | TZoomPercentChangedEvent = function(Sender: TCustomEmbeddedWB; const ulZoomPercent: uLong): HRESULT of object;
|
---|
| 211 | {Script Error handling}
|
---|
| 212 | TScriptErrorAction = (eaContinue, eaCancel, eaAskUser);
|
---|
| 213 | TScriptErrorEvent = procedure(Sender: TObject; ErrorLine, ErrorCharacter, ErrorCode, ErrorMessage, ErrorUrl: string;
|
---|
| 214 | var ScriptErrorAction: TScriptErrorAction) of object;
|
---|
| 215 |
|
---|
| 216 | {User Agent Mode Event}
|
---|
| 217 | TSetUserAgentEvent = function(var UserAgent: string): HRESULT of object;
|
---|
| 218 |
|
---|
| 219 | { TCustomEmbeddedWB }
|
---|
| 220 | TCustomEmbeddedWB = class(TEWB
|
---|
| 221 | , IDispatch // http://msdn.microsoft.com/en-us/library/ms221608.aspx
|
---|
| 222 | , IDocHostShowUI // http://msdn.microsoft.com/en-us/library/aa753269.aspx
|
---|
| 223 | , IDocHostUIHandler // http://msdn.microsoft.com/en-us/library/aa753260(VS.85).aspx
|
---|
| 224 | , IDocHostUIHandler2 // http://msdn.microsoft.com/en-us/library/aa753275(VS.85).aspx
|
---|
| 225 | , IDropTarget // http://msdn.microsoft.com/en-us/library/ms679679.aspx
|
---|
| 226 | {$IFDEF USE_IOLECOMMANDTARGET}
|
---|
| 227 | , IOleCommandTarget // http://msdn.microsoft.com/en-us/library/ms683797.aspx
|
---|
| 228 | {$ENDIF}
|
---|
| 229 | , IServiceProvider // http://msdn.microsoft.com/en-us/library/cc678965(VS.85).aspx
|
---|
| 230 | , INewWindowManager // http://msdn.microsoft.com/en-us/library/bb775418(VS.85).aspx
|
---|
| 231 | , IProtectFocus // http://msdn2.microsoft.com/en-us/library/aa361771.aspx
|
---|
| 232 | , IDownloadManager // http://msdn.microsoft.com/en-us/library/aa753613(VS.85).aspx
|
---|
| 233 | , IHTMLOMWindowServices //http://msdn.microsoft.com/library/default.asp?url=/workshop/browser/hosting/reference/ifaces/IHTMLOMWindowServices/IHTMLOMWindowServices.asp
|
---|
| 234 | , IHostBehaviorInit // http://msdn.microsoft.com/en-us/library/aa753687(VS.85).aspx
|
---|
| 235 | , IZoomEvents // http://msdn.microsoft.com/en-us/library/aa770056(VS.85).aspx
|
---|
| 236 | , IAuthenticate // http://msdn.microsoft.com/en-us/library/ms835407.aspx
|
---|
| 237 | )
|
---|
| 238 |
|
---|
| 239 | private
|
---|
| 240 | FOnZoomPercentChanged: TZoomPercentChangedEvent;
|
---|
| 241 | FOnGetIDsOfNames: TGetIDsOfNamesEvent;
|
---|
| 242 | FOnGetTypeInfo: TGetTypeInfoEvent;
|
---|
| 243 | FOnGetTypeInfoCount: TGetTypeInfoCountEvent;
|
---|
| 244 | FOnInvoke: TInvokeEvent;
|
---|
| 245 | FDownloadControlOptions: TDownloadControlOptions;
|
---|
| 246 | FOnShowMessage: TShowMessageEvent;
|
---|
| 247 | FOnShowHelp: TShowHelpEvent;
|
---|
| 248 | FHelpFile: string;
|
---|
| 249 | fOptionKeyPath: string;
|
---|
| 250 | fOverOptionKeyPath: Boolean;
|
---|
| 251 | FOnFilterDataObject: TFilterDataObjectEvent;
|
---|
| 252 | FOnGetExternal: TGetExternalEvent;
|
---|
| 253 | FOnGetHostInfo: TGetHostInfoEvent;
|
---|
| 254 | FUserInterfaceOptions: TUserInterfaceOptions;
|
---|
| 255 | FOnEnableModeless: TEnableModelessEvent;
|
---|
| 256 | {$IFDEF GETKEYPATH_HANDLERS}
|
---|
| 257 | FOnGetOptionKeyPath: TGetOptionKeyPathEvent;
|
---|
| 258 | FOnGetOverrideKeyPath: TGetOptionKeyPathEvent;
|
---|
| 259 | {$ENDIF}
|
---|
| 260 | FOnGetDropTarget: TGetDropTargetEvent;
|
---|
| 261 | FOnHideUI: TEWBNotifyEvent;
|
---|
| 262 | FOnOnDocWindowActivate: TOnActivateEvent;
|
---|
| 263 | FOnOnFrameWindowActivate: TOnActivateEvent;
|
---|
| 264 | FOnResizeBorder: TResizeBorderEvent;
|
---|
| 265 | FOnShowContextmenu: TShowContextMenuEvent;
|
---|
| 266 | FOnShowUI: TShowUIEvent;
|
---|
| 267 | FOnTranslateAccelerator: TTranslateAcceleratorEvent;
|
---|
| 268 | FOnTranslateUrL: TTranslateUrlEvent;
|
---|
| 269 | FOnUpdateUI: TEWBNotifyEvent;
|
---|
| 270 | FOnDragLeaveEvent: TNotifyEvent;
|
---|
| 271 | FOnDragEnterEvent: TOnDragEnterEvent;
|
---|
| 272 | FOnDragOverEvent: TOnDragOverEvent;
|
---|
| 273 | FOnDropEvent: TOnDropEvent;
|
---|
| 274 | FOnScriptError: TScriptErrorEvent;
|
---|
| 275 | FScriptErrorAction: TScriptErrorAction;
|
---|
| 276 | {$IFDEF USE_IOLECOMMANDTARGET}
|
---|
| 277 | FOnUnload: TNotifyEvent;
|
---|
| 278 | FOnRefresh: TRefreshEvent;
|
---|
| 279 | FOnCommandExec: TComTargetExecEvent;
|
---|
| 280 | {$ENDIF}
|
---|
| 281 | FOnQueryService: TQueryServiceEvent;
|
---|
| 282 | FOnEvaluateNewWindow: TEvaluateNewWindowEvent;
|
---|
| 283 | FCanGrabFocus: Boolean;
|
---|
| 284 | FOnAllowFocusChange: TBoolQueryEvent;
|
---|
| 285 | FOnDownload: TDownloadEvent;
|
---|
| 286 | FDropHandlingType: TDragDropHandlingType;
|
---|
| 287 | FZoomPercent: Integer;
|
---|
| 288 | FDesignMode: Boolean;
|
---|
| 289 | FDisabledPopupMenus: TIEPopupMenus;
|
---|
| 290 | FOnFilterPopupMenu: TMenuPreprocess;
|
---|
| 291 | FOnMaskedCtrlChar: TMaskedCtrlCharEvent;
|
---|
| 292 | FDisableCtrlShortcuts: string;
|
---|
| 293 | FOnResize: TOMWindowMoveEvent;
|
---|
| 294 | FOnMoveBy: TOMWindowMoveEvent;
|
---|
| 295 | FOnMove: TOMWindowMoveEvent;
|
---|
| 296 | FOnResizeBy: TOMWindowMoveEvent;
|
---|
| 297 | FFloatingHosting: Boolean;
|
---|
| 298 | FOnPopulateNSTable: TNotifyEvent;
|
---|
| 299 | FOnAuthenticate: TAuthenticateEvent;
|
---|
| 300 | {$IFDEF RESEARCH_MODE}
|
---|
| 301 | FOnQueryInterface: OnQueryInterfaceEvent;
|
---|
| 302 | {$ENDIF}
|
---|
| 303 | procedure SetDownloadOptions(const Value: TDownloadControlOptions);
|
---|
| 304 | procedure SetUserInterfaceOptions(const Value: TUserInterfaceOptions);
|
---|
| 305 | function GetDoc2: IHtmlDocument2;
|
---|
| 306 | function GetDoc3: IHtmlDocument3;
|
---|
| 307 | function GetDoc4: IHtmlDocument4;
|
---|
| 308 | function GetDoc5: IHtmlDocument5;
|
---|
| 309 | function GetElemByID(const ID: WideString): IHTMLElement;
|
---|
| 310 | function GetZoom: Integer;
|
---|
| 311 | procedure SetZoom(const Value: Integer);
|
---|
| 312 | procedure setOpticalZoom(const Value: Integer);
|
---|
| 313 | function _getCookie: WideString;
|
---|
| 314 | function GetCharSet: WideString;
|
---|
| 315 | procedure SetCharSet(const Value: WideString);
|
---|
| 316 | procedure SetDropHandlingType(const Value: TDragDropHandlingType);
|
---|
| 317 | procedure SetDesignMode(const Value: Boolean);
|
---|
| 318 | function GetDocDesignMode: TDocDesignMode;
|
---|
| 319 | procedure SetDocDesignMode(const Value: TDocDesignMode);
|
---|
| 320 | function GetBody: IHTMLElement;
|
---|
| 321 |
|
---|
| 322 | protected
|
---|
| 323 | CurrentHandle: HWND; //jls
|
---|
| 324 | procedure CreateWnd; override; //jls
|
---|
| 325 | procedure DestroyWnd; override; //jls
|
---|
| 326 | protected
|
---|
| 327 | {$IFDEF RESEARCH_MODE}
|
---|
| 328 | { IInterface }
|
---|
| 329 | function QueryInterface(const IID: TGUID; out Obj): HRESULT; override; stdcall;
|
---|
| 330 | {$ENDIF}
|
---|
| 331 | {IDispatch Interface}
|
---|
| 332 | function GetIDsOfNames(const IID: TGUID; Names: Pointer;
|
---|
| 333 | NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
|
---|
| 334 | function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT;
|
---|
| 335 | stdcall;
|
---|
| 336 | function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
|
---|
| 337 | function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
|
---|
| 338 | Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT;
|
---|
| 339 | stdcall;
|
---|
| 340 | {IDocHostShowUI Interface }
|
---|
| 341 | function ShowHelp(HWND: THandle; pszHelpFile: POleStr; uCommand: Integer;
|
---|
| 342 | dwData: Longint; ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HRESULT; stdcall;
|
---|
| 343 | function ShowMessage(HWND: THandle; lpstrText: POleStr; lpstrCaption: POleStr;
|
---|
| 344 | dwType: Longint; lpstrHelpFile: POleStr; dwHelpContext: Longint;
|
---|
| 345 | var plResult: LRESULT): HRESULT; stdcall;
|
---|
| 346 | {IDocHostUIHandler Interface}
|
---|
| 347 | function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
|
---|
| 348 | function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
|
---|
| 349 | function GetDropTarget(const pDropTarget: IDropTarget;
|
---|
| 350 | out ppDropTarget: IDropTarget): HRESULT; stdcall;
|
---|
| 351 | function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
|
---|
| 352 | function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
|
---|
| 353 | function GetOptionKeyPath(out pchKey: POleStr; const dw: DWORD): HRESULT; stdcall;
|
---|
| 354 | function HideUI: HRESULT; stdcall;
|
---|
| 355 | function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
|
---|
| 356 | function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
|
---|
| 357 | function ResizeBorder(const prcBorder: PRECT; const pUIWindow:
|
---|
| 358 | IOleInPlaceUIWindow;
|
---|
| 359 | const FrameWindow: BOOL): HRESULT; stdcall;
|
---|
| 360 | function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
|
---|
| 361 | const CommandTarget: IUnknown; const Context: IDispatch): HRESULT; stdcall;
|
---|
| 362 | function ShowUI(const dwID: DWORD; const pActiveObject:
|
---|
| 363 | IOleInPlaceActiveObject;
|
---|
| 364 | const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
|
---|
| 365 | const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
|
---|
| 366 | function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
|
---|
| 367 | const nCmdID: DWORD): HRESULT; stdcall;
|
---|
| 368 | function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POleStr;
|
---|
| 369 | out ppchURLOut: POleStr): HRESULT; stdcall;
|
---|
| 370 | function UpdateUI: HRESULT; stdcall;
|
---|
| 371 | {IDocHostUIHandler2 Interface}
|
---|
| 372 | function GetOverrideKeyPath(out pchKey: POleStr; dw: DWORD): HRESULT; stdcall;
|
---|
| 373 | {IDropTarget Interface}
|
---|
| 374 | function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
|
---|
| 375 | pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
|
---|
| 376 | function IDropTarget.DragOver = DropTargetDragOver;
|
---|
| 377 | function DropTargetDragOver(grfKeyState: Longint; pt: TPoint;
|
---|
| 378 | var dwEffect: Longint): HRESULT; stdcall;
|
---|
| 379 | function DragLeave: HRESULT; stdcall;
|
---|
| 380 | function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
|
---|
| 381 | var dwEffect: Longint): HRESULT; stdcall;
|
---|
| 382 | {$IFDEF USE_IOLECOMMANDTARGET}
|
---|
| 383 | {IOleCommandTarget interface}
|
---|
| 384 | function IOleCommandTarget.QueryStatus = CommandTarget_QueryStatus;
|
---|
| 385 | function CommandTarget_QueryStatus(CmdGroup: PGUID; cCmds: Cardinal;
|
---|
| 386 | prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; stdcall;
|
---|
| 387 | function IOleCommandTarget.Exec = CommandTarget_Exec;
|
---|
| 388 | function CommandTarget_Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
|
---|
| 389 | const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; stdcall;
|
---|
| 390 | {$ENDIF}
|
---|
| 391 | {IServiceProvider Interface}
|
---|
| 392 | function QueryService(const rsid, iid: TGUID; out Obj): HRESULT; stdcall;
|
---|
| 393 | {INewWindowManager Interface}
|
---|
| 394 | function EvaluateNewWindow(pszUrl, pszName, pszUrlContext, pszFeatures: LPCWSTR;
|
---|
| 395 | fReplace: BOOL; dwFlags, dwUserActionTime: DWORD): HRESULT; stdcall;
|
---|
| 396 | {IProtectFocus IE7 interface}
|
---|
| 397 | function AllowFocusChange(out pfAllow: BOOL): HRESULT; stdcall;
|
---|
| 398 | {IDownloadManager Interface}
|
---|
| 399 | function Download(
|
---|
| 400 | pmk: IMoniker; // Identifies the object to be downloaded
|
---|
| 401 | pbc: IBindCtx; // Stores information used by the moniker to bind
|
---|
| 402 | dwBindVerb: DWORD; // The action to be performed during the bind
|
---|
| 403 | grfBINDF: DWORD; // Determines the use of URL encoding during the bind
|
---|
| 404 | pBindInfo: PBindInfo; // Used to implement IBindStatusCallback::GetBindInfo
|
---|
| 405 | pszHeaders: PWidechar; // Additional headers to use with IHttpNegotiate
|
---|
| 406 | pszRedir: PWidechar; // The URL that the moniker is redirected to
|
---|
| 407 | uiCP: UINT // The code page of the object's display name
|
---|
| 408 | ): HRESULT; stdcall;
|
---|
| 409 | {IHostBehaviorInit}
|
---|
| 410 | function PopulateNamespaceTable: HRESULT; stdcall;
|
---|
| 411 | {IHTMLOMWindowServices Interface}
|
---|
| 412 | function ResizeBy(const x, y: Integer): HRESULT; stdcall;
|
---|
| 413 | function ResizeTo(const x, y: Integer): HRESULT; stdcall;
|
---|
| 414 | function MoveBy(const x, y: Integer): HRESULT; stdcall;
|
---|
| 415 | function MoveTo(const x, y: Integer): HRESULT; stdcall;
|
---|
| 416 | {IZoomEvents interface}
|
---|
| 417 | function OnZoomPercentChanged(const ulZoomPercent: uLong): HRESULT; stdcall;
|
---|
| 418 | {IAuthenticate}
|
---|
| 419 | function Authenticate(var hwnd: HWnd; var szUserName, szPassWord: LPWSTR):
|
---|
| 420 | HRESULT; stdcall;
|
---|
| 421 | protected
|
---|
| 422 | FDownloadOptionValue: Longint;
|
---|
| 423 | FUserInterfaceValue: Cardinal;
|
---|
| 424 | FOnSetUserAgent: TSetUserAgentEvent;
|
---|
| 425 | FOnPreRefresh: TNotifyEvent;
|
---|
| 426 | FOnHookChildWindow : TNotifyEvent;
|
---|
| 427 | procedure UpdateDownloadControlValues;
|
---|
| 428 | procedure UpdateUserInterfaceValues;
|
---|
| 429 | function CopyOptionKeyPath(Overrided: Boolean): PWideChar;
|
---|
| 430 | function DoFilterMsg(const lpMsg: PMSG): Boolean; virtual;
|
---|
| 431 | function ScriptErrorHandler(const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; virtual;
|
---|
| 432 | function DoQueryService(const rsid, iid: TGUID; var Obj): Boolean; virtual;
|
---|
| 433 | function FilterPopupMenu: Boolean; virtual;
|
---|
| 434 | procedure DoFilterPopupMenu(Sender: TObject; ID: DWORD; Menu: HMENU; const Context:
|
---|
| 435 | IDispatch); virtual;
|
---|
| 436 | procedure MoveParentForm(x, y: Integer; Delta: Boolean);
|
---|
| 437 | procedure ResizeParentForm(w, h: Integer; Delta: Boolean);
|
---|
| 438 | public
|
---|
| 439 | class function dwEffectToStr(Command: Int64): string;
|
---|
| 440 | class procedure DropEffect(grfKeyState: Longint; var dwEffect: longint);
|
---|
| 441 | constructor Create(AOwner: TComponent); override;
|
---|
| 442 | destructor Destroy; override;
|
---|
| 443 | function InvokeCommand(CmdGroup: PGUID; Cmd, nCmdexecopt: DWORD;
|
---|
| 444 | var vaIn, vaOut: OleVariant): HRESULT; overload;
|
---|
| 445 | function InvokeCommand(CmdGroup: PGUID; Cmd: DWORD): HRESULT; overload;
|
---|
| 446 | function QueryCommandStatus(CmdGroup: PGUID; cCmds: Cardinal;
|
---|
| 447 | prgCmds: POleCmd; CmdText: POleCmdText): HRESULT;
|
---|
| 448 | function QueryCMDEnabled(CmdGroup: PGUID; cmdID: Cardinal): Boolean;
|
---|
| 449 | function QueryCMDLatched(CmdGroup: PGUID; cmdID: Cardinal): Boolean;
|
---|
| 450 | function QueryCMDStatus(CmdGroup: PGUID; cmdID: Cardinal): OLECMDF;
|
---|
| 451 | function QueryCMDArrayStatus(CmdGroup: PGUID; cmds: TOleCmdArray): Boolean;
|
---|
| 452 |
|
---|
| 453 | procedure Client2HostWin(var CX, CY: Integer);
|
---|
| 454 | // just call it in OnClientToHostWindow handler
|
---|
| 455 |
|
---|
| 456 | function GetIEWin(const ClassName: string): HWND;
|
---|
| 457 | procedure SetFocusToDoc;
|
---|
| 458 | procedure SetFocusToBody;
|
---|
| 459 | procedure SetFocusToParent;
|
---|
| 460 |
|
---|
| 461 | function ZoomRangeHigh: Integer;
|
---|
| 462 | function ZoomRangeLow: Integer;
|
---|
| 463 | property Zoom: Integer read getZoom write setZoom;
|
---|
| 464 | property ZoomPercent: Integer read FZoomPercent write setOpticalZoom default 100;
|
---|
| 465 |
|
---|
| 466 | property Cookie: WideString read _getCookie;
|
---|
| 467 | property DesignMode: Boolean read FDesignMode write SetDesignMode;
|
---|
| 468 | {html functions}
|
---|
| 469 | property Doc2: IHtmlDocument2 read GetDoc2;
|
---|
| 470 | property Doc3: IHtmlDocument3 read GetDoc3;
|
---|
| 471 | property Doc4: IHtmlDocument4 read GetDoc4;
|
---|
| 472 | property Doc5: IHtmlDocument5 read GetDoc5;
|
---|
| 473 |
|
---|
| 474 | property Body: IHTMLElement read getBody;
|
---|
| 475 | property DocDesignMode: TDocDesignMode read getDocDesignMode write
|
---|
| 476 | setDocDesignMode;
|
---|
| 477 | property CharactersSet: WideString read GetCharSet write SetCharSet;
|
---|
| 478 | property ElementByID[const ID: WideString]: IHTMLElement read getElemByID;
|
---|
| 479 | function ScrollToElement(Element: IHTMLElement): Boolean;
|
---|
| 480 |
|
---|
| 481 |
|
---|
| 482 | function GetElementNamespaceTable(out aTable: IElementNamespaceTable):
|
---|
| 483 | Boolean;
|
---|
| 484 |
|
---|
| 485 | {$IFDEF RESEARCH_MODE}
|
---|
| 486 | property OnQueryInterface: OnQueryInterfaceEvent read fOnQueryInterface write fOnQueryInterface;
|
---|
| 487 | {$ENDIF}
|
---|
| 488 | property CanGrabFocus: Boolean read FCanGrabFocus write FCanGrabFocus default True;
|
---|
| 489 | published
|
---|
| 490 | property OnAllowFocusChange: TBoolQueryEvent read FOnAllowFocusChange write
|
---|
| 491 | FOnAllowFocusChange;
|
---|
| 492 | property DisableCtrlShortcuts: string read FDisableCtrlShortcuts write FDisableCtrlShortcuts;
|
---|
| 493 | property DownloadOptions: TDownloadControlOptions read FDownloadControlOptions
|
---|
| 494 | write SetDownloadOptions default [DownloadImages, DownloadVideos, DownloadBGSounds];
|
---|
| 495 | property UserInterfaceOptions: TUserInterfaceOptions read FUserInterfaceOptions
|
---|
| 496 | write SetUserInterfaceOptions default [];
|
---|
| 497 | property HelpFile: string read FHelpFile write FHelpFile;
|
---|
| 498 | property OptionKeyPath: string read FOptionKeyPath write FOptionKeyPath;
|
---|
| 499 | property OverrideOptionKeyPath: Boolean read FOverOptionKeyPath write
|
---|
| 500 | FOverOptionKeyPath default False;
|
---|
| 501 |
|
---|
| 502 | property DropHandlingType: TDragDropHandlingType read FDropHandlingType write
|
---|
| 503 | setDropHandlingType default ddtMS;
|
---|
| 504 | property DisabledPopupMenus: TIEPopupMenus
|
---|
| 505 | read FDisabledPopupMenus write FDisabledPopupMenus default [];
|
---|
| 506 | property FloatingHosting: Boolean read FFloatingHosting write
|
---|
| 507 | fFloatingHosting default False;
|
---|
| 508 |
|
---|
| 509 | property OnGetIDsOfNames: TGetIDsOfNamesEvent read FOnGetIDsOfNames write
|
---|
| 510 | FOnGetIdsOfNames;
|
---|
| 511 | property OnGetTypeInfo: TGetTypeInfoEvent read FonGetTypeInfo write
|
---|
| 512 | FOnGetTypeInfo;
|
---|
| 513 | property OnGetTypeInfoCount: TGetTypeInfoCountEvent read FonGetTypeInfoCount
|
---|
| 514 | write FOnGetTypeInfoCount;
|
---|
| 515 | property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke;
|
---|
| 516 | property OnShowHelpRequest: TShowHelpEvent read FOnShowHelp write
|
---|
| 517 | FOnShowHelp;
|
---|
| 518 | property OnShowMessage: TShowMessageEvent read FOnShowMessage write
|
---|
| 519 | FOnShowMessage;
|
---|
| 520 | property OnFilterDataObject: TFilterDataObjectEvent read FOnFilterDataObject
|
---|
| 521 | write FOnFilterDataObject;
|
---|
| 522 | property OnGetExternal: TGetExternalEvent read FOnGetExternal write
|
---|
| 523 | FOnGetExternal;
|
---|
| 524 | property OnGetHostInfo: TGetHostInfoEvent read FOnGetHostInfo write
|
---|
| 525 | FOnGetHostInfo;
|
---|
| 526 | property OnEnableModeless: TEnableModelessEvent read FOnEnableModeless
|
---|
| 527 | write FOnEnableModeless;
|
---|
| 528 | {$IFDEF GETKEYPATH_HANDLERS}
|
---|
| 529 | property OnGetOptionKeyPath: TGetOptionKeyPathEvent read FOnGetOptionKeyPath
|
---|
| 530 | write FOnGetOptionKeyPath;
|
---|
| 531 | property OnGetOverrideKeyPath: TGetOptionKeyPathEvent read
|
---|
| 532 | FOnGetOverrideKeyPath
|
---|
| 533 | write FOnGetOverrideKeyPath;
|
---|
| 534 | {$ENDIF}
|
---|
| 535 | property OnZoomPercentChange: TZoomPercentChangedEvent read FOnZoomPercentChanged write FOnZoomPercentChanged;
|
---|
| 536 | property OnGetDropTarget: TGetDropTargetEvent read FOnGetDropTarget write FOnGetDropTarget;
|
---|
| 537 | property OnHideUI: TEWBNotifyEvent read FOnHideUI write FOnHideUI;
|
---|
| 538 | property OnOnDocWindowActivate: TOnActivateEvent read FOnOnDocWindowActivate
|
---|
| 539 | write FOnOnDocWindowActivate;
|
---|
| 540 | property OnOnFrameWindowActivate: TOnActivateEvent read
|
---|
| 541 | FOnOnFrameWindowActivate
|
---|
| 542 | write FOnOnFrameWindowActivate;
|
---|
| 543 | property OnResizeBorder: TResizeBorderEvent read FOnResizeBorder write
|
---|
| 544 | FOnResizeBorder;
|
---|
| 545 | property OnShowContextMenu: TShowContextMenuEvent read FOnShowContextmenu
|
---|
| 546 | write FOnShowContextmenu;
|
---|
| 547 | property OnShowUI: TShowUIEvent read FOnShowUI write FOnShowUI;
|
---|
| 548 | property OnTranslateAccelerator: TTranslateAcceleratorEvent read
|
---|
| 549 | FOnTranslateAccelerator
|
---|
| 550 | write FOnTranslateAccelerator;
|
---|
| 551 | property OnTranslateUrl: TTranslateUrlEvent read FOnTranslateUrL
|
---|
| 552 | write FOnTranslateUrL;
|
---|
| 553 | property OnUpdateUI: TEWBNotifyEvent read FOnUpdateUI write FOnUpdateUI;
|
---|
| 554 |
|
---|
| 555 | property OnDragEnter: TOnDragEnterEvent read FOnDragEnterEvent write
|
---|
| 556 | FOnDragEnterEvent;
|
---|
| 557 | property OnDragLeave: TNotifyEvent read FOnDragLeaveEvent write
|
---|
| 558 | FOnDragLeaveEvent;
|
---|
| 559 | property OnDragOver2: TOnDragOverEvent read FOnDragOverEvent write
|
---|
| 560 | FOnDragOverEvent;
|
---|
| 561 | property OnDropEvent: TOnDropEvent read FOnDropEvent write FOnDropEvent;
|
---|
| 562 |
|
---|
| 563 | property OnScriptError: TScriptErrorEvent read FOnScriptError write FOnScriptError;
|
---|
| 564 | property ScriptErrorAction: TScriptErrorAction read FScriptErrorAction
|
---|
| 565 | write FScriptErrorAction default eaContinue;
|
---|
| 566 | {$IFDEF USE_IOLECOMMANDTARGET}
|
---|
| 567 | property OnRefresh: TRefreshEvent read FOnRefresh write FOnRefresh;
|
---|
| 568 | property OnUnload: TNotifyEvent read FOnUnload write FOnUnload;
|
---|
| 569 | property OnCommandExec: TComTargetExecEvent read FOnCommandExec write
|
---|
| 570 | fOnCommandExec;
|
---|
| 571 | {$ENDIF}
|
---|
| 572 | property OnQueryService: TQueryServiceEvent read FOnQueryService write
|
---|
| 573 | FOnQueryService;
|
---|
| 574 | property OnEvaluateNewWindow: TEvaluateNewWindowEvent read
|
---|
| 575 | FOnEvaluateNewWindow
|
---|
| 576 | write FOnEvaluateNewWindow;
|
---|
| 577 | property OnFileDownload: TDownloadEvent read FOnDownload write FOnDownload;
|
---|
| 578 | property OnFilterPopupMenu: TMenuPreprocess read FOnFilterPopupMenu write
|
---|
| 579 | FOnFilterPopupMenu;
|
---|
| 580 | property OnMaskedCtrlChar: TMaskedCtrlCharEvent read FOnMaskedCtrlChar write
|
---|
| 581 | FOnMaskedCtrlChar;
|
---|
| 582 |
|
---|
| 583 | property OnMove: TOMWindowMoveEvent read FOnMove write FOnMove;
|
---|
| 584 | property OnMoveBy: TOMWindowMoveEvent read FOnMoveBy write FOnMoveBy;
|
---|
| 585 | property OnResize: TOMWindowMoveEvent read FOnResize write FOnResize;
|
---|
| 586 | property OnResizeBy: TOMWindowMoveEvent read FOnResizeBy write FOnResizeBy;
|
---|
| 587 | property OnPopulateNSTable: TNotifyEvent read FOnPopulateNSTable write
|
---|
| 588 | FOnPopulateNSTable;
|
---|
| 589 | property OnAuthenticate: TAuthenticateEvent read FOnAuthenticate write
|
---|
| 590 | FOnAuthenticate;
|
---|
| 591 | property OnPreRefresh: TNotifyEvent read FOnPreRefresh write FOnPreRefresh;
|
---|
| 592 | end;
|
---|
| 593 |
|
---|
| 594 | TEwbCore = class(TCustomEmbeddedWB)
|
---|
| 595 | private
|
---|
| 596 | function IsCtrlCharMask: Boolean;
|
---|
| 597 | published
|
---|
| 598 | property DisableCtrlShortcuts stored IsCtrlCharMask;
|
---|
| 599 | end;
|
---|
| 600 |
|
---|
| 601 | //this two functions for using in custom OnShowContextMenu handler.
|
---|
| 602 | function IsSeTIEPopupMenus(ID: DWORD; rcm: TIEPopupMenus): Boolean;
|
---|
| 603 | function ShowRightClickMenu(Sender: TObject; dwID: DWORD;
|
---|
| 604 | const Target: IUnknown; const Context: IDispatch;
|
---|
| 605 | const ppt: PPOINT;
|
---|
| 606 | const EncodingSubMenu: OleVariant;
|
---|
| 607 | preprocess: TMenuPreprocess = nil): Boolean;
|
---|
| 608 |
|
---|
| 609 |
|
---|
| 610 | implementation
|
---|
| 611 |
|
---|
| 612 | uses
|
---|
| 613 | SysUtils, ComObj, EwbCoreTools, Registry;
|
---|
| 614 |
|
---|
| 615 | function IsSeTIEPopupMenus(ID: DWORD; rcm: TIEPopupMenus): Boolean;
|
---|
| 616 | begin
|
---|
| 617 | Result := (rcmAll in rcm) or
|
---|
| 618 | ((ID in [0..9]) and (TIEPopupMenu(ID) in rcm));
|
---|
| 619 | end;
|
---|
| 620 |
|
---|
| 621 | function ShowRightClickMenu(Sender: TObject; dwID: DWORD; const Target: IUnknown; const Context:
|
---|
| 622 | IDispatch;
|
---|
| 623 | const ppt: PPOINT; const EncodingSubMenu: OleVariant;
|
---|
| 624 | Preprocess: TMenuPreprocess = nil): Boolean;
|
---|
| 625 | var
|
---|
| 626 | ShDocLcHandle: THandle;
|
---|
| 627 | OleCommandTarget: IOleCommandTarget;
|
---|
| 628 | OleWindow: IOleWindow;
|
---|
| 629 | WindowHandle: HWND;
|
---|
| 630 | ParentMenu, SubMenu: HMENU;
|
---|
| 631 | SubMenuItemInfo: MENUITEMINFO;
|
---|
| 632 | PopupResult: LongBool;
|
---|
| 633 | begin
|
---|
| 634 | Result := False;
|
---|
| 635 | ShDocLcHandle := GetSHDOCLCModule;
|
---|
| 636 |
|
---|
| 637 | if ShDocLcHandle = 0 then Exit;
|
---|
| 638 |
|
---|
| 639 | if Supports(Target, IOleCommandTarget, OleCommandTarget) and
|
---|
| 640 | Supports(Target, IOleWindow, OleWindow) and
|
---|
| 641 | ActiveX.Succeeded(OleWindow.GetWindow(WindowHandle)) then
|
---|
| 642 | begin
|
---|
| 643 | ParentMenu := Windows.LoadMenu(ShDocLcHandle,
|
---|
| 644 | MAKEINTRESOURCE(CContextMenuID));
|
---|
| 645 | if ParentMenu <> 0 then
|
---|
| 646 | try
|
---|
| 647 | SubMenu := GetSubMenu(ParentMenu, dwID);
|
---|
| 648 | FillChar(SubMenuItemInfo, SizeOf(SubMenuItemInfo), 0);
|
---|
| 649 | SubMenuItemInfo.cbSize := SizeOf(MENUITEMINFO);
|
---|
| 650 | SubMenuItemInfo.fMask := MIIM_SUBMENU;
|
---|
| 651 | SubMenuItemInfo.hSubMenu := HMENU(@EncodingSubMenu);
|
---|
| 652 | SetMenuItemInfo(SubMenu, IDM_LANGUAGE, False, SubMenuItemInfo);
|
---|
| 653 |
|
---|
| 654 | if Assigned(Preprocess) then
|
---|
| 655 | Preprocess(Sender, dwID, SubMenu, Context);
|
---|
| 656 |
|
---|
| 657 | PopupResult := Windows.TrackPopupMenuEx(SubMenu, TPM_LEFTALIGN
|
---|
| 658 | or TPM_TOPALIGN or TPM_RETURNCMD or TPM_RIGHTBUTTON
|
---|
| 659 | or TPM_HORPOSANIMATION or TPM_VERPOSANIMATION, ppt^.X, ppt^.Y,
|
---|
| 660 | WindowHandle, nil);
|
---|
| 661 | if PopupResult then
|
---|
| 662 | SendMessage(WindowHandle, WM_COMMAND, MakeWParam(LOWORD(PopupResult), 0), 0);
|
---|
| 663 | Result := True;
|
---|
| 664 | finally
|
---|
| 665 | DestroyMenu(ParentMenu);
|
---|
| 666 | end;
|
---|
| 667 | end;
|
---|
| 668 | end;
|
---|
| 669 |
|
---|
| 670 |
|
---|
| 671 | type
|
---|
| 672 | { TnoDragDrop }
|
---|
| 673 | TnoDragDrop = class(TInterfacedObject, IDropTarget)
|
---|
| 674 | protected
|
---|
| 675 | function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
|
---|
| 676 | pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
|
---|
| 677 | function DragOver(grfKeyState: Longint; pt: TPoint;
|
---|
| 678 | var dwEffect: Longint): HRESULT; stdcall;
|
---|
| 679 | function DragLeave: HRESULT; stdcall;
|
---|
| 680 | function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
|
---|
| 681 | var dwEffect: Longint): HRESULT; stdcall;
|
---|
| 682 | end;
|
---|
| 683 |
|
---|
| 684 | function TnoDragDrop.DragEnter(const dataObj: IDataObject; grfKeyState: Integer;
|
---|
| 685 | pt: TPoint; var dwEffect: Integer): HRESULT;
|
---|
| 686 | begin
|
---|
| 687 | dwEffect := DROPEFFECT_NONE;
|
---|
| 688 | Result := S_OK;
|
---|
| 689 | end;
|
---|
| 690 |
|
---|
| 691 | function TnoDragDrop.DragLeave: HRESULT;
|
---|
| 692 | begin
|
---|
| 693 | Result := S_OK;
|
---|
| 694 | end;
|
---|
| 695 |
|
---|
| 696 | function TnoDragDrop.DragOver(grfKeyState: Integer; pt: TPoint;
|
---|
| 697 | var dwEffect: Integer): HRESULT;
|
---|
| 698 | begin
|
---|
| 699 | dwEffect := DROPEFFECT_NONE;
|
---|
| 700 | Result := S_OK;
|
---|
| 701 | end;
|
---|
| 702 |
|
---|
| 703 | function TnoDragDrop.Drop(const dataObj: IDataObject; grfKeyState: Integer;
|
---|
| 704 | pt: TPoint; var dwEffect: Integer): HRESULT;
|
---|
| 705 | begin
|
---|
| 706 | dwEffect := DROPEFFECT_NONE;
|
---|
| 707 | Result := S_OK;
|
---|
| 708 | end;
|
---|
| 709 |
|
---|
| 710 | { TCustomEmbeddedWB }
|
---|
| 711 |
|
---|
| 712 | class function TCustomEmbeddedWB.dwEffectToStr(Command: Int64): string;
|
---|
| 713 | const
|
---|
| 714 | E_UNSPEC = E_Fail;
|
---|
| 715 | begin
|
---|
| 716 | case (Command) of
|
---|
| 717 | DROPEFFECT_NONE: Result := 'Drop target cannot accept the data.';
|
---|
| 718 | DROPEFFECT_COPY: Result := 'Drag source should copy the data.';
|
---|
| 719 | DROPEFFECT_MOVE: Result := 'Drag source should remove the data.';
|
---|
| 720 | DROPEFFECT_LINK: Result :=
|
---|
| 721 | 'Drag source should create a link to the original data.';
|
---|
| 722 | DRAGDROP_S_DROP: Result := 'The drag-and-drop operation was successful.';
|
---|
| 723 | DRAGDROP_S_CANCEL: Result := 'The drag-and-drop operation was canceled.';
|
---|
| 724 | DRAGDROP_S_USEDEFAULTCURSORS: Result :=
|
---|
| 725 | 'Successful completion. Restoring defaults.';
|
---|
| 726 | DRAGDROP_E_INVALIDHWND: Result :=
|
---|
| 727 | 'Invalid handle returned in the hwnd parameter.';
|
---|
| 728 | DRAGDROP_E_NOTREGISTERED: Result :=
|
---|
| 729 | 'Failed to revoke a drop target that has not been registered.';
|
---|
| 730 | E_UNSPEC: Result := 'Unexpected error occurred.';
|
---|
| 731 | E_OUTOFMEMORY: Result := 'Out of memory.';
|
---|
| 732 | 7: Result := 'operation was successful.';
|
---|
| 733 | else
|
---|
| 734 | Result := 'Unknown.';
|
---|
| 735 | end;
|
---|
| 736 | end;
|
---|
| 737 |
|
---|
| 738 | class procedure TCustomEmbeddedWB.DropEffect(grfKeyState: Longint; var dwEffect:
|
---|
| 739 | longint);
|
---|
| 740 | begin
|
---|
| 741 | if (grfKeyState and MK_CONTROL = 0) and (grfKeyState and MK_SHIFT <> 0) and
|
---|
| 742 | (dwEffect and DropEffect_Move <> 0) then
|
---|
| 743 | dwEffect := DropEffect_Move
|
---|
| 744 | else if (grfKeyState and MK_CONTROL <> 0) and (grfKeyState and MK_SHIFT <> 0)
|
---|
| 745 | and
|
---|
| 746 | (dwEffect and DropEffect_Link <> 0) then
|
---|
| 747 | dwEffect := DropEffect_Link
|
---|
| 748 | else if (dwEffect and DropEffect_Copy <> 0) then
|
---|
| 749 | dwEffect := DropEffect_Copy
|
---|
| 750 | else if (dwEffect and DropEffect_Move <> 0) then
|
---|
| 751 | dwEffect := DropEffect_Move
|
---|
| 752 | else if (dwEffect and DropEffect_Link <> 0) then
|
---|
| 753 | dwEffect := DropEffect_Link
|
---|
| 754 | else
|
---|
| 755 | dwEffect := DropEffect_None;
|
---|
| 756 | end;
|
---|
| 757 |
|
---|
| 758 | function TCustomEmbeddedWB.AllowFocusChange(out pfAllow: BOOL): HRESULT;
|
---|
| 759 | begin
|
---|
| 760 | Result := S_OK;
|
---|
| 761 | pfAllow := CanGrabFocus;
|
---|
| 762 | if Assigned(OnAllowFocusChange) then
|
---|
| 763 | OnAllowFocusChange(Self, pfAllow);
|
---|
| 764 | end;
|
---|
| 765 |
|
---|
| 766 | function TCustomEmbeddedWB.CopyOptionKeyPath(Overrided: Boolean): PWideChar;
|
---|
| 767 | begin
|
---|
| 768 | if (OptionKeyPath = '') or
|
---|
| 769 | (OverrideOptionKeyPath xor Overrided) then
|
---|
| 770 | Result := nil
|
---|
| 771 | else
|
---|
| 772 | Result := StringToLPOLESTR(OptionKeyPath);
|
---|
| 773 | end;
|
---|
| 774 |
|
---|
| 775 | constructor TCustomEmbeddedWB.Create(AOwner: TComponent);
|
---|
| 776 | begin
|
---|
| 777 | inherited;
|
---|
| 778 | FCanGrabFocus := True;
|
---|
| 779 | FScriptErrorAction := eaContinue;
|
---|
| 780 | DownloadOptions := [DownloadImages, DownloadVideos, DownloadBGSounds];
|
---|
| 781 | UserInterfaceOptions := [EnableThemes, EnablesFormsAutoComplete];
|
---|
| 782 | FDropHandlingType := ddtMS;
|
---|
| 783 | FDisableCtrlShortcuts := 'N';
|
---|
| 784 | end;
|
---|
| 785 |
|
---|
| 786 | destructor TCustomEmbeddedWB.Destroy();
|
---|
| 787 | begin
|
---|
| 788 | inherited;
|
---|
| 789 | end;
|
---|
| 790 |
|
---|
| 791 | procedure TCustomEmbeddedWB.CreateWnd; //jls
|
---|
| 792 | begin
|
---|
| 793 | if (CurrentHandle <> 0) and IsWindow(CurrentHandle) then
|
---|
| 794 | begin
|
---|
| 795 | WindowHandle := CurrentHandle;
|
---|
| 796 | CurrentHandle := 0;
|
---|
| 797 | Windows.SetParent(WindowHandle, TWinControl(Self).Parent.Handle);
|
---|
| 798 | MoveWindow(WindowHandle, 0, 0, TWinControl(Self).Parent.Width,
|
---|
| 799 | TWinControl(Self).Parent.Height, True); //Force a resize on the client window
|
---|
| 800 | end
|
---|
| 801 | else
|
---|
| 802 | inherited;
|
---|
| 803 | end;
|
---|
| 804 |
|
---|
| 805 | procedure TCustomEmbeddedWB.DestroyWnd; //jls
|
---|
| 806 | begin
|
---|
| 807 | if (csDestroying in ComponentState) then
|
---|
| 808 | inherited
|
---|
| 809 | else
|
---|
| 810 | begin
|
---|
| 811 | Windows.SetParent(WindowHandle, Forms.Application.Handle); //Parent to the Application window which is 0x0 in size
|
---|
| 812 | CurrentHandle := WindowHandle; // Save the WindowHandle
|
---|
| 813 | WindowHandle := 0; // Set it to 0 so Createwnd will be called again...
|
---|
| 814 | end;
|
---|
| 815 | end;
|
---|
| 816 |
|
---|
| 817 | function TCustomEmbeddedWB.EnableModeless(const fEnable: BOOL): HRESULT;
|
---|
| 818 | begin
|
---|
| 819 | Result := S_OK;
|
---|
| 820 | if Assigned(FOnEnableModeless) then
|
---|
| 821 | FOnEnableModeless(Self, fEnable);
|
---|
| 822 | end;
|
---|
| 823 |
|
---|
| 824 | function TCustomEmbeddedWB.EvaluateNewWindow(pszUrl, pszName, pszUrlContext,
|
---|
| 825 | pszFeatures: LPCWSTR; fReplace: BOOL; dwFlags,
|
---|
| 826 | dwUserActionTime: DWORD): HRESULT;
|
---|
| 827 | begin
|
---|
| 828 | Result := E_FAIL;
|
---|
| 829 | if Assigned(FOnEvaluateNewWindow) then
|
---|
| 830 | FOnEvaluateNewWindow(Self, pszUrl, pszName, pszUrlContext, pszFeatures,
|
---|
| 831 | FReplace, dwFlags, dwUserActionTime, Result);
|
---|
| 832 | end;
|
---|
| 833 |
|
---|
| 834 | function TCustomEmbeddedWB.FilterDataObject(const pDO: IDataObject;
|
---|
| 835 | out ppDORet: IDataObject): HRESULT;
|
---|
| 836 | begin
|
---|
| 837 | ppDORet := nil;
|
---|
| 838 | if Assigned(FOnFilterDataObject) then
|
---|
| 839 | FOnFilterDataObject(Self, pDO, ppDORet);
|
---|
| 840 | if ppDORet = nil then
|
---|
| 841 | Result := S_FALSE
|
---|
| 842 | else
|
---|
| 843 | Result := S_OK;
|
---|
| 844 | end;
|
---|
| 845 |
|
---|
| 846 | function TCustomEmbeddedWB.GetDoc2: IHtmlDocument2;
|
---|
| 847 | begin
|
---|
| 848 | if not Supports(Document, IHtmlDocument2, Result) then
|
---|
| 849 | Result := nil;
|
---|
| 850 | end;
|
---|
| 851 |
|
---|
| 852 | function TCustomEmbeddedWB.GetDoc3: IHtmlDocument3;
|
---|
| 853 | begin
|
---|
| 854 | if not Supports(Document, IHtmlDocument3, Result) then
|
---|
| 855 | Result := nil;
|
---|
| 856 | end;
|
---|
| 857 |
|
---|
| 858 | function TCustomEmbeddedWB.GetDoc4: IHtmlDocument4;
|
---|
| 859 | begin
|
---|
| 860 | if not Supports(Document, IHtmlDocument4, Result) then
|
---|
| 861 | Result := nil;
|
---|
| 862 | end;
|
---|
| 863 |
|
---|
| 864 | function TCustomEmbeddedWB.GetDoc5: IHtmlDocument5;
|
---|
| 865 | begin
|
---|
| 866 | if not Supports(Document, IHtmlDocument5, Result) then
|
---|
| 867 | Result := nil;
|
---|
| 868 | end;
|
---|
| 869 |
|
---|
| 870 | function TCustomEmbeddedWB.getBody: IHTMLElement;
|
---|
| 871 | var
|
---|
| 872 | D: IHtmlDocument2;
|
---|
| 873 | begin
|
---|
| 874 | if Supports(Document, IHtmlDocument2, D) then
|
---|
| 875 | Result := D.body
|
---|
| 876 | else
|
---|
| 877 | Result := nil;
|
---|
| 878 | end;
|
---|
| 879 |
|
---|
| 880 | function TCustomEmbeddedWB.GetExternal(out ppDispatch: IDispatch): HRESULT;
|
---|
| 881 | begin
|
---|
| 882 | ppDispatch := nil;
|
---|
| 883 | if Assigned(FOnGetExternal) then
|
---|
| 884 | FOnGetExternal(Self, ppDispatch);
|
---|
| 885 | if ppDispatch = nil then
|
---|
| 886 | Result := S_FALSE
|
---|
| 887 | else
|
---|
| 888 | Result := S_OK;
|
---|
| 889 | end;
|
---|
| 890 |
|
---|
| 891 | function TCustomEmbeddedWB.GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT;
|
---|
| 892 | begin
|
---|
| 893 | FillChar(pInfo, SizeOf(TDOCHOSTUIINFO), #0);
|
---|
| 894 | pInfo.cbSize := SizeOf(pInfo);
|
---|
| 895 | pInfo.dwFlags := FUserInterfaceValue;
|
---|
| 896 | pInfo.dwDoubleClick := DOCHOSTUIDBLCLK_DEFAULT;
|
---|
| 897 | Result := S_OK;
|
---|
| 898 |
|
---|
| 899 | if Assigned(FOnGetHostInfo) then
|
---|
| 900 | FOnGetHostInfo(Self, pInfo);
|
---|
| 901 | end;
|
---|
| 902 |
|
---|
| 903 | function TCustomEmbeddedWB.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
|
---|
| 904 | LocaleID: Integer; DispIDs: Pointer): HRESULT;
|
---|
| 905 | begin
|
---|
| 906 | Result := inherited GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs);
|
---|
| 907 | if Assigned(FOnGetIDsOfNames) then
|
---|
| 908 | FOnGetIDsOfNames(Self, IID, Names, NameCount, LocaleID, DispIds, Result);
|
---|
| 909 | end;
|
---|
| 910 |
|
---|
| 911 | function TCustomEmbeddedWB.GetIEWin(const ClassName: string): HWND;
|
---|
| 912 | var
|
---|
| 913 | szClass: array[0..255] of char;
|
---|
| 914 | begin
|
---|
| 915 | if HandleAllocated then
|
---|
| 916 | begin
|
---|
| 917 | Result := GetWindow(WindowHandle, GW_CHILD);
|
---|
| 918 | repeat
|
---|
| 919 | if (GetClassName(Result, szClass, SizeOf(szClass)) > 0) and
|
---|
| 920 | (AnsiStrComp(PChar(ClassName), szClass) = 0) then Exit;
|
---|
| 921 | Result := GetWindow(Result, GW_CHILD);
|
---|
| 922 | until not IsWindow(Result);
|
---|
| 923 | end;
|
---|
| 924 | Result := 0;
|
---|
| 925 | end;
|
---|
| 926 |
|
---|
| 927 | function TCustomEmbeddedWB.GetOptionKeyPath(out pchKey: POleStr;
|
---|
| 928 | const dw: DWORD): HRESULT;
|
---|
| 929 | begin
|
---|
| 930 | pchKey := CopyOptionKeyPath(False);
|
---|
| 931 | {$IFDEF GETKEYPATH_HANDLERS}
|
---|
| 932 | if Assigned(FOnGetOptionKeyPath) then
|
---|
| 933 | FOnGetOptionKeyPath(Self, pchKey);
|
---|
| 934 | {$ENDIF}
|
---|
| 935 | if pchKey = nil then
|
---|
| 936 | Result := S_FALSE
|
---|
| 937 | else
|
---|
| 938 | Result := S_OK;
|
---|
| 939 | end;
|
---|
| 940 |
|
---|
| 941 | function TCustomEmbeddedWB.GetOverrideKeyPath(out pchKey: POleStr; dw: DWORD): HRESULT;
|
---|
| 942 | begin
|
---|
| 943 | pchKey := CopyOptionKeyPath(True);
|
---|
| 944 | {$IFDEF GETKEYPATH_HANDLERS}
|
---|
| 945 | if Assigned(FOnGetOverrideKeyPath) then
|
---|
| 946 | FOnGetOverrideKeyPath(Self, pchKey);
|
---|
| 947 | {$ENDIF}
|
---|
| 948 | if pchKey = nil then
|
---|
| 949 | Result := S_FALSE
|
---|
| 950 | else
|
---|
| 951 | Result := S_OK;
|
---|
| 952 | end;
|
---|
| 953 |
|
---|
| 954 | function TCustomEmbeddedWB.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT;
|
---|
| 955 | begin
|
---|
| 956 | Result := inherited GetTypeInfo(Index, LocaleID, TypeInfo);
|
---|
| 957 | if Assigned(FOnGetTypeInfo) then
|
---|
| 958 | FOnGetTypeInfo(Self, Index, LocaleID, ITypeInfo(TypeInfo), Result);
|
---|
| 959 | end;
|
---|
| 960 |
|
---|
| 961 | function TCustomEmbeddedWB.GetTypeInfoCount(out Count: Integer): HRESULT;
|
---|
| 962 | begin
|
---|
| 963 | Result := inherited GetTypeInfoCount(Count);
|
---|
| 964 | if Assigned(FOnGetTypeInfoCount) then
|
---|
| 965 | FOnGetTypeInfoCount(Self, Count, Result);
|
---|
| 966 | end;
|
---|
| 967 |
|
---|
| 968 | function TCustomEmbeddedWB.GetZoom: Integer;
|
---|
| 969 | var
|
---|
| 970 | vaIn, vaOut: OleVariant;
|
---|
| 971 | begin
|
---|
| 972 | vaIn := NULL;
|
---|
| 973 | InvokeCommand(nil, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
|
---|
| 974 | Result := vaOut;
|
---|
| 975 | end;
|
---|
| 976 |
|
---|
| 977 | procedure TCustomEmbeddedWB.SetZoom(const Value: Integer);
|
---|
| 978 | var
|
---|
| 979 | vaIn, vaOut: OleVariant;
|
---|
| 980 | Range: DWORD;
|
---|
| 981 | begin
|
---|
| 982 | InvokeCommand(nil, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn,
|
---|
| 983 | vaOut);
|
---|
| 984 | Range := DWORD(vaOut);
|
---|
| 985 | if Value < LoWord(Range) then
|
---|
| 986 | vaIn := LoWord(Range)
|
---|
| 987 | else if Value > HiWord(Range) then
|
---|
| 988 | vaIn := HiWord(Range)
|
---|
| 989 | else
|
---|
| 990 | vaIn := Value;
|
---|
| 991 | InvokeCommand(nil, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
|
---|
| 992 | end;
|
---|
| 993 |
|
---|
| 994 | procedure TCustomEmbeddedWB.SetOpticalZoom(const Value: Integer);
|
---|
| 995 | var
|
---|
| 996 | vaIn, vaOut: OleVariant;
|
---|
| 997 | Range: DWORD;
|
---|
| 998 | begin
|
---|
| 999 | if FZoomPercent <> Value then
|
---|
| 1000 | begin
|
---|
| 1001 | FZoomPercent := Value;
|
---|
| 1002 | InvokeCommand(nil, OLECMDID_OPTICAL_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
|
---|
| 1003 | Range := DWORD(vaOut);
|
---|
| 1004 | if Value < LoWord(Range) then
|
---|
| 1005 | vaIn := LoWord(Range)
|
---|
| 1006 | else
|
---|
| 1007 | if Value > HiWord(Range) then
|
---|
| 1008 | vaIn := HiWord(Range)
|
---|
| 1009 | else
|
---|
| 1010 | vaIn := Value;
|
---|
| 1011 | InvokeCommand(nil, OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
|
---|
| 1012 | if Assigned(FOnZoomPercentChanged) then
|
---|
| 1013 | FOnZoomPercentChanged(Self, vaOut);
|
---|
| 1014 | end;
|
---|
| 1015 | end;
|
---|
| 1016 |
|
---|
| 1017 | function TCustomEmbeddedWB.HideUI: HRESULT;
|
---|
| 1018 | begin
|
---|
| 1019 | Result := S_FALSE;
|
---|
| 1020 | if Assigned(FOnHideUI) then
|
---|
| 1021 | FOnHideUI(Self, Result);
|
---|
| 1022 | end;
|
---|
| 1023 |
|
---|
| 1024 | function TCustomEmbeddedWB.InvokeCommand(CmdGroup: PGUID; Cmd, nCmdexecopt: DWORD;
|
---|
| 1025 | var vaIn, vaOut: OleVariant): HRESULT;
|
---|
| 1026 | var
|
---|
| 1027 | CmdTarget: IOleCommandTarget;
|
---|
| 1028 | begin
|
---|
| 1029 | if Supports(Document, IOleCommandTarget, CmdTarget) then
|
---|
| 1030 | Result := CmdTarget.Exec(CmdGroup, Cmd, nCmdexecopt, vaIn, vaOut)
|
---|
| 1031 | else
|
---|
| 1032 | Result := E_UNEXPECTED;
|
---|
| 1033 | end;
|
---|
| 1034 |
|
---|
| 1035 | function TCustomEmbeddedWB.InvokeCommand(CmdGroup: PGUID; Cmd: DWORD): HRESULT;
|
---|
| 1036 | var
|
---|
| 1037 | CmdTarget: IOleCommandTarget;
|
---|
| 1038 | vaIn, vaOut: Olevariant;
|
---|
| 1039 | begin
|
---|
| 1040 | if Supports(Document, IOleCommandTarget, CmdTarget) then
|
---|
| 1041 | Result := CmdTarget.Exec(CmdGroup, Cmd, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut)
|
---|
| 1042 | else
|
---|
| 1043 | Result := E_UNEXPECTED;
|
---|
| 1044 | end;
|
---|
| 1045 |
|
---|
| 1046 | function TCustomEmbeddedWB.QueryCMDArrayStatus(CmdGroup: PGUID;
|
---|
| 1047 | cmds: TOleCmdArray): Boolean;
|
---|
| 1048 | var
|
---|
| 1049 | CmdTarget: IOleCommandTarget;
|
---|
| 1050 | begin
|
---|
| 1051 | if Supports(Document, IOleCommandTarget, CmdTarget) then
|
---|
| 1052 | Result := CmdTarget.QueryStatus(CmdGroup,
|
---|
| 1053 | Length(cmds), @Cmds, nil) = S_OK
|
---|
| 1054 | else
|
---|
| 1055 | Result := False;
|
---|
| 1056 | end;
|
---|
| 1057 |
|
---|
| 1058 | function TCustomEmbeddedWB.QueryCMDEnabled(CmdGroup: PGUID; cmdID: Cardinal): Boolean;
|
---|
| 1059 | begin
|
---|
| 1060 | Result := (QueryCMDStatus(CmdGroup, cmdID) and OLECMDF_ENABLED) <> 0;
|
---|
| 1061 | end;
|
---|
| 1062 |
|
---|
| 1063 | function TCustomEmbeddedWB.QueryCMDLatched(CmdGroup: PGUID; cmdID: Cardinal): Boolean;
|
---|
| 1064 | begin
|
---|
| 1065 | Result := (QueryCMDStatus(CmdGroup, cmdID) and OLECMDF_LATCHED) <> 0;
|
---|
| 1066 | end;
|
---|
| 1067 |
|
---|
| 1068 | function TCustomEmbeddedWB.QueryCMDStatus(CmdGroup: PGUID; cmdID: Cardinal): OLECMDF;
|
---|
| 1069 | var
|
---|
| 1070 | CmdTarget: IOleCommandTarget;
|
---|
| 1071 | Cmd: TOleCmd;
|
---|
| 1072 | begin
|
---|
| 1073 | Result := 0;
|
---|
| 1074 | if Supports(Document, IOleCommandTarget, CmdTarget) then
|
---|
| 1075 | begin
|
---|
| 1076 | Cmd.CmdID := cmdID;
|
---|
| 1077 | Cmd.cmdf := 0;
|
---|
| 1078 | if CmdTarget.QueryStatus(CmdGroup, 1, @Cmd, nil) = S_OK then
|
---|
| 1079 | Result := Cmd.cmdf;
|
---|
| 1080 | end;
|
---|
| 1081 | end;
|
---|
| 1082 |
|
---|
| 1083 | function TCustomEmbeddedWB.QueryCommandStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds:
|
---|
| 1084 | POleCmd;
|
---|
| 1085 | CmdText: POleCmdText): HRESULT;
|
---|
| 1086 | var
|
---|
| 1087 | CmdTarget: IOleCommandTarget;
|
---|
| 1088 | begin
|
---|
| 1089 | if Supports(Document, IOleCommandTarget, CmdTarget) then
|
---|
| 1090 | Result := CmdTarget.QueryStatus(CmdGroup, cCmds, prgCmds, CmdText)
|
---|
| 1091 | else
|
---|
| 1092 | Result := E_UNEXPECTED;
|
---|
| 1093 | end;
|
---|
| 1094 |
|
---|
| 1095 | {$IFDEF RESEARCH_MODE}
|
---|
| 1096 |
|
---|
| 1097 | function TCustomEmbeddedWB.QueryInterface(const IID: TGUID; out Obj): HRESULT;
|
---|
| 1098 | begin
|
---|
| 1099 | Result := inherited QueryInterface(IID, Obj);
|
---|
| 1100 | if Assigned(OnQueryInterface) then
|
---|
| 1101 | OnQueryInterface(Self, IID, Obj, Result);
|
---|
| 1102 | end;
|
---|
| 1103 | {$ENDIF}
|
---|
| 1104 |
|
---|
| 1105 |
|
---|
| 1106 | function TCustomEmbeddedWB.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
|
---|
| 1107 | Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT;
|
---|
| 1108 | var
|
---|
| 1109 | UserAgent: string;
|
---|
| 1110 | begin
|
---|
| 1111 | try
|
---|
| 1112 | Result := S_FALSE;
|
---|
| 1113 | if (Flags and DISPATCH_PROPERTYGET <> 0) and (VarResult <> nil) then
|
---|
| 1114 | begin
|
---|
| 1115 | Result := S_OK;
|
---|
| 1116 | case DispID of
|
---|
| 1117 | DISPID_AMBIENT_DLCONTROL:
|
---|
| 1118 | begin
|
---|
| 1119 | PVariant(VarResult)^ := FDownloadOptionValue;
|
---|
| 1120 | end;
|
---|
| 1121 | DISPID_AMBIENT_USERMODE:
|
---|
| 1122 | begin
|
---|
| 1123 | POleVariant(VarResult)^ := not DesignMode;
|
---|
| 1124 | end;
|
---|
| 1125 | DISPID_AMBIENT_USERAGENT:
|
---|
| 1126 | begin
|
---|
| 1127 | Result := S_FALSE;
|
---|
| 1128 | if Assigned(FOnSetUserAgent) then
|
---|
| 1129 | begin
|
---|
| 1130 | if FOnSetUserAgent(UserAgent) = S_OK then
|
---|
| 1131 | if UserAgent <> '' then
|
---|
| 1132 | begin
|
---|
| 1133 | POleVariant(VarResult)^ := UserAgent + #13#10;
|
---|
| 1134 | Result := S_OK;
|
---|
| 1135 | end;
|
---|
| 1136 | end;
|
---|
| 1137 | end;
|
---|
| 1138 | else
|
---|
| 1139 | Result := S_FALSE;
|
---|
| 1140 | end;
|
---|
| 1141 | end
|
---|
| 1142 |
|
---|
| 1143 | else if (Flags and DISPATCH_PROPERTYPUT <> 0) and
|
---|
| 1144 | (DispID = DISPID_AMBIENT_USERMODE) then
|
---|
| 1145 | begin
|
---|
| 1146 | Result := S_OK;
|
---|
| 1147 | Self.FDesignMode := POleVariant(TDispParams(Params).rgvarg)^;
|
---|
| 1148 | end;
|
---|
| 1149 |
|
---|
| 1150 | if Result = S_FALSE then
|
---|
| 1151 | begin
|
---|
| 1152 | Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params,
|
---|
| 1153 | VarResult, ExcepInfo, ArgErr);
|
---|
| 1154 | if (result = DISP_E_MEMBERNOTFOUND) and Assigned(FOnInvoke) then
|
---|
| 1155 | FOnInvoke(Self, DispID, IID, LocaleID, Flags, TagDispParams(Params),
|
---|
| 1156 | VarResult, ExcepInfo, ArgErr, Result);
|
---|
| 1157 | end;
|
---|
| 1158 | except
|
---|
| 1159 | on E: Exception do
|
---|
| 1160 | begin
|
---|
| 1161 | Result := DISP_E_EXCEPTION;
|
---|
| 1162 | with PExcepInfo(ExcepInfo)^ do
|
---|
| 1163 | begin
|
---|
| 1164 | wCode := 9999;
|
---|
| 1165 | bstrDescription := E.Message;
|
---|
| 1166 | bstrSource := E.ClassName;
|
---|
| 1167 | dwHelpContext := E.HelpContext;
|
---|
| 1168 | end;
|
---|
| 1169 | end;
|
---|
| 1170 | end;
|
---|
| 1171 | end;
|
---|
| 1172 |
|
---|
| 1173 | function TCustomEmbeddedWB.OnDocWindowActivate(const fActivate: BOOL): HRESULT;
|
---|
| 1174 | begin
|
---|
| 1175 | if Assigned(FOnOnDocWindowActivate) then
|
---|
| 1176 | FOnOnDocWindowActivate(Self, FActivate);
|
---|
| 1177 | Result := S_OK;
|
---|
| 1178 | end;
|
---|
| 1179 |
|
---|
| 1180 | function TCustomEmbeddedWB.OnFrameWindowActivate(const fActivate: BOOL): HRESULT;
|
---|
| 1181 | begin
|
---|
| 1182 | if Assigned(FOnOnFrameWindowActivate) then
|
---|
| 1183 | FOnOnFrameWindowActivate(Self, fActivate);
|
---|
| 1184 | Result := S_OK;
|
---|
| 1185 | end;
|
---|
| 1186 |
|
---|
| 1187 | function TCustomEmbeddedWB.DoQueryService(const rsid, iid: TGUID; var Obj): Boolean;
|
---|
| 1188 | begin
|
---|
| 1189 | if (IsEqualGuid(rsid, IID_INewWindowManager) and Assigned(FOnEvaluateNewWindow))
|
---|
| 1190 | or IsEqualGuid(rsid, IID_IProtectFocus)
|
---|
| 1191 | or (IsEqualGuid(rsid, IID_IDownloadManager) and Assigned(FOnDownload))
|
---|
| 1192 | or (IsEqualGuid(rsid, IID_IHostBehaviorInit) and Assigned(OnPopulateNSTable))
|
---|
| 1193 | or (IsEqualGuid(rsid, IID_IHTMLOMWindowServices) and
|
---|
| 1194 | (FloatingHosting or Assigned(OnMove) or Assigned(Self.OnMoveBy)
|
---|
| 1195 | or Assigned(OnResize) or Assigned(OnResizeBy)))
|
---|
| 1196 | or (IsEqualGUID(iid, IID_IAuthenticate) and Assigned(OnAuthenticate))
|
---|
| 1197 | then Result := QueryInterface(iid, Obj) = S_OK
|
---|
| 1198 | else Result := False;
|
---|
| 1199 | end;
|
---|
| 1200 |
|
---|
| 1201 | function TCustomEmbeddedWB.QueryService(const rsid, iid: TGUID; out Obj): HRESULT;
|
---|
| 1202 | begin
|
---|
| 1203 | Pointer(Obj) := nil;
|
---|
| 1204 | if (not DoQueryService(rsid, iid, Obj)) and Assigned(FOnQueryService) then
|
---|
| 1205 | FOnQueryService(Self, rsid, iid, IUnknown(obj));
|
---|
| 1206 |
|
---|
| 1207 | if Pointer(Obj) <> nil then
|
---|
| 1208 | Result := S_OK
|
---|
| 1209 | else
|
---|
| 1210 | Result := E_NOINTERFACE;
|
---|
| 1211 | end;
|
---|
| 1212 |
|
---|
| 1213 | function TCustomEmbeddedWB.ResizeBorder(const prcBorder: PRECT;
|
---|
| 1214 | const pUIWindow: IOleInPlaceUIWindow; const FrameWindow: BOOL): HRESULT;
|
---|
| 1215 | begin
|
---|
| 1216 | if Assigned(FOnResizeBorder) then
|
---|
| 1217 | FOnResizeBorder(Self, prcBorder, pUIWindow, fRameWindow);
|
---|
| 1218 | Result := S_OK;
|
---|
| 1219 | end;
|
---|
| 1220 |
|
---|
| 1221 | procedure TCustomEmbeddedWB.MoveParentForm(x, y: Integer; Delta: Boolean);
|
---|
| 1222 | var
|
---|
| 1223 | F: TCustomForm;
|
---|
| 1224 | begin
|
---|
| 1225 | F := GetParentForm(Self);
|
---|
| 1226 | if F <> nil then
|
---|
| 1227 | begin
|
---|
| 1228 | if Delta then
|
---|
| 1229 | begin
|
---|
| 1230 | x := F.Left + x;
|
---|
| 1231 | y := F.Top + y;
|
---|
| 1232 | end; //FIXME defend from moving outside of screen (don't forget multimonitor)
|
---|
| 1233 | F.SetBounds(x, y, F.Width, F.Height);
|
---|
| 1234 | end;
|
---|
| 1235 | end;
|
---|
| 1236 |
|
---|
| 1237 | procedure TCustomEmbeddedWB.ResizeParentForm(w, h: Integer; Delta: Boolean);
|
---|
| 1238 | var
|
---|
| 1239 | F: TCustomForm;
|
---|
| 1240 | begin
|
---|
| 1241 | F := GetParentForm(Self);
|
---|
| 1242 | if F <> nil then
|
---|
| 1243 | begin
|
---|
| 1244 | if Delta then
|
---|
| 1245 | begin
|
---|
| 1246 | w := F.Width + w;
|
---|
| 1247 | h := F.Height + h;
|
---|
| 1248 | end;
|
---|
| 1249 | F.SetBounds(F.Left, F.Top, w, h);
|
---|
| 1250 | end;
|
---|
| 1251 | end;
|
---|
| 1252 |
|
---|
| 1253 | function TCustomEmbeddedWB.ResizeBy(const x, y: Integer): HRESULT;
|
---|
| 1254 | begin
|
---|
| 1255 | if FloatingHosting then
|
---|
| 1256 | ResizeParentForm(x, y, True);
|
---|
| 1257 | if Assigned(OnResizeBy) then
|
---|
| 1258 | OnResizeBy(Self, x, y);
|
---|
| 1259 | Result := S_OK; // always return success to prevent script error messages
|
---|
| 1260 | end;
|
---|
| 1261 |
|
---|
| 1262 | function TCustomEmbeddedWB.ResizeTo(const x, y: Integer): HRESULT;
|
---|
| 1263 | begin
|
---|
| 1264 | if FloatingHosting then
|
---|
| 1265 | ResizeParentForm(x, y, False);
|
---|
| 1266 | if Assigned(OnResize) then
|
---|
| 1267 | OnResize(self, x, y);
|
---|
| 1268 | Result := S_OK; // always return success to prevent script error messages
|
---|
| 1269 | end;
|
---|
| 1270 |
|
---|
| 1271 | function TCustomEmbeddedWB.MoveBy(const x, y: Integer): HRESULT;
|
---|
| 1272 | begin
|
---|
| 1273 | if FloatingHosting then
|
---|
| 1274 | MoveParentForm(x, y, True);
|
---|
| 1275 | if Assigned(OnMoveBy) then
|
---|
| 1276 | OnMoveBy(self, x, y);
|
---|
| 1277 | Result := S_OK; // always return success to prevent script error messages
|
---|
| 1278 | end;
|
---|
| 1279 |
|
---|
| 1280 | function TCustomEmbeddedWB.MoveTo(const x, y: Integer): HRESULT;
|
---|
| 1281 | begin
|
---|
| 1282 | if FloatingHosting then
|
---|
| 1283 | MoveParentForm(x, y, False);
|
---|
| 1284 | if Assigned(OnMove) then
|
---|
| 1285 | OnMove(self, x, y);
|
---|
| 1286 | Result := S_OK; // always return success to prevent script error messages
|
---|
| 1287 | end;
|
---|
| 1288 |
|
---|
| 1289 | function TCustomEmbeddedWB.OnZoomPercentChanged(const ulZoomPercent: uLong): HRESULT;
|
---|
| 1290 | begin
|
---|
| 1291 | if Assigned(FOnZoomPercentChanged) then
|
---|
| 1292 | Result := FOnZoomPercentChanged(Self, ulZoomPercent)
|
---|
| 1293 | else
|
---|
| 1294 | Result := S_FALSE;
|
---|
| 1295 | end;
|
---|
| 1296 |
|
---|
| 1297 | function TCustomEmbeddedWB.GetElemByID(const ID: WideString): IHTMLElement;
|
---|
| 1298 | var
|
---|
| 1299 | Doc3: IHTMLDocument3;
|
---|
| 1300 | begin
|
---|
| 1301 | if Supports(Document, IHTMLDocument3, Doc3) then
|
---|
| 1302 | Result := Doc3.getElementById(ID)
|
---|
| 1303 | else
|
---|
| 1304 | Result := nil;
|
---|
| 1305 | end;
|
---|
| 1306 |
|
---|
| 1307 | function TCustomEmbeddedWB.ScrollToElement(Element: IHTMLElement): Boolean;
|
---|
| 1308 | var
|
---|
| 1309 | RV: IHTMLRect;
|
---|
| 1310 | begin
|
---|
| 1311 | Result := Element <> nil;
|
---|
| 1312 | if Result then
|
---|
| 1313 | begin
|
---|
| 1314 | RV := (Element as IHTMLElement2).getBoundingClientRect;
|
---|
| 1315 | Doc2.parentWindow.scrollBy(RV.left, RV.top);
|
---|
| 1316 | end;
|
---|
| 1317 | end;
|
---|
| 1318 |
|
---|
| 1319 | function TCustomEmbeddedWB.GetCharSet: WideString;
|
---|
| 1320 | begin
|
---|
| 1321 | Result := Doc2.charset;
|
---|
| 1322 | end;
|
---|
| 1323 |
|
---|
| 1324 | procedure TCustomEmbeddedWB.SetCharSet(const Value: WideString);
|
---|
| 1325 | var
|
---|
| 1326 | Level: OleVariant;
|
---|
| 1327 | begin
|
---|
| 1328 | Doc2.charset := Value;
|
---|
| 1329 | Level := 7;
|
---|
| 1330 | DefaultInterface.Refresh2(Level);
|
---|
| 1331 | end;
|
---|
| 1332 |
|
---|
| 1333 | procedure TCustomEmbeddedWB.SetDesignMode(const Value: Boolean);
|
---|
| 1334 | var
|
---|
| 1335 | Control: IOleControl;
|
---|
| 1336 | begin
|
---|
| 1337 | FDesignMode := Value;
|
---|
| 1338 | if DefaultInterface.QueryInterface(IOleControl, Control) = 0 then
|
---|
| 1339 | with (Application as IOleControl) do
|
---|
| 1340 | begin
|
---|
| 1341 | OnAmbientPropertyChange(DISPID_AMBIENT_USERMODE);
|
---|
| 1342 | _Release;
|
---|
| 1343 | end;
|
---|
| 1344 | end;
|
---|
| 1345 |
|
---|
| 1346 | const
|
---|
| 1347 | _DesignModeValues: array[TDocDesignMode] of string =
|
---|
| 1348 | ('On', 'Off', 'Inherit', '');
|
---|
| 1349 |
|
---|
| 1350 | function TCustomEmbeddedWB.GetDocDesignMode: TDocDesignMode;
|
---|
| 1351 | var
|
---|
| 1352 | D: IHTMLDocument2;
|
---|
| 1353 | I: Integer;
|
---|
| 1354 | begin
|
---|
| 1355 | Result := ddmUnknown;
|
---|
| 1356 | if Supports(Document, IHTMLDocument2, D) then
|
---|
| 1357 | begin
|
---|
| 1358 | I := AnsiIndexStr(D.designMode, _DesignModeValues);
|
---|
| 1359 | if I in [0..2] then
|
---|
| 1360 | Result := TDocDesignMode(I);
|
---|
| 1361 | end;
|
---|
| 1362 | end;
|
---|
| 1363 |
|
---|
| 1364 | procedure TCustomEmbeddedWB.SetDocDesignMode(const Value: TDocDesignMode);
|
---|
| 1365 | var
|
---|
| 1366 | D: IHTMLDocument2;
|
---|
| 1367 | begin
|
---|
| 1368 | if (Value <> ddmUnknown) and Supports(Document, IHTMLDocument2, D) then
|
---|
| 1369 | D.designMode := _DesignModeValues[Value];
|
---|
| 1370 | end;
|
---|
| 1371 |
|
---|
| 1372 | procedure TCustomEmbeddedWB.SetDownloadOptions(const Value: TDownloadControlOptions);
|
---|
| 1373 | begin
|
---|
| 1374 | FDownloadControlOptions := Value;
|
---|
| 1375 | UpdateDownloadControlValues;
|
---|
| 1376 | with (Application as IOleControl) do
|
---|
| 1377 | begin
|
---|
| 1378 | OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
|
---|
| 1379 | _Release;
|
---|
| 1380 | end;
|
---|
| 1381 | end;
|
---|
| 1382 |
|
---|
| 1383 | procedure TCustomEmbeddedWB.SetFocusToBody;
|
---|
| 1384 | var
|
---|
| 1385 | bodyElement: IHTMLElement2;
|
---|
| 1386 | HTMLDoc2: IHTMLDocument2;
|
---|
| 1387 | begin
|
---|
| 1388 | HTMLDoc2 := GetDoc2;
|
---|
| 1389 | if Assigned(HTMLDoc2) then
|
---|
| 1390 | begin
|
---|
| 1391 | bodyElement := HTMLDoc2.body as IHTMLElement2;
|
---|
| 1392 | if Assigned(bodyElement) then
|
---|
| 1393 | bodyElement.focus;
|
---|
| 1394 | end;
|
---|
| 1395 | end;
|
---|
| 1396 |
|
---|
| 1397 | procedure TCustomEmbeddedWB.SetFocusToDoc;
|
---|
| 1398 | var
|
---|
| 1399 | bCanGrabFocus: Boolean;
|
---|
| 1400 | ParentForm: TCustomForm;
|
---|
| 1401 | begin
|
---|
| 1402 | if Document <> nil then
|
---|
| 1403 | begin
|
---|
| 1404 | bCanGrabFocus := CanGrabFocus;
|
---|
| 1405 | CanGrabFocus := True;
|
---|
| 1406 | with (Application as IOleObject) do
|
---|
| 1407 | begin
|
---|
| 1408 | if DoVerb(OLEIVERB_UIACTIVATE, nil, Self, 0, Handle, GetClientRect) = S_OK then
|
---|
| 1409 | begin
|
---|
| 1410 | ParentForm := GetParentForm(Self);
|
---|
| 1411 | if Assigned(ParentForm) and Self.CanFocus then
|
---|
| 1412 | ParentForm.ActiveControl := Self;
|
---|
| 1413 | end;
|
---|
| 1414 | end;
|
---|
| 1415 | CanGrabFocus := bCanGrabFocus;
|
---|
| 1416 | end;
|
---|
| 1417 | end;
|
---|
| 1418 |
|
---|
| 1419 | procedure TCustomEmbeddedWB.SetFocusToParent;
|
---|
| 1420 | begin
|
---|
| 1421 | {if IsWindow(WindowHandle) then
|
---|
| 1422 | begin
|
---|
| 1423 | Windows.SetParent(WindowHandle, Parent.Handle);
|
---|
| 1424 | MoveWindow(WindowHandle, 0, 0, Parent.Width, Parent.Height, True);
|
---|
| 1425 | Parent.SetFocus;
|
---|
| 1426 | end;}
|
---|
| 1427 | if IsWindow(WindowHandle) then
|
---|
| 1428 | begin
|
---|
| 1429 | Windows.SetParent(WindowHandle, TWinControl(Self).Parent.Handle);
|
---|
| 1430 | MoveWindow(WindowHandle, 0, 0, TWinControl(Self).Parent.Width,
|
---|
| 1431 | TWinControl(Self).Parent.Height, True);
|
---|
| 1432 | TWinControl(Self).Parent.SetFocus;
|
---|
| 1433 | end;
|
---|
| 1434 | end;
|
---|
| 1435 |
|
---|
| 1436 | procedure TCustomEmbeddedWB.SetUserInterfaceOptions(const Value: TUserInterfaceOptions);
|
---|
| 1437 | begin
|
---|
| 1438 | FUserInterfaceOptions := Value;
|
---|
| 1439 | UpdateUserInterfaceValues;
|
---|
| 1440 | with (Application as IOleControl) do
|
---|
| 1441 | begin
|
---|
| 1442 | OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
|
---|
| 1443 | _Release;
|
---|
| 1444 | end;
|
---|
| 1445 | end;
|
---|
| 1446 |
|
---|
| 1447 | procedure TCustomEmbeddedWB.SetDropHandlingType(const Value: TDragDropHandlingType);
|
---|
| 1448 | var
|
---|
| 1449 | innerWnd: LongWord;
|
---|
| 1450 | Impl: IDropTarget;
|
---|
| 1451 | begin
|
---|
| 1452 | if FDropHandlingType <> Value then
|
---|
| 1453 | begin
|
---|
| 1454 | FDropHandlingType := Value;
|
---|
| 1455 |
|
---|
| 1456 | if HandleAllocated then
|
---|
| 1457 | innerWnd := GetIEWin('Internet Explorer_Server')
|
---|
| 1458 | else
|
---|
| 1459 | innerWnd := 0;
|
---|
| 1460 | if innerWnd <> 0 then
|
---|
| 1461 | RevokeDragDrop(innerWnd);
|
---|
| 1462 |
|
---|
| 1463 | Impl := nil;
|
---|
| 1464 | case Value of
|
---|
| 1465 | ddtMS:
|
---|
| 1466 | DefaultInterface.RegisterAsDropTarget := True;
|
---|
| 1467 | ddtMy: Impl := Self;
|
---|
| 1468 | ddtCustom:
|
---|
| 1469 | if innerWnd <> 0 then
|
---|
| 1470 | begin
|
---|
| 1471 | Impl := Self;
|
---|
| 1472 | if Assigned(FOnGetDropTarget) then
|
---|
| 1473 | FOnGetDropTarget(Self, Impl);
|
---|
| 1474 | end;
|
---|
| 1475 | ddtNo:
|
---|
| 1476 | DefaultInterface.RegisterAsDropTarget := False;
|
---|
| 1477 | end;
|
---|
| 1478 | if (innerWnd <> 0) and (Impl <> nil) then
|
---|
| 1479 | RegisterDragDrop(innerWnd, Impl);
|
---|
| 1480 | end;
|
---|
| 1481 | end;
|
---|
| 1482 |
|
---|
| 1483 | function TCustomEmbeddedWB.GetDropTarget(const pDropTarget: IDropTarget;
|
---|
| 1484 | out ppDropTarget: IDropTarget): HRESULT;
|
---|
| 1485 | begin
|
---|
| 1486 | Result := S_OK;
|
---|
| 1487 | case DropHandlingType of
|
---|
| 1488 | ddtMS:
|
---|
| 1489 | begin
|
---|
| 1490 | DefaultInterface.RegisterAsDropTarget := True;
|
---|
| 1491 | Result := E_NOTIMPL;
|
---|
| 1492 | end;
|
---|
| 1493 | ddtMy:
|
---|
| 1494 | ppDropTarget := Self;
|
---|
| 1495 | ddtCustom:
|
---|
| 1496 | begin
|
---|
| 1497 | ppDropTarget := Self;
|
---|
| 1498 | if Assigned(FOnGetDropTarget) then
|
---|
| 1499 | FOnGetDropTarget(Self, ppDropTarget);
|
---|
| 1500 | end;
|
---|
| 1501 | ddtNo:
|
---|
| 1502 | begin
|
---|
| 1503 | DefaultInterface.RegisterAsDropTarget := False;
|
---|
| 1504 | ppDropTarget := nil;
|
---|
| 1505 | end;
|
---|
| 1506 | end;
|
---|
| 1507 | end;
|
---|
| 1508 |
|
---|
| 1509 | function TCustomEmbeddedWB.DragEnter(const dataObj: IDataObject; grfKeyState: Integer;
|
---|
| 1510 | pt: TPoint; var dwEffect: Integer): HRESULT;
|
---|
| 1511 | begin
|
---|
| 1512 | Result := NOERROR;
|
---|
| 1513 | dwEffect := DROPEFFECT_NONE;
|
---|
| 1514 | if Assigned(OnDragEnter) then
|
---|
| 1515 | OnDragEnter(Self, dataObj, grfKeyState, pt, dwEffect, Result);
|
---|
| 1516 | end;
|
---|
| 1517 |
|
---|
| 1518 | function TCustomEmbeddedWB.DragLeave: HRESULT;
|
---|
| 1519 | begin
|
---|
| 1520 | Result := NOERROR;
|
---|
| 1521 | if Assigned(OnDragLeave) then
|
---|
| 1522 | OnDragLeave(Self);
|
---|
| 1523 | end;
|
---|
| 1524 |
|
---|
| 1525 | function TCustomEmbeddedWB.Drop(const dataObj: IDataObject; grfKeyState: Integer;
|
---|
| 1526 | pt: TPoint; var dwEffect: Integer): HRESULT;
|
---|
| 1527 | begin
|
---|
| 1528 | Result := NOERROR;
|
---|
| 1529 | dwEffect := DROPEFFECT_NONE;
|
---|
| 1530 | if Assigned(FOnDropEvent) then
|
---|
| 1531 | FOnDropEvent(Self, dataObj, grfKeyState, pt, dwEffect, Result);
|
---|
| 1532 | end;
|
---|
| 1533 |
|
---|
| 1534 | function TCustomEmbeddedWB.DropTargetDragOver(grfKeyState: Integer; pt: TPoint;
|
---|
| 1535 | var dwEffect: Integer): HRESULT;
|
---|
| 1536 | begin
|
---|
| 1537 | Result := NOERROR;
|
---|
| 1538 | dwEffect := DROPEFFECT_NONE;
|
---|
| 1539 | if Assigned(FOnDragOverEvent) then
|
---|
| 1540 | FOnDragOverEvent(Self, grfKeyState, pt, dwEffect, Result);
|
---|
| 1541 | end;
|
---|
| 1542 |
|
---|
| 1543 | function TCustomEmbeddedWB.Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb,
|
---|
| 1544 | grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders, pszRedir: PWidechar;
|
---|
| 1545 | uiCP: UINT): HRESULT;
|
---|
| 1546 | begin
|
---|
| 1547 | Result := E_NOTIMPL;
|
---|
| 1548 | if Assigned(FOnDownload) then
|
---|
| 1549 | FOnDownload(Self, pmk, pbc, dwBindVerb, grfBINDF, pBindInfo, pszHeaders,
|
---|
| 1550 | pszRedir, uiCP, Result);
|
---|
| 1551 | end;
|
---|
| 1552 |
|
---|
| 1553 | function TCustomEmbeddedWB.FilterPopupMenu: Boolean;
|
---|
| 1554 | begin
|
---|
| 1555 | Result := Assigned(OnFilterPopupMenu);
|
---|
| 1556 | end;
|
---|
| 1557 |
|
---|
| 1558 | procedure TCustomEmbeddedWB.DoFilterPopupMenu(Sender: TObject; ID: DWORD; Menu: HMENU; const Context:
|
---|
| 1559 | IDispatch);
|
---|
| 1560 | begin
|
---|
| 1561 | if Assigned(OnFilterPopupMenu) then
|
---|
| 1562 | OnFilterPopupMenu(Sender, ID, Menu, Context);
|
---|
| 1563 | end;
|
---|
| 1564 |
|
---|
| 1565 | function TCustomEmbeddedWB.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
|
---|
| 1566 | const CommandTarget: IUnknown; const Context: IDispatch): HRESULT;
|
---|
| 1567 | var
|
---|
| 1568 | EncodingSubMenu: OleVariant;
|
---|
| 1569 | begin
|
---|
| 1570 | Result := E_NOTIMPL;
|
---|
| 1571 | if Assigned(FOnShowContextMenu) then
|
---|
| 1572 | FOnShowContextMenu(Self, dwID, ppt, CommandTarget, Context, Result);
|
---|
| 1573 |
|
---|
| 1574 | if Result = E_NOTIMPL then
|
---|
| 1575 | begin
|
---|
| 1576 | if IsSeTIEPopupMenus(dwID, DisabledPopupMenus) then
|
---|
| 1577 | begin
|
---|
| 1578 | Result := S_OK;
|
---|
| 1579 | if Assigned(PopUpMenu) then // Show assigned TPopupMenu
|
---|
| 1580 | PopUpMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
|
---|
| 1581 | end else
|
---|
| 1582 | if FilterPopupMenu then
|
---|
| 1583 | begin
|
---|
| 1584 | ExecWB(CGetMimeSubMenuCommandID, OLECMDEXECOPT_DODEFAULT, EncodingSubMenu);
|
---|
| 1585 | if ShowRightClickMenu(Self, dwID, CommandTarget, Context, ppt, EncodingSubMenu,
|
---|
| 1586 | DoFilterPopupMenu) then
|
---|
| 1587 | Result := S_OK
|
---|
| 1588 | else
|
---|
| 1589 | Result := S_FALSE;
|
---|
| 1590 | end
|
---|
| 1591 | else
|
---|
| 1592 | Result := S_FALSE;
|
---|
| 1593 | end;
|
---|
| 1594 | end;
|
---|
| 1595 |
|
---|
| 1596 | function TCustomEmbeddedWB.ShowHelp(HWND: THandle; pszHelpFile: POleStr; uCommand,
|
---|
| 1597 | dwData: Integer; ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HRESULT;
|
---|
| 1598 | begin
|
---|
| 1599 | if Assigned(FOnShowHelp) then
|
---|
| 1600 | Result := FOnShowHelp(Self, HWND, pszHelpFile, uCommand, dwData, ptMouse, pDispatchObjectHit)
|
---|
| 1601 | else
|
---|
| 1602 | if (pszHelpFile = nil) and (HelpFile <> '') then
|
---|
| 1603 | begin
|
---|
| 1604 | HtmlHelp(HWND, PChar(HelpFile), uCommand, dwData);
|
---|
| 1605 | Result := S_OK;
|
---|
| 1606 | end
|
---|
| 1607 | else
|
---|
| 1608 | Result := S_FALSE;
|
---|
| 1609 | end;
|
---|
| 1610 |
|
---|
| 1611 | function TCustomEmbeddedWB.ShowMessage(HWND: THandle; lpstrText, lpstrCaption: POleStr;
|
---|
| 1612 | dwType: Integer; lpstrHelpFile: POleStr; dwHelpContext: Integer;
|
---|
| 1613 | var plResult: LRESULT): HRESULT;
|
---|
| 1614 | begin
|
---|
| 1615 | if Assigned(FOnShowMessage) then
|
---|
| 1616 | Result := FOnShowMessage(Self, HWND, lpstrText, lpStrCaption, dwType, lpStrHelpFile, dwHelpContext, plResult)
|
---|
| 1617 | else
|
---|
| 1618 | Result := S_FALSE;
|
---|
| 1619 | end;
|
---|
| 1620 |
|
---|
| 1621 | function TCustomEmbeddedWB.ShowUI(const dwID: DWORD;
|
---|
| 1622 | const pActiveObject: IOleInPlaceActiveObject;
|
---|
| 1623 | const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
|
---|
| 1624 | const pDoc: IOleInPlaceUIWindow): HRESULT;
|
---|
| 1625 | begin
|
---|
| 1626 | Result := S_FALSE;
|
---|
| 1627 | if Assigned(FOnShowUI) then
|
---|
| 1628 | FOnShowUI(Self, dwID, pActiveObject, pCommandTarget, pFrame, pDoc, Result);
|
---|
| 1629 | end;
|
---|
| 1630 |
|
---|
| 1631 | function TCustomEmbeddedWB.DoFilterMsg(const lpMsg: PMSG): Boolean;
|
---|
| 1632 | type
|
---|
| 1633 | PWMKey = ^TWMKey;
|
---|
| 1634 | var
|
---|
| 1635 | ShiftState: TShiftState;
|
---|
| 1636 | begin
|
---|
| 1637 | {
|
---|
| 1638 | Result := (FDisableCtrlShortcuts <> '') and (lpMsg^.message = WM_KEYDOWN)
|
---|
| 1639 | and (((GetKeyState(VK_LCONTROL) < 0) and (GetKeyState(VK_MENU) >= 0)) or
|
---|
| 1640 | ((GetKeyState(VK_RCONTROL) < 0) and (GetKeyState(VK_LMENU) >= 0)))
|
---|
| 1641 | and (_CharPos(Char(lpMsg.wParam), FDisableCtrlShortcuts) > 0); }
|
---|
| 1642 |
|
---|
| 1643 | ShiftState := KeyDataToShiftState(PWMKey(lpMsg)^.KeyData);
|
---|
| 1644 | Result := (FDisableCtrlShortcuts <> '') and (lpMsg^.message = WM_KEYDOWN)
|
---|
| 1645 | and ((ShiftState = [ssCtrl]) and (ShiftState <> [ssAlt]))
|
---|
| 1646 | and (_CharPos(Char(lpMsg.wParam), FDisableCtrlShortcuts) > 0);
|
---|
| 1647 |
|
---|
| 1648 | if Result and Assigned(OnMaskedCtrlChar) then
|
---|
| 1649 | OnMaskedCtrlChar(Self, Char(lpMsg.wParam));
|
---|
| 1650 | end;
|
---|
| 1651 |
|
---|
| 1652 | function TCustomEmbeddedWB.TranslateAccelerator(const lpMsg: PMSG;
|
---|
| 1653 | const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT;
|
---|
| 1654 | { Called by MSHTML when IOleInPlaceActiveObject.TranslateAccelerator or
|
---|
| 1655 | IOleControlSite.TranslateAccelerator is called }
|
---|
| 1656 | var
|
---|
| 1657 | Filtered: Boolean;
|
---|
| 1658 | begin
|
---|
| 1659 | Filtered := DoFilterMsg(lpMsg);
|
---|
| 1660 | if (not Filtered) and Assigned(FOnTranslateAccelerator) then
|
---|
| 1661 | FOnTranslateAccelerator(Self, lpMsg, pguidCmdGroup, nCmdID, Filtered);
|
---|
| 1662 |
|
---|
| 1663 | if Filtered then
|
---|
| 1664 | Result := S_OK
|
---|
| 1665 | else
|
---|
| 1666 | Result := S_FALSE;
|
---|
| 1667 | end;
|
---|
| 1668 |
|
---|
| 1669 |
|
---|
| 1670 | function TCustomEmbeddedWB.TranslateUrl(const dwTranslate: DWORD; const pchURLIn:
|
---|
| 1671 | POleStr; out ppchURLOut: POleStr): HRESULT;
|
---|
| 1672 | var
|
---|
| 1673 | URLOut: WideString;
|
---|
| 1674 | begin
|
---|
| 1675 | URLOut := '';
|
---|
| 1676 | if Assigned(FOnTranslateUrl) then
|
---|
| 1677 | FOnTranslateUrl(Self, pchUrlIn, URLOut);
|
---|
| 1678 | if URLOut <> '' then
|
---|
| 1679 | begin
|
---|
| 1680 | Result := S_OK;
|
---|
| 1681 | ppchURLOut := WideStringToLPOLESTR(URLOut);
|
---|
| 1682 | end
|
---|
| 1683 | else
|
---|
| 1684 | Result := S_FALSE;
|
---|
| 1685 | end;
|
---|
| 1686 |
|
---|
| 1687 | function TCustomEmbeddedWB.UpdateUI: HRESULT;
|
---|
| 1688 | begin
|
---|
| 1689 | Result := S_FALSE;
|
---|
| 1690 | if Assigned(FOnUpdateUI) then
|
---|
| 1691 | FOnUpdateUI(Self, Result);
|
---|
| 1692 | end;
|
---|
| 1693 |
|
---|
| 1694 | procedure TCustomEmbeddedWB.UpdateUserInterfaceValues;
|
---|
| 1695 | const
|
---|
| 1696 | acardUserInterfaceValues: array[TUserInterfaceOption] of Cardinal =
|
---|
| 1697 | ($00000001, $00000002, $00000004, $00000008,
|
---|
| 1698 | $00000010, $00000020, $00000040, $00000080,
|
---|
| 1699 | $00000100, $00000200, $00000400, $00000800,
|
---|
| 1700 | $00001000, $00002000, $00004000, $00010000, $00020000,
|
---|
| 1701 | $00040000, $00080000, $00100000, $00200000, $00400000,
|
---|
| 1702 | $00800000, $01000000, $02000000, $04000000, $08000000,
|
---|
| 1703 | $10000000, $20000000);
|
---|
| 1704 | var
|
---|
| 1705 | uio: TUserInterfaceOption;
|
---|
| 1706 | begin
|
---|
| 1707 | FUserInterfaceValue := 0;
|
---|
| 1708 | if (FUserInterfaceOptions <> []) then
|
---|
| 1709 | for uio := Low(TUserInterfaceOption) to High(TUserInterfaceOption) do
|
---|
| 1710 | if (uio in FUserInterfaceOptions) then
|
---|
| 1711 | Inc(FUserInterfaceValue, acardUserInterfaceValues[uio]);
|
---|
| 1712 | end;
|
---|
| 1713 |
|
---|
| 1714 |
|
---|
| 1715 | procedure TCustomEmbeddedWB.UpdateDownloadControlValues;
|
---|
| 1716 | const
|
---|
| 1717 | acardDownloadControlValues: array[TDownloadControlOption] of Cardinal =
|
---|
| 1718 | ($00000010, $00000020, $00000040, $00000080,
|
---|
| 1719 | $00000100, $00000200, $00000400, $00000800,
|
---|
| 1720 | $00001000, $00002000, $00004000, $00008000,
|
---|
| 1721 | $00010000, $00020000, $00040000, $10000000,
|
---|
| 1722 | $20000000, $40000000, $80000000);
|
---|
| 1723 | var
|
---|
| 1724 | dco: TDownloadControlOption;
|
---|
| 1725 | begin
|
---|
| 1726 | FDownloadOptionValue := 0;
|
---|
| 1727 | if (FDownloadControlOptions <> []) then
|
---|
| 1728 | for dco := Low(TDownloadControlOption) to High(TDownloadControlOption) do
|
---|
| 1729 | if (dco in FDownloadControlOptions) then
|
---|
| 1730 | Inc(FDownloadOptionValue, acardDownloadControlValues[dco]);
|
---|
| 1731 | end;
|
---|
| 1732 |
|
---|
| 1733 | function TCustomEmbeddedWB.ZoomRangeHigh: Integer;
|
---|
| 1734 | var
|
---|
| 1735 | vaIn, vaOut: OleVariant;
|
---|
| 1736 | begin
|
---|
| 1737 | InvokeCommand(nil, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
|
---|
| 1738 | Result := HiWord(DWORD(vaOut));
|
---|
| 1739 | end;
|
---|
| 1740 |
|
---|
| 1741 | function TCustomEmbeddedWB.ZoomRangeLow: Integer;
|
---|
| 1742 | var
|
---|
| 1743 | vaIn, vaOut: OleVariant;
|
---|
| 1744 | begin
|
---|
| 1745 | InvokeCommand(nil, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
|
---|
| 1746 | Result := LoWord(DWORD(vaOut));
|
---|
| 1747 | end;
|
---|
| 1748 |
|
---|
| 1749 | function TCustomEmbeddedWB._getCookie: WideString;
|
---|
| 1750 | var
|
---|
| 1751 | D: IHTMLDocument2;
|
---|
| 1752 | begin
|
---|
| 1753 | if Supports(Document, IHTMLDocument2, D) then
|
---|
| 1754 | Result := OleObject.Document.Cookie
|
---|
| 1755 | else
|
---|
| 1756 | Result := '';
|
---|
| 1757 | end;
|
---|
| 1758 |
|
---|
| 1759 | procedure TCustomEmbeddedWB.Client2HostWin(var CX, CY: Integer);
|
---|
| 1760 | var
|
---|
| 1761 | F: TCustomForm;
|
---|
| 1762 | begin
|
---|
| 1763 | F := GetParentForm(Self);
|
---|
| 1764 | if F <> nil then
|
---|
| 1765 | begin
|
---|
| 1766 | Inc(CX, F.ClientWidth - Self.Width);
|
---|
| 1767 | Inc(CY, F.ClientHeight - Self.Height);
|
---|
| 1768 | end;
|
---|
| 1769 | end;
|
---|
| 1770 |
|
---|
| 1771 | {$IFDEF USE_IOLECOMMANDTARGET}
|
---|
| 1772 | //======IOleCommandTarget interface ============================================
|
---|
| 1773 |
|
---|
| 1774 | function TCustomEmbeddedWB.CommandTarget_QueryStatus(CmdGroup: PGUID; cCmds: Cardinal;
|
---|
| 1775 | prgCmds: POleCmd; CmdText: POleCmdText): HRESULT;
|
---|
| 1776 | begin
|
---|
| 1777 | Result := S_OK;
|
---|
| 1778 | end;
|
---|
| 1779 |
|
---|
| 1780 | function TCustomEmbeddedWB.CommandTarget_Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
|
---|
| 1781 | const vaIn: OleVariant; var vaOut: OleVariant): HRESULT;
|
---|
| 1782 | var
|
---|
| 1783 | tmpCancel: Boolean;
|
---|
| 1784 | const
|
---|
| 1785 | {$J+}
|
---|
| 1786 | LastTickEvent: Cardinal = 0;
|
---|
| 1787 | {$J-}
|
---|
| 1788 | begin
|
---|
| 1789 | Result := OLECMDERR_E_NOTSUPPORTED;
|
---|
| 1790 | if CmdGroup <> nil then
|
---|
| 1791 | begin
|
---|
| 1792 | if IsEqualGuid(cmdGroup^, CGID_EXPLORER) then
|
---|
| 1793 | begin
|
---|
| 1794 | case nCmdID of
|
---|
| 1795 | OLECMDID_ONUNLOAD:
|
---|
| 1796 | if Assigned(FOnUnload) then
|
---|
| 1797 | begin
|
---|
| 1798 | FOnUnload(Self);
|
---|
| 1799 | Result := S_OK;
|
---|
| 1800 | Exit;
|
---|
| 1801 | end;
|
---|
| 1802 |
|
---|
| 1803 | OLECMDID_PREREFRESH:
|
---|
| 1804 | begin
|
---|
| 1805 | if Assigned(FOnPreRefresh) then
|
---|
| 1806 | begin
|
---|
| 1807 | if GetTickCount - LastTickEvent > 150 then
|
---|
| 1808 | begin
|
---|
| 1809 | LastTickEvent := GetTickCount;
|
---|
| 1810 | FOnPreRefresh(Self);
|
---|
| 1811 | end;
|
---|
| 1812 | end;
|
---|
| 1813 |
|
---|
| 1814 | if Assigned(FOnHookChildWindow) then
|
---|
| 1815 | if (GetIEWin('Internet Explorer_Server') <> 0) or (GetIEWin('SysListView32') <> 0) then
|
---|
| 1816 | FOnHookChildWindow(Self);
|
---|
| 1817 | end;
|
---|
| 1818 | end
|
---|
| 1819 | end else
|
---|
| 1820 | if IsEqualGuid(cmdGroup^, CGID_DocHostCommandHandler) then
|
---|
| 1821 | begin
|
---|
| 1822 | case nCmdID of
|
---|
| 1823 | ID_IE_F5_REFRESH {nCmdID 6041, F5},
|
---|
| 1824 | ID_IE_CONTEXTMENU_REFRESH {nCmdID 6042, Refresh by ContextMenu},
|
---|
| 1825 | IDM_REFRESH {nCmdID 2300}:
|
---|
| 1826 | begin
|
---|
| 1827 | if Assigned(FOnRefresh) then
|
---|
| 1828 | begin
|
---|
| 1829 | tmpCancel := False;
|
---|
| 1830 | FOnRefresh(Self, nCmdID, tmpCancel);
|
---|
| 1831 | if tmpCancel then
|
---|
| 1832 | Result := S_OK; //FIXME is it true? Why not OLECMDERR_E_CANCELED
|
---|
| 1833 | end;
|
---|
| 1834 | Exit;
|
---|
| 1835 | end;
|
---|
| 1836 | OLECMDID_SHOWSCRIPTERROR:
|
---|
| 1837 | begin
|
---|
| 1838 | Result := ScriptErrorHandler(vaIn, vaOut);
|
---|
| 1839 | Exit;
|
---|
| 1840 | end;
|
---|
| 1841 | end;
|
---|
| 1842 | end;
|
---|
| 1843 | end;
|
---|
| 1844 | if Assigned(OnCommandExec) then
|
---|
| 1845 | Self.OnCommandExec(Self, CmdGroup, nCmdID, nCmdexecopt,
|
---|
| 1846 | vaIn, vaOut, Result);
|
---|
| 1847 | end;
|
---|
| 1848 | {$ENDIF}
|
---|
| 1849 |
|
---|
| 1850 | function TCustomEmbeddedWB.ScriptErrorHandler(const vaIn: OleVariant;
|
---|
| 1851 | var vaOut: OleVariant): HRESULT;
|
---|
| 1852 | var
|
---|
| 1853 | EventObject: IHTMLEventObj;
|
---|
| 1854 | CurWindow: IHTMLWindow2;
|
---|
| 1855 | CurDocument: IHTMLDocument2;
|
---|
| 1856 | CurUnknown: IUnknown;
|
---|
| 1857 |
|
---|
| 1858 | function GetProperty(const PropName: WideString): OleVariant;
|
---|
| 1859 | var
|
---|
| 1860 | DispParams: TDispParams;
|
---|
| 1861 | Disp, Status: Integer;
|
---|
| 1862 | ExcepInfo: TExcepInfo;
|
---|
| 1863 | PPropName: PWideChar;
|
---|
| 1864 | begin
|
---|
| 1865 | DispParams.rgvarg := nil;
|
---|
| 1866 | DispParams.rgdispidNamedArgs := nil;
|
---|
| 1867 | DispParams.cArgs := 0;
|
---|
| 1868 | DispParams.cNamedArgs := 0;
|
---|
| 1869 | PPropName := PWideChar(PropName);
|
---|
| 1870 | Status := EventObject.GetIDsOfNames(GUID_NULL, @PPropName, 1, LOCALE_SYSTEM_DEFAULT, @Disp);
|
---|
| 1871 | if Status = 0 then
|
---|
| 1872 | begin
|
---|
| 1873 | Status := EventObject.Invoke(disp, GUID_NULL, LOCALE_SYSTEM_DEFAULT,
|
---|
| 1874 | DISPATCH_PROPERTYGET, DispParams, @Result, @ExcepInfo, nil);
|
---|
| 1875 | if Status <> 0 then
|
---|
| 1876 | DispatchInvokeError(Status, ExcepInfo);
|
---|
| 1877 | end
|
---|
| 1878 | else
|
---|
| 1879 | if Status = DISP_E_UNKNOWNNAME then
|
---|
| 1880 | raise
|
---|
| 1881 | EOleError.CreateFmt('''%s'' is not supported.', [PropName])
|
---|
| 1882 | else
|
---|
| 1883 | OleCheck(Status);
|
---|
| 1884 | end;
|
---|
| 1885 | begin
|
---|
| 1886 | Result := S_OK;
|
---|
| 1887 | case FScriptErrorAction of
|
---|
| 1888 | eaAskUser: Result := S_FALSE; //E_FAIL;
|
---|
| 1889 | eaContinue: vaOut := True;
|
---|
| 1890 | eaCancel: vaOut := False;
|
---|
| 1891 | end;
|
---|
| 1892 |
|
---|
| 1893 | if Assigned(FOnScriptError) then
|
---|
| 1894 | begin
|
---|
| 1895 | CurUnknown := IUnknown(TVarData(vaIn).VUnknown);
|
---|
| 1896 | if Succeeded(CurUnknown.QueryInterface(IID_IHTMLDocument2, CurDocument)) then
|
---|
| 1897 | begin
|
---|
| 1898 | CurWindow := CurDocument.Get_parentWindow;
|
---|
| 1899 | CurDocument := nil;
|
---|
| 1900 | if Assigned(CurWindow) then
|
---|
| 1901 | begin
|
---|
| 1902 | EventObject := CurWindow.Get_event;
|
---|
| 1903 | if EventObject <> nil then
|
---|
| 1904 | begin
|
---|
| 1905 | FOnScriptError(Self,
|
---|
| 1906 | GetProperty('errorline'),
|
---|
| 1907 | GetProperty('errorCharacter'),
|
---|
| 1908 | GetProperty('errorCode'),
|
---|
| 1909 | GetProperty('errorMessage'),
|
---|
| 1910 | GetProperty('errorUrl'),
|
---|
| 1911 | FScriptErrorAction);
|
---|
| 1912 | end;
|
---|
| 1913 | end;
|
---|
| 1914 | end;
|
---|
| 1915 | end;
|
---|
| 1916 | end;
|
---|
| 1917 |
|
---|
| 1918 | function TCustomEmbeddedWB.PopulateNamespaceTable: HRESULT;
|
---|
| 1919 | begin
|
---|
| 1920 | Result := S_OK;
|
---|
| 1921 | if Assigned(fOnPopulateNSTable) then
|
---|
| 1922 | FOnPopulateNSTable(Self);
|
---|
| 1923 | end;
|
---|
| 1924 |
|
---|
| 1925 | function TCustomEmbeddedWB.GetElementNamespaceTable(
|
---|
| 1926 | out aTable: IElementNamespaceTable): Boolean;
|
---|
| 1927 | var
|
---|
| 1928 | SP: IServiceProvider;
|
---|
| 1929 | begin
|
---|
| 1930 | Result := Supports(Self.Document, IServiceProvider, SP) and
|
---|
| 1931 | (SP.QueryService(IID_IElementNamespaceTable, IID_IElementNamespaceTable,
|
---|
| 1932 | aTable) = S_OK);
|
---|
| 1933 | end;
|
---|
| 1934 |
|
---|
| 1935 | function WideStringToLPOLESTR(const Src: WideString): POLEStr;
|
---|
| 1936 | begin
|
---|
| 1937 | Result := CoTaskMemAlloc((Length(Src) + 1) * SizeOf(WideChar));
|
---|
| 1938 | if Result <> nil then
|
---|
| 1939 | Move(PWideChar(Src)^, Result^, (Length(Src) + 1) * SizeOf(WideChar));
|
---|
| 1940 | end;
|
---|
| 1941 |
|
---|
| 1942 | function TCustomEmbeddedWB.Authenticate(var hwnd: HWnd; var szUserName,
|
---|
| 1943 | szPassWord: LPWSTR): HRESULT;
|
---|
| 1944 | var
|
---|
| 1945 | aUser, aPwd: WideString;
|
---|
| 1946 | begin
|
---|
| 1947 | Result := S_OK;
|
---|
| 1948 | hwnd := Self.Handle;
|
---|
| 1949 | aUser := '';
|
---|
| 1950 | aPwd := '';
|
---|
| 1951 | if Assigned(OnAuthenticate) then
|
---|
| 1952 | OnAuthenticate(Self, hwnd, aUser, aPwd, Result);
|
---|
| 1953 | if aUser <> '' then
|
---|
| 1954 | szUserName := WideStringToLPOLESTR(aUser)
|
---|
| 1955 | else
|
---|
| 1956 | szUserName := nil;
|
---|
| 1957 | if aPwd <> '' then
|
---|
| 1958 | szPassWord := WideStringToLPOLESTR(aPwd)
|
---|
| 1959 | else
|
---|
| 1960 | szPassWord := nil;
|
---|
| 1961 | end;
|
---|
| 1962 |
|
---|
| 1963 | { TEwbCore }
|
---|
| 1964 |
|
---|
| 1965 | function TEwbCore.IsCtrlCharMask: Boolean;
|
---|
| 1966 | begin
|
---|
| 1967 | Result := FDisableCtrlShortcuts <> 'N';
|
---|
| 1968 | end;
|
---|
| 1969 |
|
---|
| 1970 | end.
|
---|