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.3 - (show annotations) (download) (as text)
Tue Feb 21 15:35:49 2006 UTC (18 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_53_0_671, v1_54_0_677, v1_54_0_676, v1_52_1_658, v1_53_0_664, v1_52_0_647, v1_52_0_648, v1_53_0_661, v1_53_0_663, v1_53_0_662, v1_53_0_665, v1_53_0_667, v1_53_0_666, v1_53_0_669, v1_53_0_668, v1_52_0_651, v1_52_0_650, v1_52_0_652, v1_52_0_654, v1_53_0_672, v1_53_0_670, v1_54_0_675, root-of-Bb53, v1_52_1_657, v1_54_0_674, v1_52_0_660, v1_52_0_655, v1_52_0_656, v1_52_0_649, v1_53_1_673
Branch point for: Bb53, Bb52
Changes since 1.2: +2 -2 lines
File MIME type: text/x-pascal
マウスジェスチャー-の不具合とレス番指定URLを踏んだときの処理用に
TThreadItemを拡張

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 end;
36 // BrowserRecord???ゃ????????FBrowser??紊???
37 procedure ReleaseBrowser( BRecord: TBrowserRecord);
38
39 implementation
40
41 uses
42 Forms, SysUtils;
43
44 // *************************************************************************
45 //! BrowserRecord???ゃ????????FBrowser??紊???
46 // *************************************************************************
47 procedure ReleaseBrowser( BRecord: TBrowserRecord);
48 begin
49 if BRecord <> nil then begin
50 BRecord.Browser := nil;
51 if BRecord.Event <> nil then begin
52 BRecord.Event.Free;
53 BRecord.Event := nil;
54 end;
55 BRecord.Repaint := true;
56 end;
57 end;
58 // *************************************************************************
59 //! BrowserRecord?????鴻????????/span>
60 // *************************************************************************
61 destructor TBrowserRecord.Destroy;
62 var
63 doc :OleVariant;
64 begin
65 if Self.FEvent <> nil then
66 Self.FEvent.Free;
67 if Self.FBrowser <> nil then begin
68 if Self.Thread <> nil then begin
69 //?帥????奨???у奨?????????鴻????????祉??????????????????????????/span>
70 //???????????鴻?????若?????篆?絖????????障?????????????祉?c?????障????
71 if Self.FBrowser.OleObject.Document.documentElement.innerText <> '' then begin
72 doc := Idispatch( olevariant(Self.FBrowser.ControlInterface).Document) as IHTMLDocument2;
73 Self.Thread.ScrollTop := doc.Body.ScrollTop;
74 end;
75 end;
76 ShowWindow(Self.FBrowser.Handle, SW_HIDE);
77 end;
78
79 end;
80 // *************************************************************************
81 //! ???????吟???鴻?????若????????
82 // *************************************************************************
83 procedure TBrowserRecord.Move(const AName: string);
84 var
85 top: Integer;
86 item: OleVariant;
87 begin
88 //???????吟??篁???????????????????????
89 if (Self.Browser <> nil) then begin
90 //???????吟?????若?帥????粋昭?推賢????????粋昭?帥??緇???/span>
91 while (Self.Browser.ReadyState <> READYSTATE_COMPLETE) and
92 (Self.Browser.ReadyState <> READYSTATE_INTERACTIVE) do begin
93 Sleep(1);
94 Application.ProcessMessages;
95 end;
96
97 try
98 top := 0;
99 item := OleVariant( Self.Browser.Document as IHTMLDocument2)
100 .anchors.item(OleVariant(AName));
101 item.focus();
102 repeat
103 top := top + item.offsetTop;
104 item := item.offsetParent;
105 until AnsiCompareText(item.tagName, 'body' ) = 0;
106 OleVariant(Self.Browser.Document as IHTMLDocument2).body.scrollTop := top;
107 except
108 end;
109 end;
110 end;
111 //ID?≪?潟???取申??
112 procedure TBrowserRecord.IDAnchorPopup(Abody :string);
113 const
114 OUTER_HTML = '<p id="idSearch"></p>';
115 HIDDEN = 'hidden';
116 var
117 firstElement: IHTMLElement;
118 document: IHTMLDocument2;
119 docAll: IHTMLElementCollection;
120 doc : Variant;
121 nCSS : string;
122 begin
123 if Self.Browser <> nil then begin
124 try
125 document := Self.Browser.Document as IHTMLDocument2;
126
127 if Assigned(document) then begin
128 docAll := document.all;
129 firstElement := docAll.item('idSearch', 0) as IHTMLElement;
130 if (Assigned(firstElement)) then begin
131 if Length(Abody) > 0 then begin
132 doc := Idispatch( olevariant(Self.Browser.ControlInterface).Document) as IHTMLDocument2;
133 nCSS := '<p id="idSearch" style="position:absolute;top:' + IntToStr(doc.Body.ScrollTop + 10) + 'px;right:5px;' //
134 + 'background-color:window; border:outset 1px infobackground; z-index:10; overflow-y:auto; border-top:none">'
135 + Abody + '</p>';
136 firstElement.outerHTML := nCSS;
137 firstElement.style.visibility := 'visible';
138 end else begin
139 firstElement.outerHTML := OUTER_HTML;
140 firstElement.style.visibility := HIDDEN;
141 end;
142 end else if (Assigned(firstElement)) then begin
143 firstElement.outerHTML := OUTER_HTML;
144 firstElement.style.visibility := HIDDEN;
145 end;
146 end;
147 except
148 end;
149 end;
150 end;
151
152
153 end.

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