| 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. |