BrowserRecord.pas

   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; ///< \83u\83\89\83E\83U\83h\83L\83\85\83\81\83\93\83g\83C\83x\83\93\83g
  21                 FThread         : TThreadItem;
  22                 FLastSize       : Integer;
  23                 FRepaint        : Boolean;
  24                 //FMovement     : string;                                                       ///< \83X\83N\83\8d\81[\83\8b\90æ\83A\83\93\83J\81[
  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\82É\82Â\82¢\82Ä\82¢\82éFBrowser\82ð\8aO\82·
  38         procedure ReleaseBrowser( BRecord: TBrowserRecord);
  39
  40 implementation
  41
  42 uses
  43         Forms, SysUtils;
  44
  45 // *************************************************************************
  46 //! BrowserRecord\82É\82Â\82¢\82Ä\82¢\82éFBrowser\82ð\8aO\82·
  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\82Ì\83f\83X\83g\83\89\83N\83^
  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                         //\83^\83u\82Ì\95\9c\8c³\82Å\95\9c\8c³\82³\82ê\82½\83X\83\8c\82Í\81A\95`\89æ\82³\82ê\82Ä\82¢\82È\82¢\82Æ\82«\82ª\82 \82é\82Ì\82Å
  71                         //\82»\82Ì\82Æ\82«\82Ì\83X\83N\83\8d\81[\83\8b\97Ê\82ð\95Û\91¶\82µ\82Ä\82µ\82Ü\82¤\82Æ\83g\83b\83v\82É\96ß\82Á\82Ä\82µ\82Ü\82¤\81B
  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 //! \83u\83\89\83E\83U\82ð\83X\83N\83\8d\81[\83\8b\82³\82¹\82é
  83 // *************************************************************************
  84 procedure TBrowserRecord.Move(const AName: string);
  85 var
  86         top: Integer;
  87         item: OleVariant;
  88 begin
  89         //\83u\83\89\83E\83U\82ª\95t\82¢\82Ä\82é\82Æ\82«\82¾\82¯\8f\88\97\9d\82·\82é
  90         if (Self.Browser <> nil) then begin
  91                 //\83u\83\89\83E\83U\82ª\83f\81[\83^\82Ì\93Ç\82Ý\8d\9e\82Ý\92\86\82Ì\8e\9e\82Í\93Ç\82Ý\8d\9e\82Ý\82ð\91Ò\82Â
  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\83A\83\93\83J\81[\92Ç\89Á
 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 \8c\9f\8dõ\83_\83C\83A\83\8d\83O\8cÄ\82Ñ\8fo\82µ
 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.