source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/EwbBehaviorsComp.pas@ 1681

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

TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 38.6 KB
Line 
1//*************************************************************
2// EwbBehaviorsComp *
3// *
4// Freeware Component *
5// For Delphi *
6// by *
7// Serge Voloshenyuk *
8// Developing Team: *
9// Serge Voloshenyuk (SergeV@bsalsa.com) *
10// Eran Bodankin (bsalsa) -(bsalsa@gmail.com) *
11// *
12// Documentation and updated versions: *
13// *
14// http://www.bsalsa.com *
15//*************************************************************
16{LICENSE:
17THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
18EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
19WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
20YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
21AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
22AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
23OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
24OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
25INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
26OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
27AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY
28DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.
29
30You may use/ change/ modify the component under 3 conditions:
311. In your website, add a link to "http://www.bsalsa.com"
322. In your application, add credits to "Embedded Web Browser"
333. Mail me (bsalsa@gmail.com) any code change in the unit for the benefit
34 of the other users.
354. Please, consider donation in our web site!
36{*******************************************************************************}
37//$Id: EwbBehaviorsComp.pas,v 1.1.2.1 2006/11/29 22:13:00 sergev Exp $
38
39unit EwbBehaviorsComp;
40
41interface
42
43{$I EWB.inc}
44
45uses
46{$IFDEF DELPHI6_UP}Variants, {$ENDIF}
47 Windows, Classes, Graphics, ActiveX, Mshtml_Ewb, EwbAcc, EwbClasses, EwbEvents,
48 EwbEventsComp;
49
50type
51 TEwbBehaviorFactory = class;
52 TBinBehavior = class;
53 TEwbBehaviorController = class;
54
55 TPainterProperty = (
56 ppOpaque,
57 ppTransparent,
58 //NOIMPL ppAlpha,
59 //NOIMPL ppComplex,
60 ppOverlay,
61 ppHitTest,
62 ppSurface,
63 pp3DSurface,
64 //NOIMPL ppNoBand,
65 ppNoDC,
66 ppNoPhysicalClip,
67 ppNoSaveDC,
68 ppSupportsXForm,
69 ppExpand,
70 ppNoScrollBits
71 );
72 TPainterProperties = set of TPainterProperty;
73
74 TPaintZOrder = (
75 pzNone,
76 pzReplaceAll,
77 pzReplaceContent,
78 pzReplaceBackground,
79 pzBelowContent,
80 pzBelowFlow,
81 pzAboveFlow,
82 pzAboveContent,
83 pzWinTop
84 );
85
86 TPaintEventFlag = (pfTarget, pfSetCursor);
87 TPaintEventFlags = set of TPaintEventFlag;
88
89 TLayoutMode = (
90 lmNone,
91 lmFullDelegation,
92 lmModifyNatural,
93 lmMapSize
94 );
95
96 {events}
97 TBehaviorNameEvent = procedure(Sender: TEwbBehaviorController;
98 Element: IHTMLElement2; var aName: WideString) of object;
99 TCreateBehaviorEvent = function(Sender: TEwbBehaviorController;
100 const bstrBehavior, bstrBehaviorUrl: WideString;
101 pSite: IElementBehaviorSite): IElementBehavior of object;
102
103 TGetIdOfNameEvent = procedure(Sender: TBinBehavior; const name: widestring; var id: Integer) of object;
104 TInvokeEvent = procedure(Sender: TBinBehavior; DispID: Integer;
105 VarResult: POleVariant; Params: TDispParams; var Rezult: HRESULT) of object;
106 TGetPropertyEvent = procedure(Sender: TBinBehavior; DispID: Integer;
107 VarResult: POleVariant; Params: TDispParams; var Rezult: HRESULT) of object;
108 TPutPropertyEvent = procedure(Sender: TBinBehavior; DispID: Integer;
109 Params: TDispParams; var Rezult: HRESULT) of object;
110
111
112 TBehaviorNotifyEvent = procedure(Sender: TBinBehavior) of object;
113 TPainterDrawEvent = procedure(Sender: TBinBehavior;
114 rcBounds, rcUpdate: TRect; lDrawFlags: Integer; Canvas: TCanvas) of object;
115 TPainterDirectDrawEvent = procedure(Sender: TBinBehavior;
116 rcBounds, rcUpdate: TRect; lDrawFlags: Integer; DrawObject: Pointer) of
117 object;
118 TPainterResizeEvent = procedure(Sender: TBinBehavior; size: TSize) of object;
119 TPainterInfoEvent = procedure(Sender: TBinBehavior; var pInfo:
120 _HTML_PAINTER_INFO) of object;
121 TPainterHitTestEvent = procedure(Sender: TBinBehavior; pt: TPoint; var pbHit:
122 BOOL;
123 var plPartID: Longint) of object;
124
125 TLayoutSizeEvent = procedure(Sender: TBinBehavior; dwFlags: Integer;
126 sizeContent: TSize; var pptTranslateBy: TPoint;
127 var pptTopLeft: TPoint; var psizeProposed: TSize) of object;
128 TLayoutPositionEvent = procedure(Sender: TBinBehavior; lFlags: Integer; var
129 pptTopLeft: TPoint) of object;
130 TLayoutMapSizeEvent = procedure(Sender: TBinBehavior; psizeIn: PSize; var
131 prcOut: TRect) of object;
132 TLayoutTextDescentEvent = procedure(Sender: TBinBehavior; var plDescent:
133 Integer) of object;
134
135 TEventTargetEvent = procedure(Sender: TBinBehavior; var ppElement:
136 IHTMLElement) of object;
137 TSetCursorEvent = procedure(Sender: TBinBehavior; lPartID: Integer) of object;
138 TStringFromPartIDEvent = procedure(Sender: TBinBehavior; lPartID: Integer; var
139 pbstrPart: WideString) of object;
140 TOverlayMoveEvent = procedure(Sender: TBinBehavior; rcDevice: TRect) of
141 object;
142 TGetFocusRectEvent = procedure(Sender: TBinBehavior; var pRect: TRect) of
143 object;
144 TGetSubmitInfoEvent = procedure(Sender: TBinBehavior; pSubmitData:
145 IHTMLSubmitData) of object;
146 TResetSubmitEvent = procedure(Sender: TBinBehavior) of object;
147
148 TFindBehaviorEvent = procedure(Sender: TObject;
149 const bstrBehavior, bstrBehaviorUrl: WideString;
150 pSite: IElementBehaviorSite; var ppBehavior: IElementBehavior) of object;
151
152 TResolveNSEvent = procedure(Sender: TObject;
153 const bstrNamespace, bstrTagName, bstrAttrs: WideString;
154 pNamespace: IElementNamespace) of object;
155
156 TCreateNamespaceEvent = procedure(Sender: TObject;
157 pNamespace: IElementNamespace) of object;
158
159 TCreateNSWithImplEvent = procedure(Sender: TObject;
160 pNamespace: IElementNamespace;
161 const bstrImplementation: WideString) of object;
162
163 TEwbBehaviorFactory = class(TComponent
164 , IElementBehaviorFactory
165 , IElementNamespaceFactoryCallback
166 , IElementNamespaceFactory
167 , IElementNamespaceFactory2
168 )
169 private
170 FOnFindBehavior: TFindBehaviorEvent;
171 FOnResolveNS: TResolveNSEvent;
172 FOnCreateNS: TCreateNamespaceEvent;
173 FOnCreateNSWithImpl: TCreateNSWithImplEvent;
174 protected
175 {IElementBehaviorFactory}
176 function FindBehavior(const bstrBehavior: WideString; const bstrBehaviorUrl:
177 WideString;
178 const pSite: IElementBehaviorSite; out ppBehavior: IElementBehavior):
179 HRESULT; stdcall;
180 {IElementNamespaceFactoryCallback}
181 function Resolve(const bstrNamespace: WideString; const bstrTagName:
182 WideString;
183 const bstrAttrs: WideString; pNamespace: IElementNamespace): HRESULT;
184 stdcall;
185 {IElementNamespaceFactory}
186 function IElementNamespaceFactory.create = FactoryCreate;
187 function FactoryCreate(pNamespace: IElementNamespace): HRESULT; stdcall;
188 {IElementNamespaceFactory2}
189 function IElementNamespaceFactory2.create = FactoryCreate;
190 function CreateWithImplementation(pNamespace: IElementNamespace;
191 const bstrImplementation: WideString): HRESULT; stdcall;
192 published
193 property OnFindBehavior: TFindBehaviorEvent read FOnFindBehavior write
194 FOnFindBehavior;
195 property OnResolveNS: TResolveNSEvent read FOnResolveNS write FOnResolveNS;
196 property OnCreateNS: TCreateNamespaceEvent read FOnCreateNS write
197 FOnCreateNS;
198 property OnCreateNSWithImpl: TCreateNSWithImplEvent read FOnCreateNSWithImpl
199 write FOnCreateNSWithImpl;
200 end;
201
202 TEwbBehaviorController = class(THtmlListener, IElementBehaviorFactory)
203 private
204 FBehaviors: TList;
205 FZOrder: TPaintZOrder;
206 FPainterProperties: TPainterProperties;
207 FPainterFlags: Integer;
208 FOnDetach: TBehaviorNotifyEvent;
209 FOnApplyStyle: TBehaviorNotifyEvent;
210 FOnDocContextChange: TBehaviorNotifyEvent;
211 FOnContentReady: TBehaviorNotifyEvent;
212 FOnInit: TBehaviorNotifyEvent;
213 FOnContentSave: TBehaviorNotifyEvent;
214 FOnDocReady: TBehaviorNotifyEvent;
215 FOnDraw: TPainterDrawEvent;
216 FOnHitTest: TPainterHitTestEvent;
217 FOnPainterInfo: TPainterInfoEvent;
218 FOnResize: TPainterResizeEvent;
219 FOnGetName: TBehaviorNameEvent;
220 FOnCreateBehavior: TCreateBehaviorEvent;
221 fHandleEvents: Boolean;
222 FLayoutMode: TLayoutMode;
223 fLayoutMapSize: TLayoutMapSizeEvent;
224 fLayoutPosition: TLayoutPositionEvent;
225 FLayoutSize: TLayoutSizeEvent;
226 FLayoutTextDescent: Integer;
227 FOnLayoutTextDescent: TLayoutTextDescentEvent;
228 fPaintEventInfo: TPaintEventFlags;
229 FOnEventTarget: TEventTargetEvent;
230 FOnSetCursor: TSetCursorEvent;
231 FOnStringFromPartID: TStringFromPartIDEvent;
232 FOnOverlayMove: TOverlayMoveEvent;
233 FOnDirectDraw: TPainterDirectDrawEvent;
234 FOnGetFocusRect: TGetFocusRectEvent;
235 FOnGetSubmitInfo: TGetSubmitInfoEvent;
236 FOnResetSubmit: TResetSubmitEvent;
237 FOnGetIdOfName: TGetIdOfNameEvent;
238 FOnGetProperty: TGetPropertyEvent;
239 FOnInvoke: TInvokeEvent;
240 FOnPutProperty: TPutPropertyEvent;
241 fAlive: Boolean;
242 procedure setPainterProperties(const Value: TPainterProperties);
243 procedure setZOrder(const Value: TPaintZOrder);
244 procedure setLayoutMode(const Value: TLayoutMode);
245 procedure setLayoutTextDescent(const Value: Integer);
246 protected
247 {IElementBehaviorFactory}
248 function FindBehavior(const bstrBehavior: WideString; const bstrBehaviorUrl:
249 WideString;
250 const pSite: IElementBehaviorSite; out ppBehavior: IElementBehavior):
251 HRESULT; stdcall;
252
253 protected
254 procedure Add(aBehavior: TBinBehavior);
255 procedure Remove(aBehavior: TBinBehavior);
256
257 procedure DoGetIdOfName(Sender: TBinBehavior; const name: widestring; var id: Integer); virtual;
258 procedure DoInvoke(Sender: TBinBehavior; DispID: Integer;
259 VarResult: POleVariant; Params: TDispParams; var Rezult: HRESULT); virtual;
260 procedure DoGetProperty(Sender: TBinBehavior; DispID: Integer;
261 VarResult: POleVariant; Params: TDispParams; var Rezult: HRESULT); virtual;
262 procedure DoPutProperty(Sender: TBinBehavior; DispID: Integer;
263 Params: TDispParams; var Rezult: HRESULT); virtual;
264
265 procedure DoInit(Sender: TBinBehavior); virtual;
266 procedure DoDetach(Sender: TBinBehavior); virtual;
267 procedure DoNotify(Sender: TBinBehavior; lEvent: Integer); virtual;
268 procedure DoDraw(Sender: TBinBehavior;
269 rcBounds, rcUpdate: TRect; lDrawFlags: Integer; Canvas: TCanvas); virtual;
270 procedure DoDirectDraw(Sender: TBinBehavior;
271 rcBounds, rcUpdate: TRect; lDrawFlags: Integer; pvDrawObject: Pointer);
272 virtual;
273 procedure DoPainterResize(Sender: TBinBehavior; size: TSize); virtual;
274 procedure GetPainterInfo(Sender: TBinBehavior; var pInfo:
275 _HTML_PAINTER_INFO); virtual;
276 procedure DoHitTestPoint(Sender: TBinBehavior; pt: TPoint; var pbHit: BOOL;
277 var plPartID: Longint); virtual;
278 procedure DoLayoutSize(Sender: TBinBehavior; dwFlags: Integer; sizeContent:
279 TSize; var pptTranslateBy: TPoint;
280 var pptTopLeft: TPoint; var psizeProposed: TSize); virtual;
281 procedure DoLayoutPosition(Sender: TBinBehavior; lFlags: Integer; var
282 pptTopLeft: TPoint); virtual;
283 procedure DoLayoutMapSize(Sender: TBinBehavior; psizeIn: PSize; var prcOut:
284 TRect); virtual;
285 procedure DoTextDescent(Sender: TBinBehavior; var plDescent: Integer);
286 virtual;
287
288 procedure DoEventTarget(Sender: TBinBehavior; var ppElement: IHTMLElement);
289 virtual;
290 procedure DoSetCursor(Sender: TBinBehavior; lPartID: Integer); virtual;
291 function DoStringFromPartID(Sender: TBinBehavior; lPartID: Integer; out
292 pbstrPart: WideString): Boolean; virtual;
293 procedure DoOverlayMove(Sender: TBinBehavior; rcDevice: TRect); virtual;
294 procedure DoGetFocusRect(Sender: TBinBehavior; var pRect: TRect); virtual;
295 procedure DoGetSubmitInfo(Sender: TBinBehavior; pSubmitData:
296 IHTMLSubmitData); virtual;
297 procedure DoResetSubmit(Sender: TBinBehavior); virtual;
298 public
299 destructor Destroy; override;
300
301 procedure InvalidatePainterInfo;
302 procedure InvalidateLayoutInfo;
303
304 function Attach(Element: IHTMLElement2): Integer; overload;
305 function Attach(Element: IHTMLElement): Integer; overload;
306 published
307 property Alive: Boolean read fAlive write fAlive;
308 property ZOrder: TPaintZOrder read FZOrder write setZOrder default pzNone;
309 property LayoutMode: TLayoutMode read FLayoutMode write setLayoutMode default lmNone;
310 property PainterProperties: TPainterProperties read FPainterProperties write
311 setPainterProperties;
312 property HandleEvents: Boolean read fHandleEvents write fHandleEvents;
313 property LayoutTextDescent: Integer read FLayoutTextDescent write
314 setLayoutTextDescent;
315 property PaintEventInfo: TPaintEventFlags read fPaintEventInfo write
316 fPaintEventInfo;
317
318 property OnGetName: TBehaviorNameEvent read FOnGetName write FOnGetName;
319 property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke;
320 property OnGetProperty: TGetPropertyEvent read FOnGetProperty write FOnGetProperty;
321 property OnPutProperty: TPutPropertyEvent read FOnPutProperty write FOnPutProperty;
322
323
324 property OnCreateBehavior: TCreateBehaviorEvent read FOnCreateBehavior write
325 FOnCreateBehavior;
326
327 property OnGetIdOfName: TGetIdOfNameEvent read FOnGetIdOfName write FOnGetIdOfName;
328
329 property OnInit: TBehaviorNotifyEvent read FOnInit write FOnInit;
330 property OnDetach: TBehaviorNotifyEvent read FOnDetach write FOnDetach;
331 property OnContentReady: TBehaviorNotifyEvent read FOnContentReady write
332 FOnContentReady;
333 property OnDocReady: TBehaviorNotifyEvent read FOnDocReady write
334 FOnDocReady;
335 property OnApplyStyle: TBehaviorNotifyEvent read FOnApplyStyle write
336 FOnApplyStyle;
337 property OnDocContextChange: TBehaviorNotifyEvent read FOnDocContextChange
338 write FOnDocContextChange;
339 property OnContentSave: TBehaviorNotifyEvent read FOnContentSave write
340 FOnContentSave;
341
342 property OnDraw: TPainterDrawEvent read FOnDraw write FOnDraw;
343 property OnDirectDraw: TPainterDirectDrawEvent read FOnDirectDraw write
344 FOnDirectDraw;
345 property OnPainterResize: TPainterResizeEvent read FOnResize write
346 FOnResize;
347 property OnPainterInfo: TPainterInfoEvent read FOnPainterInfo write
348 FOnPainterInfo;
349 property OnPainterHitTest: TPainterHitTestEvent read FOnHitTest write
350 FOnHitTest;
351
352 property OnOverlayMove: TOverlayMoveEvent read FOnOverlayMove write
353 FOnOverlayMove;
354
355 property OnEventTarget: TEventTargetEvent read FOnEventTarget write
356 FOnEventTarget;
357 property OnSetCursor: TSetCursorEvent read FOnSetCursor write FOnSetCursor;
358 property OnStringFromPartID: TStringFromPartIDEvent read FOnStringFromPartID
359 write FOnStringFromPartID;
360
361 property OnLayoutSize: TLayoutSizeEvent read FLayoutSize write FLayoutSize;
362 property OnLayoutPosition: TLayoutPositionEvent read fLayoutPosition write
363 fLayoutPosition;
364 property OnLayoutMapSize: TLayoutMapSizeEvent read fLayoutMapSize write
365 fLayoutMapSize;
366 property OnLayoutTextDescent: TLayoutTextDescentEvent read
367 FOnLayoutTextDescent write FOnLayoutTextDescent;
368
369 property OnGetFocusRect: TGetFocusRectEvent read FOnGetFocusRect write
370 FOnGetFocusRect;
371 property OnGetSubmitInfo: TGetSubmitInfoEvent read FOnGetSubmitInfo write
372 FOnGetSubmitInfo;
373 property OnResetSubmit: TResetSubmitEvent read FOnResetSubmit write
374 FOnResetSubmit;
375 end;
376
377 TBihState = set of 0..7;
378
379 TBinBehavior = class(TInterfacedDispatchObject
380 , IElementBehavior
381 , IHTMLPainter
382 , IHTMLPainterEventInfo
383 , IHTMLPainterOverlay
384 , IElementBehaviorLayout
385 , IElementBehaviorLayout2
386 , IElementBehaviorFocus
387 , IElementBehaviorSubmit
388 )
389 private
390 fController: TEwbBehaviorController;
391 fSite: IElementBehaviorSite;
392 FElement: IHTMLElement;
393 FEventsLink: IHubLink;
394 fState: TBihState;
395 function getSiteOM: IElementBehaviorSiteOM;
396 function getPaintSite: IHTMLPaintSite;
397 function getDefaults: IHTMLElementDefaults;
398 function getSiteLayout: IElementBehaviorSiteLayout;
399 function getSiteLayout2: IElementBehaviorSiteLayout2;
400 protected
401 {IDispatch}
402 function GetIDsOfNames(const IID: TGUID; Names: Pointer;
403 NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; override;
404 stdcall;
405 function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
406 Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT;
407 override; stdcall;
408 {IElementBehavior}
409 function Init(pBehaviorSite: IElementBehaviorSite): HRESULT; stdcall;
410 function Notify(lEvent: Integer; var pVar: OleVariant): HRESULT; stdcall;
411 function Detach: HRESULT; stdcall;
412 {IHTMLPainter}
413 function IHTMLPainter.Draw = PainterDraw;
414 function PainterDraw(rcBounds, rcUpdate: TRect; lDrawFlags: Integer;
415 hdc: hdc; pvDrawObject: Pointer): HRESULT; stdcall;
416 function IHTMLPainter.onresize = PainterResize;
417 function PainterResize(size: TSize): HRESULT; stdcall;
418 function IHTMLPainter.GetPainterInfo = PainterInfo;
419 function PainterInfo(out pInfo: _HTML_PAINTER_INFO): HRESULT; stdcall;
420 function IHTMLPainter.HitTestPoint = PainterHitTestPoint;
421 function PainterHitTestPoint(pt: TPoint; out pbHit: BOOL; out plPartID:
422 Longint): HRESULT; stdcall;
423 {IHTMLPainterEventInfo}
424 function GetEventInfoFlags(out plEventInfoFlags: Integer): HRESULT; stdcall;
425 function GetEventTarget(var ppElement: IHTMLElement): HRESULT; stdcall;
426 function SetCursor(lPartID: Integer): HRESULT; stdcall;
427 function StringFromPartID(lPartID: Integer; out pbstrPart: WideString):
428 HRESULT; stdcall;
429 {IHTMLPainterOverlay}
430 function IHTMLPainterOverlay.onmove = onOverlayMove;
431 function onOverlayMove(rcDevice: TRect): HRESULT; stdcall;
432 {IElementBehaviorLayout}
433 function GetSize(dwFlags: Integer; sizeContent: TSize; var pptTranslateBy:
434 TPoint;
435 var pptTopLeft: TPoint; var psizeProposed: TSize): HRESULT; stdcall;
436 function GetLayoutInfo(out plLayoutInfo: Integer): HRESULT; stdcall;
437 function GetPosition(lFlags: Integer; var pptTopLeft: TPoint): HRESULT;
438 stdcall;
439 function MapSize(psizeIn: PSize; out prcOut: TRect): HRESULT; stdcall;
440 {IElementBehaviorLayout2}
441 function GetTextDescent(out plDescent: Integer): HRESULT; stdcall;
442 {IElementBehaviorFocus}
443 function GetFocusRect(var pRect: TRect): HRESULT; stdcall;
444 {IElementBehaviorSubmit}
445 function GetSubmitInfo(pSubmitData: IHTMLSubmitData): HRESULT; stdcall;
446 function IElementBehaviorSubmit.reset = ResetSubmit;
447 function ResetSubmit: HRESULT; stdcall;
448 protected
449 function getBoolProp(const Index: Integer): Boolean;
450 procedure SetBoolProp(const Index: Integer; const Value: Boolean);
451 public
452 constructor Create(aController: TEwbBehaviorController);
453 destructor Destroy; override;
454
455 procedure ConnectToEvents;
456 procedure DisconnectFromEvents;
457 property Controller: TEwbBehaviorController read fController;
458 property Site: IElementBehaviorSite read fSite;
459 property SiteOM: IElementBehaviorSiteOM read getSiteOM;
460 property ContextReady: Boolean index 0 read getBoolProp;
461 property DocumentReady: Boolean index 1 read getBoolProp;
462 property Element: IHTMLElement read FElement;
463 property PaintSite: IHTMLPaintSite read getPaintSite;
464 property Defaults: IHTMLElementDefaults read getDefaults;
465 property SiteLayout: IElementBehaviorSiteLayout read getSiteLayout;
466 property SiteLayout2: IElementBehaviorSiteLayout2 read getSiteLayout2;
467 end;
468
469implementation
470uses SysUtils;
471
472const
473
474 _zorders: array[TPaintZOrder] of Integer = (
475 HTMLPAINT_ZORDER_NONE,
476 HTMLPAINT_ZORDER_REPLACE_ALL,
477 HTMLPAINT_ZORDER_REPLACE_CONTENT,
478 HTMLPAINT_ZORDER_REPLACE_BACKGROUND,
479 HTMLPAINT_ZORDER_BELOW_CONTENT,
480 HTMLPAINT_ZORDER_BELOW_FLOW,
481 HTMLPAINT_ZORDER_ABOVE_FLOW,
482 HTMLPAINT_ZORDER_ABOVE_CONTENT,
483 HTMLPAINT_ZORDER_WINDOW_TOP
484 );
485
486 _pproperties: array[TPainterProperty] of Integer = (
487 HTMLPAINTER_OPAQUE,
488 HTMLPAINTER_TRANSPARENT,
489 //NOIMPL HTMLPAINTER_ALPHA,
490 //NOIMPL HTMLPAINTER_COMPLEX,
491 HTMLPAINTER_OVERLAY,
492 HTMLPAINTER_HITTEST,
493 HTMLPAINTER_SURFACE,
494 HTMLPAINTER_3DSURFACE,
495 //NOIMPL HTMLPAINTER_NOBAND,
496 HTMLPAINTER_NODC,
497 HTMLPAINTER_NOPHYSICALCLIP,
498 HTMLPAINTER_NOSAVEDC,
499 HTMLPAINTER_SUPPORTS_XFORM,
500 HTMLPAINTER_EXPAND,
501 HTMLPAINTER_NOSCROLLBITS
502 );
503
504 _layouts: array[TLayoutMode] of Integer = (
505 0,
506 BEHAVIORLAYOUTINFO_FULLDELEGATION,
507 BEHAVIORLAYOUTINFO_MODIFYNATURAL,
508 BEHAVIORLAYOUTINFO_MAPSIZE
509 );
510
511 { TEwbBehaviorFactory }
512
513function TEwbBehaviorFactory.CreateWithImplementation(
514 pNamespace: IElementNamespace;
515 const bstrImplementation: WideString): HRESULT;
516begin
517 Result := S_OK;
518 if Assigned(FOnCreateNSWithImpl) then
519 FOnCreateNSWithImpl(Self, pNamespace, bstrImplementation)
520 else if Assigned(FOnCreateNS) then
521 FOnCreateNS(Self, pNamespace);
522end;
523
524function TEwbBehaviorFactory.FactoryCreate(pNamespace: IElementNamespace):
525 HRESULT;
526begin
527 Result := S_OK;
528 if Assigned(FOnCreateNS) then
529 FOnCreateNS(Self, pNamespace);
530end;
531
532function TEwbBehaviorFactory.FindBehavior(const bstrBehavior,
533 bstrBehaviorUrl: WideString; const pSite: IElementBehaviorSite;
534 out ppBehavior: IElementBehavior): HRESULT;
535begin
536 ppBehavior := nil;
537 if Assigned(FOnFindBehavior) then
538 FOnFindBehavior(Self, bstrBehavior, bstrBehaviorUrl, pSite, ppBehavior);
539 if ppBehavior = nil then
540 Result := E_NOTIMPL
541 else
542 Result := S_OK;
543end;
544
545function TEwbBehaviorFactory.Resolve(const bstrNamespace, bstrTagName,
546 bstrAttrs: WideString; pNamespace: IElementNamespace): HRESULT;
547begin
548 Result := S_OK;
549 if Assigned(FOnResolveNS) then
550 FOnResolveNS(Self, bstrNamespace, bstrTagName, bstrAttrs, pNamespace);
551end;
552
553{ TBinBehavior }
554
555constructor TBinBehavior.Create(aController: TEwbBehaviorController);
556begin
557 inherited Create;
558 aController.Add(Self);
559end;
560
561destructor TBinBehavior.Destroy;
562begin
563 FController.Remove(Self);
564 inherited;
565end;
566
567function TBinBehavior.getBoolProp(const Index: Integer): Boolean;
568begin
569 Result := Index in fState;
570end;
571
572procedure TBinBehavior.SetBoolProp(const Index: Integer;
573 const Value: Boolean);
574begin
575 if Value then
576 Include(fState, Index)
577 else
578 Exclude(fState, Index);
579end;
580
581function TBinBehavior.getSiteOM: IElementBehaviorSiteOM;
582begin
583 if not Supports(fSite, IElementBehaviorSiteOM, Result) then
584 Result := nil;
585end;
586
587function TBinBehavior.getPaintSite: IHTMLPaintSite;
588begin
589 if not Supports(fSite, IHTMLPaintSite, Result) then
590 Result := nil;
591end;
592
593function TBinBehavior.getDefaults: IHTMLElementDefaults;
594var
595 OM2: IElementBehaviorSiteOM2;
596begin
597 if Supports(fSite, IElementBehaviorSiteOM2, OM2) then
598 OM2.GetDefaults(Result)
599 else
600 Result := nil;
601end;
602
603function TBinBehavior.getSiteLayout: IElementBehaviorSiteLayout;
604begin
605 if not Supports(fSite, IElementBehaviorSiteLayout, Result) then
606 Result := nil;
607end;
608
609function TBinBehavior.getSiteLayout2: IElementBehaviorSiteLayout2;
610begin
611 if not Supports(fSite, IElementBehaviorSiteLayout2, Result) then
612 Result := nil;
613end;
614
615function TBinBehavior.Detach: HRESULT;
616begin
617 FController.DoDetach(Self);
618 DisconnectFromEvents;
619 FElement := nil;
620 SetBoolProp(1, False);
621 fSite := nil;
622 SetBoolProp(0, False);
623 Result := S_OK;
624end;
625
626procedure TBinBehavior.ConnectToEvents;
627begin
628 if FEventsLink = nil then
629 FEventsLink := FController.Connect2(Element, Self);
630end;
631
632procedure TBinBehavior.DisconnectFromEvents;
633begin
634 if FEventsLink <> nil then
635 try
636 FEventsLink.Disconnect;
637 finally
638 FEventsLink := nil;
639 end;
640end;
641
642function TBinBehavior.Init(pBehaviorSite: IElementBehaviorSite): HRESULT;
643begin
644 fSite := pBehaviorSite;
645 FController.DoInit(Self);
646 Result := S_OK;
647end;
648
649function TBinBehavior.Notify(lEvent: Integer;
650 var pVar: OleVariant): HRESULT;
651begin
652 case lEvent of
653 BEHAVIOREVENT_CONTENTREADY:
654 begin
655 SetBoolProp(0, True);
656 Site.GetElement(FElement);
657 if FController.HandleEvents then
658 Self.ConnectToEvents;
659 end;
660 BEHAVIOREVENT_DOCUMENTREADY:
661 SetBoolProp(1, True);
662 end;
663 FController.DoNotify(Self, lEvent);
664 Result := S_OK;
665end;
666
667function TBinBehavior.PainterDraw(rcBounds, rcUpdate: TRect;
668 lDrawFlags: Integer; hdc: hdc; pvDrawObject: Pointer): HRESULT;
669var
670 Canvas: TCanvas;
671begin
672 Result := S_OK;
673 if hdc <> 0 then
674 begin
675 Canvas := TCanvas.Create;
676 Canvas.Handle := hdc;
677 end else if pvDrawObject <> nil then
678 begin
679 FController.DoDirectDraw(Self, rcBounds, rcUpdate, lDrawFlags,
680 pvDrawObject);
681 Exit;
682 end else
683 Canvas := nil;
684 try
685 FController.DoDraw(Self, rcBounds, rcUpdate, lDrawFlags, Canvas);
686 finally
687 Canvas.Free;
688 end;
689end;
690
691function TBinBehavior.PainterHitTestPoint(pt: TPoint; out pbHit: BOOL;
692 out plPartID: Integer): HRESULT;
693begin
694 pbHit := False;
695 plPartID := 0;
696 FController.DoHitTestPoint(Self, pt, pbHit, plPartID);
697 Result := S_OK;
698end;
699
700function TBinBehavior.PainterInfo(out pInfo: _HTML_PAINTER_INFO): HRESULT;
701begin
702 pInfo.lZOrder := _zorders[FController.ZOrder];
703 pInfo.lFlags := FController.FPainterFlags;
704 FController.GetPainterInfo(Self, pInfo);
705 Result := S_OK;
706end;
707
708function TBinBehavior.PainterResize(size: TSize): HRESULT;
709begin
710 FController.DoPainterResize(Self, size);
711 Result := S_OK;
712end;
713
714function TBinBehavior.GetLayoutInfo(out plLayoutInfo: Integer): HRESULT;
715begin
716 plLayoutInfo := _layouts[FController.LayoutMode];
717 Result := S_OK;
718end;
719
720function TBinBehavior.GetPosition(lFlags: Integer;
721 var pptTopLeft: TPoint): HRESULT;
722begin
723 FController.DoLayoutPosition(Self, lFlags, pptTopLeft);
724 Result := S_OK;
725end;
726
727function TBinBehavior.GetSize(dwFlags: Integer; sizeContent: TSize;
728 var pptTranslateBy, pptTopLeft: TPoint;
729 var psizeProposed: TSize): HRESULT;
730begin
731 FController.DoLayoutSize(Self, dwFlags, sizeContent,
732 pptTranslateBy, pptTopLeft, psizeProposed);
733 Result := S_OK;
734end;
735
736function TBinBehavior.MapSize(psizeIn: PSize; out prcOut: TRect): HRESULT;
737begin
738 FController.DoLayoutMapSize(Self, psizeIn, prcOut);
739 Result := S_OK;
740end;
741
742function TBinBehavior.GetTextDescent(out plDescent: Integer): HRESULT;
743begin
744 FController.DoTextDescent(Self, plDescent);
745 Result := S_OK;
746end;
747
748function TBinBehavior.GetEventInfoFlags(
749 out plEventInfoFlags: Integer): HRESULT;
750begin
751 plEventInfoFlags := 0;
752 with Self.FController do
753 begin
754 if pfTarget in PaintEventInfo then
755 plEventInfoFlags := HTMLPAINT_EVENT_TARGET;
756 if pfSetCursor in PaintEventInfo then
757 plEventInfoFlags := plEventInfoFlags or HTMLPAINT_EVENT_SETCURSOR;
758 end;
759 Result := S_OK;
760end;
761
762function TBinBehavior.GetEventTarget(var ppElement: IHTMLElement): HRESULT;
763begin
764 FController.DoEventTarget(Self, ppElement);
765 Result := S_OK;
766end;
767
768function TBinBehavior.SetCursor(lPartID: Integer): HRESULT;
769begin
770 FController.DoSetCursor(Self, lPartID);
771 Result := S_OK;
772end;
773
774function TBinBehavior.StringFromPartID(lPartID: Integer;
775 out pbstrPart: WideString): HRESULT;
776begin
777 if FController.DoStringFromPartID(Self, lPartID, pbstrPart) then
778 Result := S_OK
779 else
780 Result := E_NOTIMPL;
781end;
782
783function TBinBehavior.onOverlayMove(rcDevice: TRect): HRESULT;
784begin
785 FController.DoOverlayMove(Self, rcDevice);
786 Result := S_OK;
787end;
788
789function TBinBehavior.GetFocusRect(var pRect: TRect): HRESULT;
790begin
791 FController.DoGetFocusRect(Self, pRect);
792 Result := S_OK;
793end;
794
795function TBinBehavior.GetSubmitInfo(
796 pSubmitData: IHTMLSubmitData): HRESULT;
797begin
798 FController.DoGetSubmitInfo(Self, pSubmitData);
799 Result := S_OK;
800end;
801
802function TBinBehavior.ResetSubmit: HRESULT;
803begin
804 FController.DoResetSubmit(Self);
805 Result := S_OK;
806end;
807
808function TBinBehavior.GetIDsOfNames(const IID: TGUID; Names: Pointer;
809 NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
810var
811 I: Integer;
812 pname: WideString;
813 id: Integer;
814begin
815 pname := PWideChar(Names^);
816 for I := 0 to NameCount - 1 do
817 PDispIDList(DispIDs)^[i] := -1;
818 id := -1;
819 FController.DoGetIdOfName(Self, pname, id);
820 if id <> -1 then
821 begin
822 PDispIDList(DispIDs)^[0] := TDispID(id);
823 Result := S_OK
824 end else Result := E_NOTIMPL;
825end;
826
827function TBinBehavior.Invoke(DispID: Integer; const IID: TGUID;
828 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
829 ArgErr: Pointer): HRESULT;
830begin
831 try
832 Result := DISP_E_MEMBERNOTFOUND;
833 if integer(DispID) <> -1 then
834 if Flags = DISPATCH_METHOD then
835 FController.DoInvoke(Self, DispID, POleVariant(VarResult),
836 TDispParams(Params), Result)
837 else
838 case Flags and not DISPATCH_METHOD of
839 DISPATCH_PROPERTYGET:
840 FController.DoGetProperty(Self, DispID, POleVariant(VarResult),
841 TDispParams(Params), Result);
842
843 DISPATCH_PROPERTYPUT,
844 DISPATCH_PROPERTYPUTREF,
845 DISPATCH_PROPERTYPUT + DISPATCH_PROPERTYPUTREF:
846 FController.DoPutProperty(Self, DispID, TDispParams(Params), Result);
847 end;
848 except
849 on E: Exception do
850 with PExcepInfo(ExcepInfo)^ do
851 begin
852 Result := DISP_E_EXCEPTION;
853 wCode := 9999;
854 bstrDescription := E.Message;
855 bstrSource := E.ClassName;
856 dwHelpContext := E.HelpContext;
857 end;
858 end;
859end;
860
861{ TEwbBehaviorController }
862
863destructor TEwbBehaviorController.Destroy;
864begin
865 FreeAndNil(FBehaviors);
866 inherited;
867end;
868
869procedure TEwbBehaviorController.Add(aBehavior: TBinBehavior);
870begin
871 aBehavior.fController := Self;
872 if Alive then
873 begin
874 if FBehaviors = nil then
875 FBehaviors := TList.Create;
876 FBehaviors.Add(aBehavior);
877 end;
878end;
879
880procedure TEwbBehaviorController.Remove(aBehavior: TBinBehavior);
881begin
882 aBehavior.fController := nil;
883 if FBehaviors <> nil then
884 FBehaviors.Remove(aBehavior);
885end;
886
887procedure TEwbBehaviorController.InvalidatePainterInfo;
888var I: Integer;
889begin
890 if FBehaviors <> nil then
891 for I := 0 to FBehaviors.Count - 1 do
892 with TBinBehavior(FBehaviors[I]) do
893 PaintSite.InvalidatePainterInfo;
894end;
895
896procedure TEwbBehaviorController.InvalidateLayoutInfo;
897var I: Integer;
898begin
899 if FBehaviors <> nil then
900 for I := 0 to FBehaviors.Count - 1 do
901 with TBinBehavior(FBehaviors[I]) do
902 SiteLayout.InvalidateLayoutInfo;
903end;
904
905procedure TEwbBehaviorController.setZOrder(const Value: TPaintZOrder);
906begin
907 if FZOrder <> Value then
908 begin
909 FZOrder := Value;
910 InvalidatePainterInfo;
911 end;
912end;
913
914procedure TEwbBehaviorController.setPainterProperties(
915 const Value: TPainterProperties);
916var
917 lFlags: Integer;
918 I: TPainterProperty;
919begin
920 lFlags := 0;
921 FPainterProperties := Value;
922 for I := Low(TPainterProperty) to High(TPainterProperty) do
923 if I in Value then
924 lFlags := lFlags or _pproperties[I];
925 FPainterFlags := lFlags;
926 InvalidatePainterInfo;
927end;
928
929procedure TEwbBehaviorController.setLayoutMode(const Value: TLayoutMode);
930begin
931 if FLayoutMode <> Value then
932 begin
933 FLayoutMode := Value;
934 InvalidateLayoutInfo;
935 end;
936end;
937
938procedure TEwbBehaviorController.setLayoutTextDescent(
939 const Value: Integer);
940begin
941 if FLayoutTextDescent <> Value then
942 begin
943 FLayoutTextDescent := Value;
944 InvalidateLayoutInfo;
945 end;
946end;
947
948function TEwbBehaviorController.FindBehavior(const bstrBehavior,
949 bstrBehaviorUrl: WideString; const pSite: IElementBehaviorSite;
950 out ppBehavior: IElementBehavior): HRESULT;
951begin
952 if Assigned(FOnCreateBehavior) then
953 ppBehavior := FOnCreateBehavior(Self, bstrBehavior, bstrBehaviorUrl, pSite);
954 if ppBehavior = nil then
955 ppBehavior := TBinBehavior.Create(Self) as IElementBehavior;
956 Result := S_OK;
957end;
958
959function TEwbBehaviorController.Attach(Element: IHTMLElement2): Integer;
960var
961 aName: Widestring;
962{$IFDEF DELPHI5_UP}
963 SelfIntf: IElementBehaviorFactory;
964{$ENDIF}
965begin
966 aName := '';
967 if Assigned(FOnGetName) then
968 FOnGetName(Self, Element, aName);
969{$IFDEF DELPHI5_UP}
970 GetInterface(IElementBehaviorFactory, SelfIntf);
971 Result := Element.addBehavior(aName, SelfIntf);
972{$ELSE}
973 Result := Element.addBehavior(aName, Self as IElementBehaviorFactory);
974{$ENDIF}
975end;
976
977function TEwbBehaviorController.Attach(Element: IHTMLElement): Integer;
978var
979 E: IHTMLElement2;
980begin
981 if Supports(Element, IHTMLElement2, E) then
982 Result := Attach(E)
983 else
984 Result := 0;
985end;
986
987procedure TEwbBehaviorController.DoInit(Sender: TBinBehavior);
988begin
989 if Assigned(FOnInit) then
990 FOnInit(Sender);
991end;
992
993procedure TEwbBehaviorController.DoDetach(Sender: TBinBehavior);
994begin
995 if Assigned(FOnDetach) then
996 FOnDetach(Sender);
997end;
998
999procedure TEwbBehaviorController.DoDraw(Sender: TBinBehavior; rcBounds,
1000 rcUpdate: TRect; lDrawFlags: Integer; Canvas: TCanvas);
1001begin
1002 if Assigned(FOnDraw) then
1003 FOnDraw(Sender, rcBounds, rcUpdate, lDrawFlags, Canvas);
1004end;
1005
1006procedure TEwbBehaviorController.DoDirectDraw(Sender: TBinBehavior;
1007 rcBounds, rcUpdate: TRect; lDrawFlags: Integer; pvDrawObject: Pointer);
1008begin
1009 if Assigned(FOnDirectDraw) then
1010 FOnDirectDraw(Sender, rcBounds, rcUpdate, lDrawFlags, pvDrawObject);
1011end;
1012
1013procedure TEwbBehaviorController.DoHitTestPoint(Sender: TBinBehavior;
1014 pt: TPoint; var pbHit: BOOL; var plPartID: Integer);
1015begin
1016 if Assigned(FOnHitTest) then
1017 FOnHitTest(Sender, pt, pbHit, plPartID);
1018end;
1019
1020procedure TEwbBehaviorController.DoPainterResize(Sender: TBinBehavior;
1021 Size: TSize);
1022begin
1023 if Assigned(FOnResize) then
1024 FOnResize(Sender, size);
1025end;
1026
1027procedure TEwbBehaviorController.GetPainterInfo(Sender: TBinBehavior;
1028 var pInfo: _HTML_PAINTER_INFO);
1029begin
1030 if Assigned(FOnPainterInfo) then
1031 FOnPainterInfo(Sender, pInfo);
1032end;
1033
1034procedure TEwbBehaviorController.DoNotify(Sender: TBinBehavior;
1035 lEvent: Integer);
1036begin
1037 case lEvent of
1038 BEHAVIOREVENT_CONTENTREADY:
1039 if Assigned(FOnContentReady) then
1040 FOnContentReady(Sender);
1041 BEHAVIOREVENT_DOCUMENTREADY:
1042 if Assigned(FOnDocReady) then
1043 FOnDocReady(Sender);
1044 BEHAVIOREVENT_DOCUMENTCONTEXTCHANGE:
1045 if Assigned(FOnDocContextChange) then
1046 FOnDocContextChange(Sender);
1047 BEHAVIOREVENT_CONTENTSAVE:
1048 if Assigned(FOnContentSave) then
1049 FOnContentSave(Sender);
1050 BEHAVIOREVENT_APPLYSTYLE:
1051 if Assigned(FOnApplyStyle) then
1052 FOnApplyStyle(Sender);
1053 end;
1054end;
1055
1056procedure TEwbBehaviorController.DoLayoutMapSize(Sender: TBinBehavior;
1057 psizeIn: PSize; var prcOut: TRect);
1058begin
1059 if Assigned(fLayoutMapSize) then
1060 fLayoutMapSize(Sender, psizeIn, prcOut);
1061end;
1062
1063procedure TEwbBehaviorController.DoLayoutPosition(Sender: TBinBehavior;
1064 lFlags: Integer; var pptTopLeft: TPoint);
1065begin
1066 if Assigned(fLayoutPosition) then
1067 fLayoutPosition(Sender, lFlags, pptTopLeft);
1068end;
1069
1070procedure TEwbBehaviorController.DoLayoutSize(Sender: TBinBehavior;
1071 dwFlags: Integer; sizeContent: TSize; var pptTranslateBy,
1072 pptTopLeft: TPoint; var psizeProposed: TSize);
1073begin
1074 if Assigned(FLayoutSize) then
1075 FLayoutSize(Sender, dwFlags, sizeContent, pptTranslateBy, pptTopLeft,
1076 psizeProposed);
1077end;
1078
1079procedure TEwbBehaviorController.DoTextDescent(Sender: TBinBehavior;
1080 var plDescent: Integer);
1081begin
1082 plDescent := Self.LayoutTextDescent;
1083 if Assigned(FOnLayoutTextDescent) then
1084 FOnLayoutTextDescent(Sender, plDescent);
1085end;
1086
1087procedure TEwbBehaviorController.DoEventTarget(Sender: TBinBehavior;
1088 var ppElement: IHTMLElement);
1089begin
1090 if Assigned(FOnEventTarget) then
1091 FOnEventTarget(Sender, ppElement);
1092end;
1093
1094procedure TEwbBehaviorController.DoSetCursor(Sender: TBinBehavior;
1095 lPartID: Integer);
1096begin
1097 if Assigned(FOnSetCursor) then
1098 FOnSetCursor(Sender, lPartID);
1099end;
1100
1101function TEwbBehaviorController.DoStringFromPartID(Sender: TBinBehavior;
1102 lPartID: Integer; out pbstrPart: WideString): Boolean;
1103begin
1104 Result := Assigned(FOnStringFromPartID);
1105 if Result then
1106 FOnStringFromPartID(Sender, lPartID, pbstrPart);
1107end;
1108
1109procedure TEwbBehaviorController.DoOverlayMove(Sender: TBinBehavior;
1110 rcDevice: TRect);
1111begin
1112 if Assigned(FOnOverlayMove) then
1113 FOnOverlayMove(Sender, rcDevice);
1114end;
1115
1116procedure TEwbBehaviorController.DoGetFocusRect(Sender: TBinBehavior;
1117 var pRect: TRect);
1118begin
1119 if Assigned(FOnGetFocusRect) then
1120 FOnGetFocusRect(Sender, pRect);
1121end;
1122
1123procedure TEwbBehaviorController.DoGetSubmitInfo(Sender: TBinBehavior;
1124 pSubmitData: IHTMLSubmitData);
1125begin
1126 if Assigned(FOnGetSubmitInfo) then
1127 FOnGetSubmitInfo(Sender, pSubmitData);
1128end;
1129
1130procedure TEwbBehaviorController.DoResetSubmit(Sender: TBinBehavior);
1131begin
1132 if Assigned(FOnResetSubmit) then
1133 FOnResetSubmit(Sender);
1134end;
1135
1136procedure TEwbBehaviorController.DoGetIdOfName(Sender: TBinBehavior;
1137 const name: widestring; var id: Integer);
1138begin
1139 if Assigned(FOnGetIdOfName) then
1140 FOnGetIdOfName(Sender, name, id);
1141end;
1142
1143procedure TEwbBehaviorController.DoGetProperty(Sender: TBinBehavior;
1144 DispID: Integer; VarResult: POleVariant; Params: TDispParams;
1145 var Rezult: HRESULT);
1146begin
1147 if Assigned(FOnGetProperty) then
1148 FOnGetProperty(Sender, DispID, VarResult, Params, Rezult);
1149end;
1150
1151procedure TEwbBehaviorController.DoInvoke(Sender: TBinBehavior;
1152 DispID: Integer; VarResult: POleVariant; Params: TDispParams;
1153 var Rezult: HRESULT);
1154begin
1155 if Assigned(FOnInvoke) then
1156 FOnInvoke(Sender, DispID, VarResult, Params, Rezult);
1157end;
1158
1159procedure TEwbBehaviorController.DoPutProperty(Sender: TBinBehavior;
1160 DispID: Integer; Params: TDispParams; var Rezult: HRESULT);
1161begin
1162 if Assigned(FOnPutProperty) then
1163 FOnPutProperty(Sender, DispID, Params, Rezult);
1164end;
1165
1166end.
Note: See TracBrowser for help on using the repository browser.