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); overload;
  34         procedure       Move(scroll: Integer); overload;
  35                 procedure       IDAnchorPopup(Abody :string);
  36         procedure OpenFindDialog;
  37         end;
  38         // BrowserRecord\82É\82Â\82¢\82Ä\82¢\82éFBrowser\82ð\8aO\82·
  39         procedure ReleaseBrowser( BRecord: TBrowserRecord);
  40
  41 implementation
  42
  43 uses
  44         Forms, SysUtils;
  45
  46 // *************************************************************************
  47 //! BrowserRecord\82É\82Â\82¢\82Ä\82¢\82éFBrowser\82ð\8aO\82·
  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\82Ì\83f\83X\83g\83\89\83N\83^
  62 // *************************************************************************
  63 destructor      TBrowserRecord.Destroy;
  64 var
  65         doc :IHTMLDocument2;
  66 begin
  67         if Self.FEvent <> nil then
  68                 Self.FEvent.Free;
  69
  70         if Self.FBrowser <> nil then begin
  71                 if Self.Thread <> nil then begin
  72                         //\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Å
  73                         //\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
  74
  75             try
  76                 doc := Self.FBrowser.ControlInterface.Document as IHTMLDocument2;
  77                 if Assigned(doc) then begin
  78                     if (doc as IHTMLDocument3).documentElement.innerText <> '' then begin
  79                         Self.Thread.ScrollTop := (doc.body as IHTMLElement2).scrollTop;
  80                             end;
  81                 end;
  82             except
  83             end;
  84                 end;
  85                 ShowWindow(Self.FBrowser.Handle, SW_HIDE);
  86         end;
  87
  88 end;
  89 // *************************************************************************
  90 //! \83u\83\89\83E\83U\82ð\83X\83N\83\8d\81[\83\8b\82³\82¹\82é
  91 // *************************************************************************
  92 procedure TBrowserRecord.Move(const AName: string);
  93 var
  94         top: Integer;
  95         item: OleVariant;
  96     doc : OleVariant;
  97 begin
  98         //\83u\83\89\83E\83U\82ª\95t\82¢\82Ä\82é\82Æ\82«\82¾\82¯\8f\88\97\9d\82·\82é
  99     if not Assigned(Self.Browser) then
 100         Exit;
 101
 102         //\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Â
 103         while (Self.Browser.ReadyState <> READYSTATE_COMPLETE) and
 104                         (Self.Browser.ReadyState <> READYSTATE_INTERACTIVE) do begin
 105                 Sleep(1);
 106                 Application.ProcessMessages;
 107         end;
 108
 109         try
 110         doc := Self.Browser.OleObject.Document;
 111                 top := 0;
 112                 item := doc.anchors.item(OleVariant(AName));
 113                 item.focus();
 114                 repeat
 115                         top := top + item.offsetTop;
 116                 item := item.offsetParent;
 117                 until AnsiCompareText(item.tagName, 'body' ) = 0;
 118                 doc.body.scrollTop := top;
 119         except
 120         end;
 121 end;
 122 // *************************************************************************
 123 //! \83u\83\89\83E\83U\82ð\83X\83N\83\8d\81[\83\8b\82³\82¹\82é
 124 // *************************************************************************
 125 procedure TBrowserRecord.Move(scroll: Integer);
 126 var
 127     doc: IHTMLDocument2;
 128 begin
 129         //\83u\83\89\83E\83U\82ª\95t\82¢\82Ä\82é\82Æ\82«\82¾\82¯\8f\88\97\9d\82·\82é
 130     if not Assigned(Self.Browser) then
 131         Exit;
 132
 133         //\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Â
 134         while (Self.Browser.ReadyState <> READYSTATE_COMPLETE) and
 135                                 (Self.Browser.ReadyState <> READYSTATE_INTERACTIVE) do begin
 136                 Sleep(1);
 137                 Application.ProcessMessages;
 138         end;
 139
 140         try
 141         doc := Self.Browser.ControlInterface.Document as IHTMLDocument2;
 142                 (doc.body as IHTMLElement2).scrollTop := (doc.body as IHTMLElement2).scrollTop + scroll;
 143         except
 144         end;
 145 end;
 146
 147 //ID\83A\83\93\83J\81[\92Ç\89Á
 148 procedure TBrowserRecord.IDAnchorPopup(Abody :string);
 149 const
 150         OUTER_HTML = '<p id="idSearch"></p>';
 151         HIDDEN = 'hidden';
 152 var
 153         firstElement: IHTMLElement;
 154         doc : IHTMLDocument2;
 155         nCSS : string;
 156 begin
 157     if not Assigned(Self.Browser) then
 158         Exit;
 159
 160         try
 161                 doc := Self.Browser.ControlInterface.Document as IHTMLDocument2;
 162                 if not Assigned(doc) then
 163             Exit;
 164
 165                 firstElement := doc.all.item('idSearch', 0) as IHTMLElement;
 166                 if not Assigned(firstElement) then
 167             Exit;
 168
 169         try
 170                 if Length(Abody) > 0 then begin
 171                         nCSS := '<p id="idSearch" style="position:absolute;top:' + IntToStr((doc.body as IHTMLElement2).ScrollTop + 10) + 'px;right:5px;' //
 172                                 + 'background-color:window; border:outset 1px infobackground; z-index:10; overflow-y:auto; border-top:none">'
 173                                     + Abody + '</p>';
 174                         firstElement.outerHTML := nCSS;
 175                         firstElement.style.visibility := 'visible';
 176                     end else begin
 177                             firstElement.outerHTML := OUTER_HTML;
 178                         firstElement.style.visibility := HIDDEN;
 179                 end;
 180             except
 181                     firstElement.outerHTML := OUTER_HTML;
 182                         firstElement.style.visibility := HIDDEN;
 183         end;
 184
 185         except
 186         end;
 187 end;
 188 {
 189 \brief \8c\9f\8dõ\83_\83C\83A\83\8d\83O\8cÄ\82Ñ\8fo\82µ
 190 }
 191 procedure TBrowserRecord.OpenFindDialog();
 192 const
 193         CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
 194         HTMLID_FIND = 1;
 195 var
 196         CmdTarget : IOleCommandTarget;
 197         vaIn, vaOut: OleVariant;
 198 begin
 199         if Assigned(Self.Browser) then begin
 200                 try
 201                         CmdTarget := Self.Browser.ControlInterface.Document as IOleCommandTarget;
 202                         if Assigned(CmdTarget) then begin
 203                                 CmdTarget.Exec(@CGID_WebBrowser, HTMLID_FIND, 0, vaIn, vaOut);
 204                         end;
 205                 except
 206                 end;
 207         end;
 208 end;
 209
 210 end.