| 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 |
begin |
| 187 |
if Assigned(Self.Browser) then begin |
| 188 |
vaIn := 0; |
| 189 |
vaOut := 0; |
| 190 |
try |
| 191 |
CmdTarget := Self.Browser.ControlInterface.Document as IOleCommandTarget; |
| 192 |
if Assigned(CmdTarget) then begin |
| 193 |
CmdTarget.Exec(@CGID_WebBrowser, HTMLID_FIND, 0, vaIn, vaOut); |
| 194 |
end; |
| 195 |
except |
| 196 |
end; |
| 197 |
end; |
| 198 |
end; |
| 199 |
|
| 200 |
end. |