Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/BrowserRecord.pas

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


Revision 1.4 - (show annotations) (download) (as text)
Sat Aug 12 22:19:57 2006 UTC (17 years, 8 months ago) by h677
Branch: MAIN
CVS Tags: v1_54_0_678, v1_54_0_680, v1_54_0_681, v1_54_0_682, v1_54_0_683, v1_54_0_679
Changes since 1.3: +30 -1 lines
File MIME type: text/x-pascal
検索ダイアログを表示するメソッドを移動

1 unit BrowserRecord;
2
3 interface
4
5 uses
6 Windows, OleCtrls, ActiveX,
7 {$IF Defined(DELPRO) }
8 SHDocVw,
9 MSHTML,
10 {$ELSE}
11 SHDocVw_TLB,
12 MSHTML_TLB,
13 {$IFEND}
14 BoardGroup, HTMLDocumentEvent;
15
16 type
17 TBrowserRecord = class( TObject )
18 private
19 FBrowser : TWebBrowser;
20 FEvent: THTMLDocumentEventSink; ///< ???????吟?????ャ?<?潟???ゃ???潟??
21 FThread : TThreadItem;
22 FLastSize : Integer;
23 FRepaint : Boolean;
24 //FMovement : string; ///< ?鴻?????若?????≪?潟????/span>
25 public
26 destructor Destroy; override;
27 property Event : THTMLDocumentEventSink read FEvent write FEvent;
28 property Browser : TWebBrowser read FBrowser write FBrowser;
29 property Thread : TThreadItem read FThread write FThread;
30 property LastSize : Integer read FLastSize write FLastSize;
31 property Repaint : Boolean read FRepaint write FRepaint;
32 //property Movement : string read FMovement write FMovement;
33 procedure Move(const AName: string);
34 procedure IDAnchorPopup(Abody :string);
35 procedure OpenFindDialog;
36 end;
37 // BrowserRecord???ゃ????????FBrowser??紊???
38 procedure ReleaseBrowser( BRecord: TBrowserRecord);
39
40 implementation
41
42 uses
43 Forms, SysUtils;
44
45 // *************************************************************************
46 //! BrowserRecord???ゃ????????FBrowser??紊???
47 // *************************************************************************
48 procedure ReleaseBrowser( BRecord: TBrowserRecord);
49 begin
50 if BRecord <> nil then begin
51 BRecord.Browser := nil;
52 if BRecord.Event <> nil then begin
53 BRecord.Event.Free;
54 BRecord.Event := nil;
55 end;
56 BRecord.Repaint := true;
57 end;
58 end;
59 // *************************************************************************
60 //! BrowserRecord?????鴻????????/span>
61 // *************************************************************************
62 destructor TBrowserRecord.Destroy;
63 var
64 doc :OleVariant;
65 begin
66 if Self.FEvent <> nil then
67 Self.FEvent.Free;
68 if Self.FBrowser <> nil then begin
69 if Self.Thread <> nil then begin
70 //?帥????奨???у奨?????????鴻????????祉??????????????????????????/span>
71 //???????????鴻?????若?????篆?絖????????障?????????????祉?c?????障????
72 if Self.FBrowser.OleObject.Document.documentElement.innerText <> '' then begin
73 doc := Idispatch( olevariant(Self.FBrowser.ControlInterface).Document) as IHTMLDocument2;
74 Self.Thread.ScrollTop := doc.Body.ScrollTop;
75 end;
76 end;
77 ShowWindow(Self.FBrowser.Handle, SW_HIDE);
78 end;
79
80 end;
81 // *************************************************************************
82 //! ???????吟???鴻?????若????????
83 // *************************************************************************
84 procedure TBrowserRecord.Move(const AName: string);
85 var
86 top: Integer;
87 item: OleVariant;
88 begin
89 //???????吟??篁???????????????????????
90 if (Self.Browser <> nil) then begin
91 //???????吟?????若?帥????粋昭?推賢????????粋昭?帥??緇???/span>
92 while (Self.Browser.ReadyState <> READYSTATE_COMPLETE) and
93 (Self.Browser.ReadyState <> READYSTATE_INTERACTIVE) do begin
94 Sleep(1);
95 Application.ProcessMessages;
96 end;
97
98 try
99 top := 0;
100 item := OleVariant( Self.Browser.Document as IHTMLDocument2)
101 .anchors.item(OleVariant(AName));
102 item.focus();
103 repeat
104 top := top + item.offsetTop;
105 item := item.offsetParent;
106 until AnsiCompareText(item.tagName, 'body' ) = 0;
107 OleVariant(Self.Browser.Document as IHTMLDocument2).body.scrollTop := top;
108 except
109 end;
110 end;
111 end;
112 //ID?≪?潟???取申??
113 procedure TBrowserRecord.IDAnchorPopup(Abody :string);
114 const
115 OUTER_HTML = '<p id="idSearch"></p>';
116 HIDDEN = 'hidden';
117 var
118 firstElement: IHTMLElement;
119 document: IHTMLDocument2;
120 docAll: IHTMLElementCollection;
121 doc : Variant;
122 nCSS : string;
123 begin
124 if Self.Browser <> nil then begin
125 try
126 document := Self.Browser.Document as IHTMLDocument2;
127
128 if Assigned(document) then begin
129 docAll := document.all;
130 firstElement := docAll.item('idSearch', 0) as IHTMLElement;
131 if (Assigned(firstElement)) then begin
132 if Length(Abody) > 0 then begin
133 doc := Idispatch( olevariant(Self.Browser.ControlInterface).Document) as IHTMLDocument2;
134 nCSS := '<p id="idSearch" style="position:absolute;top:' + IntToStr(doc.Body.ScrollTop + 10) + 'px;right:5px;' //
135 + 'background-color:window; border:outset 1px infobackground; z-index:10; overflow-y:auto; border-top:none">'
136 + Abody + '</p>';
137 firstElement.outerHTML := nCSS;
138 firstElement.style.visibility := 'visible';
139 end else begin
140 firstElement.outerHTML := OUTER_HTML;
141 firstElement.style.visibility := HIDDEN;
142 end;
143 end else if (Assigned(firstElement)) then begin
144 firstElement.outerHTML := OUTER_HTML;
145 firstElement.style.visibility := HIDDEN;
146 end;
147 end;
148 except
149 end;
150 end;
151 end;
152 {
153 \brief 罎?膣≪???ゃ?≪???医?若?喝?冴??
154 }
155 procedure TBrowserRecord.OpenFindDialog();
156 const
157 CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
158 HTMLID_FIND = 1;
159 var
160 CmdTarget : IOleCommandTarget;
161 vaIn, vaOut: OleVariant;
162 PtrGUID: PGUID;
163 begin
164 if (Self.Browser <> nil) and (Self.Browser.Document <> nil) then begin
165 New(PtrGUID);
166 PtrGUID^ := CGID_WebBrowser;
167 try
168 Self.Browser.Document.QueryInterface(IOleCommandTarget, CmdTarget);
169 if CmdTarget <> nil then begin
170 try
171 CmdTarget.Exec(PtrGUID, HTMLID_FIND, 0, vaIn, vaOut);
172 finally
173 CmdTarget._Release;
174 end;
175 end;
176 except
177 end;
178 Dispose(PtrGUID);
179 end;
180 end;
181
182 end.

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