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.7 - (show annotations) (download) (as text)
Sun Apr 15 16:21:29 2007 UTC (17 years ago) by h677
Branch: MAIN
CVS Tags: v1_56_0_715, v1_57_0_737, 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_56_0_707, v1_56_0_705, v1_56_0_704, v1_56_0_703, v1_56_0_702, v1_56_0_701, v1_56_0_700, v1_57_0_723, v1_57_0_725, v1_57_0_726, v1_57_0_727, v1_57_0_720, v1_57_0_722, v1_57_0_728, v1_57_0_729, v1_57_0_736, v1_57_0_719, v1_57_0_718, v1_56_0_716, v1_56_0_710, v1_56_0_711, v1_56_1_717, v1_56_1_716, v1_56_2_724, v1_56_2_722, v1_56_0_714, v1_56_0_712, v1_56_0_713, v1_56_0_721, marged_bRESPOPUP, v1_56_0_706, v1_57_0_742, v1_57_0_743, v1_57_0_740, v1_57_0_741, v1_56_0_709, v1_56_0_708, v1_56_0_699
Branch point for: Bb57, Bb56, bRESPOPUP
Changes since 1.6: +0 -3 lines
File MIME type: text/x-pascal
タブのポップアップメニューに同じ板のスレッドを開くメニューを追加してみた。
履歴でキーボードのEnterでスレッドを開くとエラーが出る不具合の修正。

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); overload;
34 procedure Move(scroll: Integer); overload;
35 procedure IDAnchorPopup(Abody :string);
36 procedure OpenFindDialog;
37 end;
38 // BrowserRecord???ゃ????????FBrowser??紊???
39 procedure ReleaseBrowser( BRecord: TBrowserRecord);
40
41 implementation
42
43 uses
44 Forms, SysUtils;
45
46 // *************************************************************************
47 //! BrowserRecord???ゃ????????FBrowser??紊???
48 // *************************************************************************
49 procedure ReleaseBrowser( BRecord: TBrowserRecord);
50 begin
51 if BRecord <> nil then begin
52 BRecord.Browser := nil;
53 if BRecord.Event <> nil then begin
54 BRecord.Event.Free;
55 BRecord.Event := nil;
56 end;
57 BRecord.Repaint := true;
58 end;
59 end;
60 // *************************************************************************
61 //! BrowserRecord?????鴻????????/span>
62 // *************************************************************************
63 destructor TBrowserRecord.Destroy;
64 var
65 doc :OleVariant;
66 begin
67 if Self.FEvent <> nil then
68 Self.FEvent.Free;
69 if Self.FBrowser <> nil then begin
70 if Self.Thread <> nil then begin
71 //?帥????奨???у奨?????????鴻????????祉??????????????????????????/span>
72 //???????????鴻?????若?????篆?絖????????障?????????????祉?c?????障????
73 if Self.FBrowser.OleObject.Document.documentElement.innerText <> '' then begin
74 doc := Idispatch( olevariant(Self.FBrowser.ControlInterface).Document) as IHTMLDocument2;
75 Self.Thread.ScrollTop := doc.Body.ScrollTop;
76 end;
77 end;
78 ShowWindow(Self.FBrowser.Handle, SW_HIDE);
79 end;
80
81 end;
82 // *************************************************************************
83 //! ???????吟???鴻?????若????????
84 // *************************************************************************
85 procedure TBrowserRecord.Move(const AName: string);
86 var
87 top: Integer;
88 item: OleVariant;
89 begin
90 //???????吟??篁???????????????????????
91 if (Self.Browser <> nil) then begin
92 //???????吟?????若?帥????粋昭?推賢????????粋昭?帥??緇???/span>
93 while (Self.Browser.ReadyState <> READYSTATE_COMPLETE) and
94 (Self.Browser.ReadyState <> READYSTATE_INTERACTIVE) do begin
95 Sleep(1);
96 Application.ProcessMessages;
97 end;
98
99 try
100 top := 0;
101 item := OleVariant( Self.Browser.Document as IHTMLDocument2)
102 .anchors.item(OleVariant(AName));
103 item.focus();
104 repeat
105 top := top + item.offsetTop;
106 item := item.offsetParent;
107 until AnsiCompareText(item.tagName, 'body' ) = 0;
108 OleVariant(Self.Browser.Document as IHTMLDocument2).body.scrollTop := top;
109 except
110 end;
111 end;
112 end;
113 // *************************************************************************
114 //! ???????吟???鴻?????若????????
115 // *************************************************************************
116 procedure TBrowserRecord.Move(scroll: Integer);
117 begin
118 //???????吟??篁???????????????????????
119 if (Self.Browser <> nil) then begin
120 //???????吟?????若?帥????粋昭?推賢????????粋昭?帥??緇???/span>
121 while (Self.Browser.ReadyState <> READYSTATE_COMPLETE) and
122 (Self.Browser.ReadyState <> READYSTATE_INTERACTIVE) do begin
123 Sleep(1);
124 Application.ProcessMessages;
125 end;
126
127 try
128 OleVariant(Self.Browser.Document as IHTMLDocument2).body.scrollTop
129 := OleVariant(Self.Browser.Document as IHTMLDocument2).body.scrollTop
130 + scroll;
131 except
132 end;
133 end;
134 end;
135
136 //ID?≪?潟???取申??
137 procedure TBrowserRecord.IDAnchorPopup(Abody :string);
138 const
139 OUTER_HTML = '<p id="idSearch"></p>';
140 HIDDEN = 'hidden';
141 var
142 firstElement: IHTMLElement;
143 document: IHTMLDocument2;
144 docAll: IHTMLElementCollection;
145 doc : Variant;
146 nCSS : string;
147 begin
148 if Self.Browser <> nil then begin
149 try
150 document := Self.Browser.Document as IHTMLDocument2;
151
152 if Assigned(document) then begin
153 docAll := document.all;
154 firstElement := docAll.item('idSearch', 0) as IHTMLElement;
155 if (Assigned(firstElement)) then begin
156 if Length(Abody) > 0 then begin
157 doc := Idispatch( olevariant(Self.Browser.ControlInterface).Document) as IHTMLDocument2;
158 nCSS := '<p id="idSearch" style="position:absolute;top:' + IntToStr(doc.Body.ScrollTop + 10) + 'px;right:5px;' //
159 + 'background-color:window; border:outset 1px infobackground; z-index:10; overflow-y:auto; border-top:none">'
160 + Abody + '</p>';
161 firstElement.outerHTML := nCSS;
162 firstElement.style.visibility := 'visible';
163 end else begin
164 firstElement.outerHTML := OUTER_HTML;
165 firstElement.style.visibility := HIDDEN;
166 end;
167 end else if (Assigned(firstElement)) then begin
168 firstElement.outerHTML := OUTER_HTML;
169 firstElement.style.visibility := HIDDEN;
170 end;
171 end;
172 except
173 end;
174 end;
175 end;
176 {
177 \brief 罎?膣≪???ゃ?≪???医?若?喝?冴??
178 }
179 procedure TBrowserRecord.OpenFindDialog();
180 const
181 CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
182 HTMLID_FIND = 1;
183 var
184 CmdTarget : IOleCommandTarget;
185 vaIn, vaOut: OleVariant;
186 PtrGUID: PGUID;
187 begin
188 if (Self.Browser <> nil) and (Self.Browser.Document <> nil) then begin
189 //???????吟?????若?帥????粋昭?推賢????????粋昭?帥??緇???/span>
190 while (Self.Browser.ReadyState <> READYSTATE_COMPLETE) and
191 (Self.Browser.ReadyState <> READYSTATE_INTERACTIVE) do begin
192 Sleep(1);
193 Application.ProcessMessages;
194 end;
195 vaIn := 0;
196 vaOut := 0;
197 New(PtrGUID);
198 PtrGUID^ := CGID_WebBrowser;
199 try
200 try
201 if Self.Browser.Document
202 .QueryInterface(IOleCommandTarget, CmdTarget)
203 = S_OK then begin
204 if CmdTarget <> nil then begin
205 try
206 CmdTarget.Exec(PtrGUID, HTMLID_FIND, 0, vaIn, vaOut);
207 finally
208 CmdTarget._Release;
209 end;
210 end;
211 end;
212 except
213 end;
214 finally
215 Dispose(PtrGUID);
216 end;
217 end;
218 end;
219
220 end.

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