Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/HTMLDocumentEvent.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.4 - (show annotations) (download) (as text)
Sun Aug 26 13:00:41 2007 UTC (16 years, 7 months ago) by h677
Branch: MAIN
CVS Tags: v1_59_0_771, v1_59_0_770, v1_59_0_773, v1_59_0_772, v1_59_0_775, v1_59_0_774, v1_59_0_777, v1_59_0_776, v1_59_0_778, v1_63_1_819, v1_57_0_737, v1_62_0_812, v1_57_0_735, v1_57_0_734, v1_57_0_733, v1_57_0_732, v1_57_0_731, v1_57_0_730, v1_57_0_739, v1_57_0_738, v1_59_1_765, v1_60_0_788, v1_60_0_789, v1_58_0_748, v1_58_0_745, v1_60_0_781, v1_60_0_782, v1_58_0_746, v1_60_0_784, v1_60_0_786, v1_60_0_787, v1_59_0_767, v1_59_1_778, v1_59_0_768, v1_59_0_769, v1_57_1_744, v1_57_0_728, v1_57_0_729, v1_57_0_736, v1_58_0_752, v1_58_0_750, v1_58_0_751, v1_58_0_756, v1_58_0_757, v1_58_0_754, v1_58_0_755, v1_58_0_759, v1_61_0_796, v1_61_0_797, v1_61_0_795, v1_61_0_798, v1_61_0_799, v1_63_0_818, v1_63_0_817, v1_63_0_816, v1_63_0_815, v1_62_0_805, v1_62_0_804, v1_62_0_807, v1_62_0_806, v1_62_0_803, v1_62_0_802, v1_62_0_809, v1_60_0_780, v1_60_0_779, v1_62_0_810, v1_62_0_811, v1_58_0_747, v1_60_0_783, v1_59_2_785, v1_60_1_793, v1_58_0_763, v1_58_0_762, v1_58_0_761, v1_58_0_760, v1_62_1_813, v1_57_2_749, v1_57_0_742, v1_57_0_743, v1_57_0_740, v1_57_0_741, v1_57_0_744, v1_61_0_800, v1_60_0_793, v1_60_0_792, v1_60_0_791, v1_60_0_790, v1_60_2_794, v1_61_1_801, HEAD
Branch point for: Bb57, Bb62, Bb63, Bb60, Bb61, Bb59, Bb58
Changes since 1.3: +6 -0 lines
File MIME type: text/x-pascal
レスポップアップウィンドウ上でのダブルクリックで、
レスポップアップウィンドウを閉じるようにした。

1 unit HTMLDocumentEvent;
2
3 interface
4
5 uses
6 Windows, Classes, ActiveX, ComObj;
7
8 type
9 TDocumentContextMenuEvent = function(Sender: TObject): WordBool of object;
10
11 THTMLDocumentEventSink = class(TInterfacedObject,IUnknown,IDispatch)
12 private
13 FOwner: TObject;
14 FSimpleDisp: IDispatch;
15 FSimpleIID: TGUID;
16 FSimpleCon: Integer;
17 FOnContextMenu: TDocumentContextMenuEvent;
18 FOnClick: TDocumentContextMenuEvent;
19 FOnMouseMove: TDocumentContextMenuEvent;
20 FOnMouseDown: TDocumentContextMenuEvent;
21 FOnDoubleClick: TDocumentContextMenuEvent;
22 protected
23 { IUnknown }
24 function QueryInterface(const IID:TGUID; out Obj): HRESULT; stdcall;
25 function _AddRef:Integer; stdcall;
26 function _Release:Integer; stdcall;
27 { IDispatch }
28 function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
29 function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
30 function GetIDsOfNames(const IID: TGUID; Names: Pointer;
31 NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
32 function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
33 Flags: Word; var Params; VarResult, ExcepInfo, ArgErr:Pointer): HRESULT; stdcall;
34 public
35 constructor Create(AOwner: TObject; ADisp: IDispatch; const AIID: TGUID);
36 destructor Destroy; override;
37 property OnContextMenu: TDocumentContextMenuEvent read FOnContextMenu write FOnContextMenu;
38 property OnClick: TDocumentContextMenuEvent read FOnClick write FOnClick;
39 property OnMouseMove: TDocumentContextMenuEvent read FOnMouseMove write FOnMouseMove;
40 property OnMouseDown: TDocumentContextMenuEvent read FOnMouseDown write FOnMouseDown;
41 property OnDoubleClick: TDocumentContextMenuEvent read FOnDoubleClick write FOnDoubleClick;
42 end;
43
44 implementation
45
46 function THTMLDocumentEventSink._AddRef: Integer;
47 begin
48 Result := 2;
49 end;
50
51 function THTMLDocumentEventSink._Release: Integer;
52 begin
53 Result := 1;
54 end;
55
56 constructor THTMLDocumentEventSink.Create(AOwner: TObject; ADisp: IDispatch; const AIID: TGUID);
57 begin
58 inherited Create;
59 FOwner := AOwner;
60 FSimpleDisp := ADisp;
61 FSimpleIID := AIID;
62 InterfaceConnect(FSimpleDisp, FSimpleIID, Self, FSimpleCon);
63 end;
64
65 destructor THTMLDocumentEventSink.Destroy;
66 begin
67 InterfaceDisconnect(FSimpleDisp,FSimpleIID,FSimpleCon);
68 inherited Destroy;
69 end;
70
71 function THTMLDocumentEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
72 NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
73 begin
74 Result := E_NOTIMPL;
75 end;
76
77 function THTMLDocumentEventSink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT;
78 begin
79 Result := E_NOTIMPL;
80 end;
81
82 function THTMLDocumentEventSink.GetTypeInfoCount(out Count: Integer): HRESULT;
83 begin
84 Count := 0;
85 Result := S_OK;
86 end;
87
88 function THTMLDocumentEventSink.Invoke(DispID: Integer; const IID: TGUID;
89 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
90 ArgErr: Pointer): HRESULT;
91 begin
92 case DispID of
93 DISPID_MOUSEDOWN:
94 if Assigned(FOnMouseDown) then begin
95 PVariant(VarResult)^ := FOnMouseDown(FOwner);
96 end;
97 DISPID_MOUSEMOVE:
98 if Assigned(FOnMouseMove) then begin
99 PVariant(VarResult)^ := FOnMouseMove(FOwner);
100 end;
101 DISPID_CLICK:
102 if Assigned(FOnClick) then begin
103 PVariant(VarResult)^ := FOnClick(FOwner);
104 end;
105 DISPID_DBLCLICK:
106 if Assigned(FOnDoubleClick) then begin
107 PVariant(VarResult)^ := FOnDoubleClick(FOwner);
108 end;
109 1023:
110 if Assigned(FOnContextMenu) then begin
111 PVariant(VarResult)^ := FOnContextMenu(FOwner);
112 end;
113 end;
114 Result := S_OK;
115 end;
116
117 function THTMLDocumentEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
118 begin
119 Result := E_NOINTERFACE;
120 if GetInterface(IID,Obj) then
121 Result := S_OK;
122 if IsEqualGUID(IID,FSimpleIID) and GetInterface(IDispatch,Obj) then
123 Result := S_OK;
124 end;
125
126 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26