Browse CVS Repository
Contents of /gikonavigoeson/gikonavi/HTMLDocumentEvent.pas
Parent Directory
| Revision Log
| 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. |
| |