Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/Giko.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.664 by h677, Thu Mar 13 16:42:23 2008 UTC revision 1.665 by eggcake, Sun Apr 13 04:20:24 2008 UTC
# Line 903  begin Line 903  begin
903  {$ENDIF}  {$ENDIF}
904  //try  //try
905          Sort.SetSortDate(Now());          Sort.SetSortDate(Now());
906            
907          FTreeType := gttNone;          FTreeType := gttNone;
908          // 起動時に保存されてしまう対策          // 起動時に保存されてしまう対策
909          FStartUp := true;          FStartUp := true;
# Line 1545  var Line 1545  var
1545          i                               : Integer;          i                               : Integer;
1546          wp                      : TWindowPlacement;          wp                      : TWindowPlacement;
1547          tmpBool : Boolean;          tmpBool : Boolean;
1548        doc:IHTMLDocument2;
1549  begin  begin
1550          // マウスジェスチャー開放          // マウスジェスチャー開放
1551          try          try
# Line 1630  begin Line 1631  begin
1631          end;          end;
1632          try          try
1633                  for i := FBrowsers.Count - 1 downto 0 do begin                  for i := FBrowsers.Count - 1 downto 0 do begin
1634                GikoSys.ShowRefCount('browser' + IntToStr(i), TWebBrowser(FBrowsers[i]).ControlInterface);
1635                GikoSys.ShowRefCount('document' + IntToStr(i), TWebBrowser(FBrowsers[i]).ControlInterface.Document);
1636                    end;
1637    
1638                    for i := FBrowsers.Count - 1 downto 0 do begin
1639                          TWebBrowser(FBrowsers[i]).Free;                          TWebBrowser(FBrowsers[i]).Free;
1640                  end;                  end;
1641                  FBrowsers.Clear;                  FBrowsers.Clear;
# Line 1909  var Line 1915  var
1915          e: IHTMLElement;          e: IHTMLElement;
1916          Ext: string;          Ext: string;
1917          PathRec: TPathRec;          PathRec: TPathRec;
1918    Text2: string;      Text2: string;
1919      cResPopup: TResPopupBrowser;      cResPopup: TResPopupBrowser;
1920        senderBrowser :TWebBrowser;
1921        doc: IHTMLDocument2;
1922  begin  begin
1923          // ギコナビはレスアンカーが about:blank.. で始まることを期待しているが      // ギコナビはレスアンカーが about:blank.. で始まることを期待しているが
1924    // IE 7 では about:blank.. ではなく about:.. になるので、置換する(投げやり)      // IE 7 では about:blank.. ではなく about:.. になるので、置換する(投げやり)
1925          if Pos('about:..', Text) = 1 then      if Pos('about:..', Text) = 1 then
1926          Text2 := 'about:blank..' + Copy( Text, Length('about:..')+1, Length(Text) )          Text2 := 'about:blank..' + Copy( Text, Length('about:..')+1, Length(Text) )
1927    else      else
1928          Text2 := Text;          Text2 := Text;
1929    
1930          if not( TObject(Sender) is TWebBrowser )then          if not( TObject(Sender) is TWebBrowser )then
1931                  Exit;                  Exit;
1932    
1933        senderBrowser := TWebBrowser(Sender);
1934        doc := senderBrowser.ControlInterface.Document as IHTMLDocument2;
1935    
1936          try          try
1937                  try                  try
1938                          if (TWebBrowser(Sender) <> nil) and (not TWebBrowser(Sender).Busy) and (Assigned(TWebBrowser(Sender).Document)) then begin                          if ((not senderBrowser.Busy) and Assigned(doc)) then begin
1939                                  if LowerCase(OleVariant(IHTMLDocument2(TWebBrowser(Sender).Document)).charset) <> 'shift_jis' then begin                                  if LowerCase(doc.charset) <> 'shift_jis' then begin
1940                                          OleVariant(IHTMLDocument2(TWebBrowser(Sender).Document)).charset := 'shift_jis';                                          doc.charset := 'shift_jis';
1941                                  end;                                  end;
1942                          end;                          end;
1943                  except                  except
1944                  end;                  end;
1945          finally          finally
1946          end;          end;
1947    
1948          if PreviewTimer.Enabled then          if PreviewTimer.Enabled then
1949                  PreviewTimer.Enabled := False;                  PreviewTimer.Enabled := False;
1950    
1951          Application.CancelHint;          Application.CancelHint;
1952    
1953          try          try
1954                  if GetActiveContent <> nil then                  if GetActiveContent <> nil then
1955                          ActiveFileName := ChangeFileExt(ExtractFileName(GetActiveContent.FileName), '')                          ActiveFileName := ChangeFileExt(ExtractFileName(GetActiveContent.FileName), '')
# Line 1943  begin Line 1959  begin
1959                  FActiveContent := nil;                  FActiveContent := nil;
1960                  Exit;                  Exit;
1961          end;          end;
1962    
1963      // 前回と同じ場合終了      // 前回と同じ場合終了
1964      if (StatusBar.Panels[1].Text = Text2) then begin      if (StatusBar.Panels[1].Text = Text2) then begin
1965          if Text2 = '' then begin          if Text2 = '' then begin
# Line 2014  begin Line 2031  begin
2031                          s := StringReplace(Text2, 'mailto:', '', [rfIgnoreCase]);                          s := StringReplace(Text2, 'mailto:', '', [rfIgnoreCase]);
2032                          //ギコナビスレ パート3の466氏に感謝                          //ギコナビスレ パート3の466氏に感謝
2033                          GetCursorPos(p);                          GetCursorPos(p);
2034                          p.x := p.x - TWebBrowser(Sender).ClientOrigin.x;                          p.x := p.x - senderBrowser.ClientOrigin.x;
2035                          p.y := p.y - TWebBrowser(Sender).ClientOrigin.y;                          p.y := p.y - senderBrowser.ClientOrigin.y;
2036                          e := IHTMLDocument2(TWebBrowser(Sender).Document).elementFromPoint(p.x, p.y);                          e := doc.elementFromPoint(p.x, p.y);
2037                          if (Assigned(e)) then begin                          if (Assigned(e)) then begin
2038                  CreateResPopupBrowser;                  CreateResPopupBrowser;
2039    
# Line 2806  var Line 2823  var
2823          BBSID: string;          BBSID: string;
2824          FileName: string;          FileName: string;
2825          sTitle: string;          sTitle: string;
2826          doc: Variant;          doc: OleVariant;
2827          s: string;          s: string;
2828          idx: Integer;          idx: Integer;
2829          ThreadItem: TThreadItem;          ThreadItem: TThreadItem;
# Line 2820  begin Line 2837  begin
2837          (FActiveContent <> nil) and          (FActiveContent <> nil) and
2838                  (FActiveContent.Thread <> Thread.Thread) and                  (FActiveContent.Thread <> Thread.Thread) and
2839                  (FActiveContent.Browser <> nil) and                  (FActiveContent.Browser <> nil) and
2840                  (Assigned(FActiveContent.Browser.Document)) then begin                  (Assigned(FActiveContent.Browser.ControlInterface.Document)) then begin
2841                  try          try
2842                  try              try
2843                          FActiveContent.Thread.ScrollTop := OleVariant(IHTMLDocument2(FActiveContent.Browser.Document).Body).ScrollTop;                  FActiveContent.Thread.ScrollTop := FActiveContent.Browser.OleObject.Document.Body.ScrollTop;
2844                  except              except
2845                          on E: Exception do              on E: Exception do
2846                                  MsgBox(Handle, E.Message, 'SetContent[<-ScrollTop]', 0);                  MsgBox(Handle, E.Message, 'SetContent[<-ScrollTop]', 0);
2847                  end;          end;
2848                  finally                  finally
2849                  end;                  end;
2850          end;          end;
# Line 2879  begin Line 2896  begin
2896                                  ShowWindow(FActiveContent.Browser.Handle, SW_HIDE);                                  ShowWindow(FActiveContent.Browser.Handle, SW_HIDE);
2897                  end;                  end;
2898                  ShowWindow(Thread.Browser.Handle, SW_SHOW);                  ShowWindow(Thread.Browser.Handle, SW_SHOW);
2899                  if (not Assigned(Thread.Browser.Document)) then begin                  if (not Assigned(Thread.Browser.ControlInterface.Document)) then begin
2900                          Thread.Browser.Navigate('about:blank');                          Thread.Browser.Navigate('about:blank');
2901                  end;                  end;
2902                  while (Thread.Browser.ReadyState <> READYSTATE_COMPLETE) and                  while (Thread.Browser.ReadyState <> READYSTATE_COMPLETE) and
# Line 2917  begin Line 2934  begin
2934                          try                          try
2935                                  Thread.Browser.BringToFront;                                  Thread.Browser.BringToFront;
2936                                  s := '<HTML><BODY><CENTER>このスレッドは取得していません</CENTER></BODY></HTML>';                                  s := '<HTML><BODY><CENTER>このスレッドは取得していません</CENTER></BODY></HTML>';
2937                                  doc := Idispatch( olevariant(Thread.Browser.ControlInterface).Document) as IHTMLDocument2;                                  doc := Thread.Browser.OleObject.Document;
2938                                  doc.open;                                  doc.open;
2939                                  doc.charset := 'Shift_JIS';                                  doc.charset := 'Shift_JIS';
2940                                  doc.Write(s);                                  doc.Write(s);
# Line 3648  begin Line 3665  begin
3665  end;  end;
3666  procedure TGikoForm.DeleteTab(index, selectIndex: Integer);  procedure TGikoForm.DeleteTab(index, selectIndex: Integer);
3667  var  var
3668      doc: Variant;      browserRec : TBrowserRecord;
3669        doc: OleVariant;
3670      j: Integer;      j: Integer;
3671  begin  begin
3672        browserRec := TBrowserRecord(BrowserTab.Tabs.Objects[index]);
3673      try      try
3674          if TBrowserRecord(BrowserTab.Tabs.Objects[index]).Browser <> nil then begin          if browserRec.Browser <> nil then begin
3675              doc := TBrowserRecord(BrowserTab.Tabs.Objects[index]).Browser.Document;              doc := browserRec.Browser.OleObject.Document;
3676              TBrowserRecord(BrowserTab.Tabs.Objects[index]).Thread.ScrollTop := doc.Body.ScrollTop;              browserRec.Thread.ScrollTop := doc.Body.ScrollTop;
3677          end;          end;
3678      except      except
3679          TBrowserRecord(BrowserTab.Tabs.Objects[index]).Thread.ScrollTop := 0;          browserRec.Thread.ScrollTop := 0;
3680      end;      end;
3681      if(FActiveContent = TBrowserRecord(BrowserTab.Tabs.Objects[index])) then  
3682        if(FActiveContent = browserRec) then
3683          FActiveContent := nil;          FActiveContent := nil;
3684      if TBrowserRecord(BrowserTab.Tabs.Objects[index]).Browser <> nil then begin      if browserRec.Browser <> nil then begin
3685          j := FBrowsers.IndexOf(TBrowserRecord(BrowserTab.Tabs.Objects[index]).Browser);          j := FBrowsers.IndexOf(browserRec.Browser);
3686          if j <> -1 then          if j <> -1 then
3687              FBrowsers.Move(j, BROWSER_COUNT - 1);              FBrowsers.Move(j, BROWSER_COUNT - 1);
3688      end;      end;
3689    
3690      BrowserTab.Tabs.BeginUpdate;      BrowserTab.Tabs.BeginUpdate;
3691      try      try
3692          GikoSys.Setting.LastCloseTabURL :=          GikoSys.Setting.LastCloseTabURL := browserRec.Thread.URL;
3693              TBrowserRecord(BrowserTab.Tabs.Objects[index]).Thread.URL;          browserRec.Free;
         TBrowserRecord(BrowserTab.Tabs.Objects[index]).Free;  
3694          if ( BrowserTab.Tabs.Count - 1 = index ) and          if ( BrowserTab.Tabs.Count - 1 = index ) and
3695              ( BrowserTab.TabRect(index).Left              ( BrowserTab.TabRect(index).Left
3696                  <= BrowserTab.DisplayRect.Left ) then begin                  <= BrowserTab.DisplayRect.Left ) then begin
# Line 3691  begin Line 3711  begin
3711      if BrowserTab.Tabs.Count = 0 then begin      if BrowserTab.Tabs.Count = 0 then begin
3712          BrowserNullTab.Thread := nil;          BrowserNullTab.Thread := nil;
3713      end;      end;
3714    
3715      if(BrowserTab.TabIndex <> -1) and      if(BrowserTab.TabIndex <> -1) and
3716          ( TBrowserRecord(BrowserTab.Tabs.Objects[BrowserTab.TabIndex]).Browser = nil) then begin          ( TBrowserRecord(BrowserTab.Tabs.Objects[BrowserTab.TabIndex]).Browser = nil) then begin
3717          // 一番古いブラウザを開放する          // 一番古いブラウザを開放する
# Line 3843  var Line 3864  var
3864      BNum, BRes: string;      BNum, BRes: string;
3865      threadItem: TThreadItem;      threadItem: TThreadItem;
3866      aElement : IHTMLElement;      aElement : IHTMLElement;
3867        senderBrowser : TWebBrowser;
3868        doc : IHTMLDocument2;
3869  begin  begin
3870  {$IFDEF DEBUG}  {$IFDEF DEBUG}
3871          Writeln(IntToStr(Integer(ppDisp)));          Writeln(IntToStr(Integer(ppDisp)));
3872  {$ENDIF}  {$ENDIF}
3873          Cancel := True;          Cancel := True;
     aElement := IHTMLDocument2(TWebBrowser(Sender).Document).activeElement;  
         if ( aElement <> nil) then begin  
                 Text := aElement.Get_outerText;  
                 Html := aElement.Get_outerHTML;  
                 if(AnsiPos('>>', Text) = 1) or (AnsiPos('>', Text) = 1)  
                         or (AnsiPos('>>', Text) = 1) or (AnsiPos('>', Text) = 1) then begin  
                         if GikoSys.Setting.ResAnchorJamp then begin  
   
                                 Text := ZenToHan(Trim(Text));  
   
                                 if(AnsiPos('>>', Text) = 1) then begin  
                                         //Text := Copy(Text, 3, Length(Text) - 2);  
                                         Delete(Text, 1, 2);  
                                 end else begin  
                                         //Text := Copy(Text, 2, Length(Text) - 1);  
                                         Delete(Text, 1, 1);  
                                 end;  
3874    
3875                                  if AnsiPos('-', Text) <> 0 then begin          if not( TObject(Sender) is TWebBrowser )then
3876                                          wkIntSt := StrToIntDef(Copy(Text, 1, AnsiPos('-', Text) - 1), 0);                  Exit;
                                         Text := Copy(Text, AnsiPos('-', Text) + 1, Length(Text));  
                                         wkIntTo := StrToIntDef(Text, 0);  
                                         if wkIntTo < wkIntSt then  
                                                 wkIntSt := wkIntTo;  
                                 end else begin  
                                         wkIntSt := StrToIntDef(Text, 0);  
                                 end;  
3877    
3878                                  if wkIntSt <> 0 then begin      senderBrowser := TWebBrowser(Sender);
3879                          FActiveContent.IDAnchorPopup('');      doc := senderBrowser.ControlInterface.Document as IHTMLDocument2;
3880                      MoveHisotryManager.pushItem(FActiveContent);          if not Assigned(doc) then
3881                      if (Sender is TResPopupBrowser) then begin                  Exit;
3882                          TResPopupBrowser(Sender).ChildClear;  
3883                          OpenThreadItem(          aElement := doc.activeElement;
3884                              GetActiveContent(true),          if not Assigned(aElement) then
3885                              GetActiveContent(true).URL + '&st=' +                  Exit;
3886                                   IntToStr(wkIntSt) + '&to=' + IntToStr(wkIntSt));  
3887                      end else begin          Text := aElement.Get_outerText;
3888                                          BrowserMovement(IntToStr(wkIntSt));          Html := aElement.Get_outerHTML;
3889                      end;  
3890                  end;          if(AnsiPos('>>', Text) = 1) or (AnsiPos('>', Text) = 1)
3891                    or (AnsiPos('>>', Text) = 1) or (AnsiPos('>', Text) = 1) then begin
3892                    if GikoSys.Setting.ResAnchorJamp then begin
3893    
3894                            Text := ZenToHan(Trim(Text));
3895    
3896                            if(AnsiPos('>>', Text) = 1) then begin
3897                                    //Text := Copy(Text, 3, Length(Text) - 2);
3898                                    Delete(Text, 1, 2);
3899                            end else begin
3900                                    //Text := Copy(Text, 2, Length(Text) - 1);
3901                                    Delete(Text, 1, 1);
3902                          end;                          end;
                 end else begin  
             ////'http://be.2ch.net/test/p.php?i='+id+'&u=d:'+bas+num  
3903    
3904                          URL := GikoSys.GetHRefText(Html);                          if AnsiPos('-', Text) <> 0 then begin
3905                          URL := GikoSys.HTMLDecode(URL);                                  wkIntSt := StrToIntDef(Copy(Text, 1, AnsiPos('-', Text) - 1), 0);
3906              if AnsiPos('BE:', URL) = 1 then begin                                  Text := Copy(Text, AnsiPos('-', Text) + 1, Length(Text));
3907                                  BNum := Copy(URL, 4, AnsiPos('/', URL) - 4);                                  wkIntTo := StrToIntDef(Text, 0);
3908                                  BRes := Copy(URL, AnsiPos('/', URL) + 1,  Length(URL));                                  if wkIntTo < wkIntSt then
3909                  threadItem := FActiveContent.Thread;                                          wkIntSt := wkIntTo;
3910                  if threadItem = nil then Exit;                          end else begin
3911                  URL := BE_PHP_URL + BNum + '&u=d'                                  wkIntSt := StrToIntDef(Text, 0);
3912                          + CustomStringReplace(threadItem.URL, 'l50', '') + BRes;                          end;
             end;  
3913    
3914                          if( AnsiPos('http://', URL) = 1) or (AnsiPos('https://', URL) = 1) or                          if wkIntSt <> 0 then begin
3915                                  ( AnsiPos('ftp://', URL) = 1) then begin                  FActiveContent.IDAnchorPopup('');
3916                                  //アドレスバーの履歴                  MoveHisotryManager.pushItem(FActiveContent);
                                 if GikoSys.Setting.LinkAddAddressBar then begin  
                                         idx := AddressComboBox.Items.IndexOf(URL);  
                                         if idx = -1 then begin  
                                                 AddressComboBox.Items.Insert(0, URL);  
                                                 if AddressComboBox.Items.Count > GikoSys.Setting.AddressHistoryCount then  
                                                         AddressComboBox.Items.Delete(AddressComboBox.Items.Count - 1);  
                                         end else begin  
                                                 AddressComboBox.Items.Delete(idx);  
                                                 AddressComboBox.Items.Insert(0, URL);  
                                         end;  
                                 end;  
3917                  if (Sender is TResPopupBrowser) then begin                  if (Sender is TResPopupBrowser) then begin
3918                      TResPopupBrowser(Sender).ChildClear                      TResPopupBrowser(Sender).ChildClear;
3919                        OpenThreadItem(
3920                            GetActiveContent(true),
3921                            GetActiveContent(true).URL + '&st=' +
3922                                 IntToStr(wkIntSt) + '&to=' + IntToStr(wkIntSt));
3923                    end else begin
3924                                            BrowserMovement(IntToStr(wkIntSt));
3925                  end;                  end;
3926                end;
3927                    end;
3928            end else begin
3929            ////'http://be.2ch.net/test/p.php?i='+id+'&u=d:'+bas+num
3930    
3931                  MoveHisotryManager.pushItem(FActiveContent);                  URL := GikoSys.GetHRefText(Html);
3932                                  MoveToURL( URL );                  URL := GikoSys.HTMLDecode(URL);
3933            if AnsiPos('BE:', URL) = 1 then begin
3934                            BNum := Copy(URL, 4, AnsiPos('/', URL) - 4);
3935                            BRes := Copy(URL, AnsiPos('/', URL) + 1,  Length(URL));
3936                threadItem := FActiveContent.Thread;
3937                if threadItem = nil then Exit;
3938                URL := BE_PHP_URL + BNum + '&u=d'
3939                    + CustomStringReplace(threadItem.URL, 'l50', '') + BRes;
3940            end;
3941    
3942                    if( AnsiPos('http://', URL) = 1) or (AnsiPos('https://', URL) = 1) or
3943                            ( AnsiPos('ftp://', URL) = 1) then begin
3944                            //アドレスバーの履歴
3945                            if GikoSys.Setting.LinkAddAddressBar then begin
3946                                    idx := AddressComboBox.Items.IndexOf(URL);
3947                                    if idx = -1 then begin
3948                                            AddressComboBox.Items.Insert(0, URL);
3949                                            if AddressComboBox.Items.Count > GikoSys.Setting.AddressHistoryCount then
3950                                                    AddressComboBox.Items.Delete(AddressComboBox.Items.Count - 1);
3951                                    end else begin
3952                                            AddressComboBox.Items.Delete(idx);
3953                                            AddressComboBox.Items.Insert(0, URL);
3954                                    end;
3955                          end;                          end;
3956                if (Sender is TResPopupBrowser) then begin
3957                    TResPopupBrowser(Sender).ChildClear
3958                end;
3959    
3960                MoveHisotryManager.pushItem(FActiveContent);
3961                            MoveToURL( URL );
3962                  end;                  end;
3963      end;          end;
3964    
3965  end;  end;
3966    
# Line 4161  end; Line 4195  end;
4195  procedure TGikoForm.BrowserDocumentComplete(Sender: TObject;  procedure TGikoForm.BrowserDocumentComplete(Sender: TObject;
4196          const pDisp: IDispatch; var URL: OleVariant);          const pDisp: IDispatch; var URL: OleVariant);
4197  var  var
         FDispHtmlDocument: DispHTMLDocument;  
4198          BrowserRecord :TBrowserRecord;          BrowserRecord :TBrowserRecord;
4199          i :Integer;          i :Integer;
4200          doc                                     : Variant;          doc     : IHTMLDocument2;
4201          threadItem      : TThreadItem;          threadItem      : TThreadItem;
4202  begin  begin
4203          if TObject(Sender) is TWebBrowser then begin          if TObject(Sender) is TWebBrowser then begin
# Line 4179  begin Line 4212  begin
4212                          if BrowserRecord <> nil then begin                          if BrowserRecord <> nil then begin
4213                                  if BrowserRecord.Event <> nil then                                  if BrowserRecord.Event <> nil then
4214                                          BrowserRecord.Event.Free;                                          BrowserRecord.Event.Free;
4215                                  FDispHtmlDocument := Idispatch(OleVariant(BrowserRecord.Browser.ControlInterface).Document) as DispHTMLDocument;                                  BrowserRecord.Event := THTMLDocumentEventSink.Create(Self, BrowserRecord.Browser.ControlInterface.Document, HTMLDocumentEvents2);
                                 BrowserRecord.Event := THTMLDocumentEventSink.Create(Self, FDispHtmlDocument, HTMLDocumentEvents2);  
4216                                  BrowserRecord.Event.OnContextMenu := OnDocumentContextMenu;                                  BrowserRecord.Event.OnContextMenu := OnDocumentContextMenu;
4217                                  BrowserRecord.Event.OnClick := WebBrowserClick;  //追加したOnClickイベント                                  BrowserRecord.Event.OnClick := WebBrowserClick;  //追加したOnClickイベント
4218                          end;                          end;
4219                  end else begin                  end else begin
4220                          if GetActiveContent <> nil then begin                          if GetActiveContent <> nil then begin
                                 FDispHtmlDocument := Idispatch(OleVariant(Browser.ControlInterface).Document) as DispHTMLDocument;  
4221                                  if FEvent <> nil then                                  if FEvent <> nil then
4222                                          FEvent.Free;                                          FEvent.Free;
4223                                  FEvent := THTMLDocumentEventSink.Create(Self, FDispHtmlDocument, HTMLDocumentEvents2);                                  FEvent := THTMLDocumentEventSink.Create(Self, Browser.ControlInterface.Document, HTMLDocumentEvents2);
4224                                  FEvent.OnContextMenu := OnDocumentContextMenu;                                  FEvent.OnContextMenu := OnDocumentContextMenu;
4225                                  FEvent.OnClick := WebBrowserClick;  //追加したOnClickイベント                                  FEvent.OnClick := WebBrowserClick;  //追加したOnClickイベント
4226                          end else begin                          end else begin
# Line 4227  begin Line 4258  begin
4258                                  RefreshListView(threadItem);                                  RefreshListView(threadItem);
4259                          end else if threadItem.ScrollTop <> 0 then begin                          end else if threadItem.ScrollTop <> 0 then begin
4260                                  try                                  try
4261                                          doc := Idispatch( OleVariant( BrowserRecord.Browser.ControlInterface ).Document ) as IHTMLDocument2;                                          doc := BrowserRecord.Browser.ControlInterface.Document as IHTMLDocument2;
4262                                          doc.Body.ScrollTop := threadItem.ScrollTop;                                          (doc.body as IHTMLElement2).ScrollTop := threadItem.ScrollTop;
4263                                  except                                  except
4264                                          on E: Exception do                                          on E: Exception do
4265                                                  MsgBox(Handle, E.Message, 'SetContent[ScrollTop<-]', 0);                                                  MsgBox(Handle, E.Message, 'SetContent[ScrollTop<-]', 0);
# Line 4553  var Line 4584  var
4584          stRes, edRes : Int64;          stRes, edRes : Int64;
4585          browserRec : TBrowserRecord;          browserRec : TBrowserRecord;
4586          threadNumber : String;          threadNumber : String;
4587          doc : Variant;          doc : IHTMLDocument2;
4588  begin  begin
4589          stRes := 0;          stRes := 0;
4590          edRes := 0;          edRes := 0;
# Line 4581  begin Line 4612  begin
4612                          browserRec.Move(IntToStr(stRes));                          browserRec.Move(IntToStr(stRes));
4613                          Thread.JumpAddress := 0;                          Thread.JumpAddress := 0;
4614                          try                          try
4615                                  doc := Idispatch( OleVariant( browserRec.Browser.ControlInterface ).Document ) as IHTMLDocument2;                  doc := browserRec.Browser.ControlInterface.Document as IHTMLDocument2;
4616                                  Thread.ScrollTop := doc.Body.ScrollTop;                  if Assigned(doc) then
4617                                    Thread.ScrollTop := (doc.body as IHTMLElement2).ScrollTop;
4618                          except                          except
4619                          end;                          end;
4620                  end;                  end;
# Line 4783  end; Line 4815  end;
4815    
4816  procedure TGikoForm.WndProc(var Message: TMessage);  procedure TGikoForm.WndProc(var Message: TMessage);
4817  var  var
4818          senderBrowser   : TWebBrowser;          senderBrowser : TWebBrowser;
4819          url                                             : OleVariant;          url : OleVariant;
4820  begin  begin
4821          try          try
4822                  case Message.Msg of                  case Message.Msg of
# Line 4944  end; Line 4976  end;
4976    
4977  function TGikoForm.OnDocumentContextMenu(Sender: TObject): WordBool;  function TGikoForm.OnDocumentContextMenu(Sender: TObject): WordBool;
4978  var  var
4979          Doc: IHtmlDocument2;          doc: IHtmlDocument2;
4980          Range: IHTMLTxtRange;          Range: IHTMLTxtRange;
4981          s: string;          s: string;
4982          Num: Integer;          Num: Integer;
# Line 4952  var Line 4984  var
4984  begin  begin
4985          Result := False;          Result := False;
4986          FactiveContent.IDAnchorPopup('');          FactiveContent.IDAnchorPopup('');
4987          Doc := FactiveContent.Browser.Document as IHtmlDocument2;  
4988          if Assigned(Doc) then begin          doc := FactiveContent.Browser.ControlInterface.Document as IHtmlDocument2;
4989                  Range := Doc.selection.createRange as IHTMLTxtRange;          if not Assigned(doc) then
4990                  s := CustomStringReplace(Range.text, ' ', ' ');//全角空白を半角空白に          Exit;
4991                  s := ZenToHan(Trim(s));  
4992                  if GikoSys.IsNumeric(s) then begin          Range := doc.selection.createRange as IHTMLTxtRange;
4993                          Num := StrToInt64Def(s, -1);          if not Assigned(Range) then
4994                          ThreadItem := GetActiveContent(true);          Exit;
4995                          if (ThreadItem <> nil) and (Num <= ThreadItem.Count)  
4996                  and (Num > 0)then begin          s := CustomStringReplace(Range.text, ' ', ' ');//全角空白を半角空白に
4997                  CreateResPopupBrowser;          s := ZenToHan(Trim(s));
4998                  FResPopupBrowser.CreateNewBrowser.PopupType := gptThread;          if GikoSys.IsNumeric(s) then begin
4999                                  HTMLCreater.SetResPopupText(FResPopupBrowser.CreateNewBrowser, ThreadItem, Num, Num, False, False);                  Num := StrToInt64Def(s, -1);
5000                  FResPopupBrowser.Popup;                  ThreadItem := GetActiveContent(true);
5001                                  Result := False;                  if (ThreadItem <> nil) and (Num <= ThreadItem.Count)
5002                          end else             and (Num > 0)then begin
5003                                  Result := True;             CreateResPopupBrowser;
5004                  end else begin             FResPopupBrowser.CreateNewBrowser.PopupType := gptThread;
5005                            HTMLCreater.SetResPopupText(FResPopupBrowser.CreateNewBrowser, ThreadItem, Num, Num, False, False);
5006                FResPopupBrowser.Popup;
5007                    Result := False;
5008                    end else
5009                          Result := True;                          Result := True;
5010                  end;      end else begin
5011                    Result := True;
5012          end;          end;
5013  end;  end;
5014    
# Line 6478  end; Line 6515  end;
6515    
6516  /// 最小化される  /// 最小化される
6517  procedure TGikoForm.OnMinimize;  procedure TGikoForm.OnMinimize;
6518    var
6519        doc: IHTMLDocument2;
6520  begin  begin
6521          if FActiveContent <> nil then begin          if FActiveContent <> nil then begin
6522                  FIsMinimize := mtMinimizing;                  FIsMinimize := mtMinimizing;
6523                  FActiveContent.Thread.ScrollTop := OleVariant(IHTMLDocument2(FActiveContent.Browser.Document)).Body.ScrollTop;          doc := FActiveContent.Browser.ControlInterface.Document as IHTMLDocument2;
6524            if Assigned(doc) then begin
6525                    FActiveContent.Thread.ScrollTop := (doc.body as IHTMLElement2).ScrollTop;
6526            end;
6527          end;          end;
6528  end;  end;
6529    
# Line 6677  end; Line 6719  end;
6719    
6720  procedure TGikoForm.OnResized;  procedure TGikoForm.OnResized;
6721  var  var
6722          doc                                             : Variant;          doc : IHTMLDocument2;
6723  begin  begin
   
6724          FOldFormWidth := Width;          FOldFormWidth := Width;
6725          FIsIgnoreResize := rtNone;          FIsIgnoreResize := rtNone;
6726    
# Line 6694  begin Line 6735  begin
6735                  begin                  begin
6736                          // 最小化は既に完了している (つまりタスクバーからウィンドウを復元中)                          // 最小化は既に完了している (つまりタスクバーからウィンドウを復元中)
6737                          if FActiveContent <> nil then begin                          if FActiveContent <> nil then begin
6738                                  doc := Idispatch( olevariant(FActiveContent.Browser.ControlInterface).Document) as IHTMLDocument2;                                  doc := FActiveContent.Browser.ControlInterface.Document as IHTMLDocument2;
6739                                  doc.Body.ScrollTop := FActiveContent.Thread.ScrollTop;                                  (doc.body as IHTMLElement2).ScrollTop := FActiveContent.Thread.ScrollTop;
6740                          end;                          end;
6741                          FIsMinimize := mtNone;                          FIsMinimize := mtNone;
6742                  end;                  end;
# Line 6709  function TGikoForm.WebBrowserClick(Sende Line 6750  function TGikoForm.WebBrowserClick(Sende
6750  const  const
6751      LIMIT = 20;      LIMIT = 20;
6752  var  var
         p : TPoint;  
6753          e: IHTMLElement;          e: IHTMLElement;
6754        doc : IHTMLDocument2;
6755        FOleInPlaceActiveObject: IOleInPlaceActiveObject;
6756            p : TPoint;
6757          AID: string;          AID: string;
6758          stlist : TStringList;          stlist : TStringList;
6759          i, count: Integer;          i, count: Integer;
6760          body : String;          body : String;
6761      limited : Integer;      limited : Integer;
     FOleInPlaceActiveObject: IOleInPlaceActiveObject;  
6762  begin  begin
6763    result := true;          result := true;
6764    try      if not Assigned(FActiveContent) then
6765          if (FActiveContent <> nil) and (FActiveContent.Browser <> nil) then          Exit;
6766          FOleInPlaceActiveObject := FActiveContent.Browser.ControlInterface as IOleInPlaceActiveObject;      if not Assigned(FActiveContent.Browser) then
6767          FOleInPlaceActiveObject.OnFrameWindowActivate(True);          Exit;
6768                  try  
6769                          GetCursorPos(p);          try
6770                          p.x := p.x - FActiveContent.Browser.ClientOrigin.x;                  FOleInPlaceActiveObject := FActiveContent.Browser.ControlInterface as IOleInPlaceActiveObject;
6771                          p.y := p.y - FActiveContent.Browser.ClientOrigin.y;                  FOleInPlaceActiveObject.OnFrameWindowActivate(True);
6772                          e := IHTMLDocument2(FActiveContent.Browser.Document).elementFromPoint(p.x, p.y);                  GetCursorPos(p);
6773                          if (Assigned(e)) then begin                  
6774                                  if (e.className = 'date') or (e.id = 'date') then begin                  p.x := p.x - FActiveContent.Browser.ClientOrigin.x;
6775                                          AID := e.innerText;                  p.y := p.y - FActiveContent.Browser.ClientOrigin.y;
6776                                          if AnsiPos('id', AnsiLowerCase(AID)) > 0 then begin                  
6777                                                  AID := Copy(AID, AnsiPos('id', AnsiLowerCase(AID)) - 1, 11);                  doc := FActiveContent.Browser.ControlInterface.Document as IHTMLDocument2;
6778                          if AnsiPos(' be:', AnsiLowerCase(AID)) > 0 then begin                  if not Assigned(doc) then
6779                                  AID := Copy(AID, 1, AnsiPos(' BE:', AnsiLowerCase(AID)) - 1)                          Exit;
6780                          end;  
6781                                          end else begin                  e := doc.elementFromPoint(p.x, p.y);
6782                                                  stlist := TStringList.Create;                  if not Assigned(e) then
6783                                                  try                          Exit;
6784                                                          stList.DelimitedText := AID;                  
6785                                                          AID := '';                  if (e.className = 'date') or (e.id = 'date') then begin
6786                                                          for i := 0 to stList.Count - 1 do                          AID := e.innerText;
6787                                                                  if Length(WideString(stList[i])) = 8 then begin                          if AnsiPos('id', AnsiLowerCase(AID)) > 0 then begin
6788                                                                          if GikoSys.NotDateorTimeString(stList[i]) then begin                                  AID := Copy(AID, AnsiPos('id', AnsiLowerCase(AID)) - 1, 11);
6789                                                                                  AID := stList[i];                                  if AnsiPos(' be:', AnsiLowerCase(AID)) > 0 then begin
6790                                                                                  break;                                          AID := Copy(AID, 1, AnsiPos(' BE:', AnsiLowerCase(AID)) - 1)
6791                                                                          end;                                  end;
6792                                                                  end;                          end else begin
6793                                                  finally                                  stlist := TStringList.Create;
6794                                                          stList.Free;                                  try
6795                                            stList.DelimitedText := AID;
6796                                            AID := '';
6797                                            for i := 0 to stList.Count - 1 do begin
6798                                                    if Length(WideString(stList[i])) = 8 then begin
6799                                                            if GikoSys.NotDateorTimeString(stList[i]) then begin
6800                                                                    AID := stList[i];
6801                                                                    break;
6802                                                            end;
6803                                                  end;                                                  end;
6804                                          end;                                          end;
6805                      count := GikoSys.GetSameIDResCount(AID, FActiveContent.Thread);                                  finally
6806                      limited := LIMIT;                                          stList.Free;
                     if not (GikoSys.Setting.LimitResCountMessage) then begin  
                         limited := -1;  
                     end else if (count > LIMIT) then begin  
                         if (GikoUtil.MsgBox(Handle,  
                                 IntToStr(LIMIT) + '個以上ありますが、すべて表示しますか?',  
                                 'IDポップアップ警告',  
                                                                 MB_YESNO or MB_ICONQUESTION) = ID_YES) then begin  
                             limited := -1;  
                         end  
                     end;  
                                         body := GikoSys.GetSameIDResAnchor(AID, FActiveContent.Thread, limited);  
                                         FActiveContent.IDAnchorPopup(body);  
6807                                  end;                                  end;
6808                          end;                          end;
6809                  except                          
6810                            count := GikoSys.GetSameIDResCount(AID, FActiveContent.Thread);
6811                            limited := LIMIT;
6812                            if not (GikoSys.Setting.LimitResCountMessage) then begin
6813                                    limited := -1;
6814                            end else if (count > LIMIT) then begin
6815                                    if (GikoUtil.MsgBox(Handle,
6816                                                    IntToStr(LIMIT) + '個以上ありますが、すべて表示しますか?',
6817                                                    'IDポップアップ警告',
6818                                                    MB_YESNO or MB_ICONQUESTION) = ID_YES) then begin
6819                                            limited := -1;
6820                                    end
6821                            end;
6822    
6823                            body := GikoSys.GetSameIDResAnchor(AID, FActiveContent.Thread, limited);
6824                            FActiveContent.IDAnchorPopup(body);
6825                  end;                  end;
6826    except          except
6827    end;          end;
6828  end;  end;
6829    
6830  //スレッド一覧を最大化してフォーカスを当てる  //スレッド一覧を最大化してフォーカスを当てる
# Line 7160  end; Line 7213  end;
7213  //このレスあぼ〜ん  //このレスあぼ〜ん
7214  procedure TGikoForm.IndividualAbon(Atag, Atype : Integer);  procedure TGikoForm.IndividualAbon(Atag, Atype : Integer);
7215  var  var
7216          ThreadItem      : TThreadItem;      doc : IHTMLDocument2;
7217          ReadList                : TStringList;          ThreadItem : TThreadItem;
7218          wordCount               : TWordCount;          ReadList : TStringList;
7219            wordCount : TWordCount;
7220  begin  begin
7221          ThreadItem      := GetActiveContent(True);      if not Assigned(FActiveContent) then
7222          ReadList                := TStringList.Create;          Exit;
7223          wordCount               := TWordCount.Create;      doc := FActiveContent.Browser.ControlInterface.Document as IHTMLDocument2;
7224        if not Assigned(doc) then
7225            Exit;
7226    
7227            ThreadItem := GetActiveContent(True);
7228            ReadList := TStringList.Create;
7229            wordCount := TWordCount.Create;
7230          try          try
7231                  ThreadItem.ScrollTop := OleVariant(IHTMLDocument2(FActiveContent.Browser.Document)).Body.ScrollTop;                  ThreadItem.ScrollTop := (doc.body as IHTMLElement2).ScrollTop;
7232  {$IFDEF SPAM_FILTER_ENABLED}  {$IFDEF SPAM_FILTER_ENABLED}
7233                  // スパムに設定                  // スパムに設定
7234                  ReadList.LoadFromFile( ThreadItem.GetThreadFileName );                  ReadList.LoadFromFile( ThreadItem.GetThreadFileName );
# Line 7189  end; Line 7249  end;
7249  //同一IDをNGワードに登録  //同一IDをNGワードに登録
7250  procedure TGikoForm.AddIDtoNGWord(invisible : boolean);  procedure TGikoForm.AddIDtoNGWord(invisible : boolean);
7251  var  var
7252        doc : IHTMLDocument2;
7253          ThreadItem : TThreadItem;          ThreadItem : TThreadItem;
7254          No : Integer;          No : Integer;
7255  {$IFDEF SPAM_FILTER_ENABLED}  {$IFDEF SPAM_FILTER_ENABLED}
# Line 7238  begin Line 7299  begin
7299      end;      end;
7300  {$ENDIF}  {$ENDIF}
7301      if (FActiveContent.Repaint) then begin      if (FActiveContent.Repaint) then begin
7302          ThreadItem.ScrollTop := OleVariant(IHTMLDocument2(FActiveContent.Browser.Document)).Body.ScrollTop;          doc := FActiveContent.Browser.ControlInterface.Document as IHTMLDocument2;
7303    
7304            if not Assigned(doc) then
7305                Exit;
7306            ThreadItem.ScrollTop := (doc.body as IHTMLElement2).ScrollTop;
7307          if ThreadItem <> nil then          if ThreadItem <> nil then
7308              InsertBrowserTab( ThreadItem, True );              InsertBrowserTab( ThreadItem, True );
7309      end;      end;
# Line 7264  begin Line 7329  begin
7329                  ReadList                := TStringList.Create;                  ReadList                := TStringList.Create;
7330                  wordCount               := TWordCount.Create;                  wordCount               := TWordCount.Create;
7331                  try                  try
7332                          ThreadItem.ScrollTop := OleVariant(IHTMLDocument2(FActiveContent.Browser.Document)).Body.ScrollTop;                          ThreadItem.ScrollTop := FActiveContent.Browser.OleObject.Document.Body.ScrollTop;
7333  {$IFDEF SPAM_FILTER_ENABLED}  {$IFDEF SPAM_FILTER_ENABLED}
7334                          // スパムに設定                          // スパムに設定
7335                          ReadList.LoadFromFile( ThreadItem.GetThreadFileName );                          ReadList.LoadFromFile( ThreadItem.GetThreadFileName );
# Line 7294  end; Line 7359  end;
7359  procedure TGikoForm.KokoPopupMenuPopup(Sender: TObject);  procedure TGikoForm.KokoPopupMenuPopup(Sender: TObject);
7360  var  var
7361          firstElement: IHTMLElement;          firstElement: IHTMLElement;
7362          document: IHTMLDocument2;          doc: IHTMLDocument2;
7363  begin  begin
7364          document := FActiveContent.Browser.Document as IHTMLDocument2;      try
7365          if Assigned(document) then          doc := FActiveContent.Browser.ControlInterface.Document as IHTMLDocument2;
7366                  firstElement := document.all.item('idSearch', 0) as IHTMLElement;              if Assigned(doc) then
7367                  if Assigned(firstElement) then                      firstElement := doc.all.item('idSearch', 0) as IHTMLElement;
7368                          if firstElement.style.visibility <> 'hidden' then                  if Assigned(firstElement) then
7369                                  firstElement.style.visibility := 'hidden';                          if firstElement.style.visibility <> 'hidden' then
7370                                    firstElement.style.visibility := 'hidden';
7371        except
7372        end;
7373  end;  end;
7374    
7375  procedure TGikoForm.RepaintAllTabsBrowser();  procedure TGikoForm.RepaintAllTabsBrowser();
# Line 7484  begin Line 7552  begin
7552          BrowserNullTab.Browser.Navigate(BLANK_HTML);          BrowserNullTab.Browser.Navigate(BLANK_HTML);
7553    
7554          FBrowsers := TList.Create;          FBrowsers := TList.Create;
7555    
7556          for i := 0 to count -1 do begin          for i := 0 to count -1 do begin
7557                  FBrowsers.Add(TWebBrowser.Create(BrowserPanel));                  FBrowsers.Add(TWebBrowser.Create(BrowserPanel));
7558                  newBrowser := FBrowsers[FBrowsers.Count - 1];                  newBrowser := FBrowsers[FBrowsers.Count - 1];
# Line 7499  begin Line 7568  begin
7568                  newBrowser.OnStatusTextChange   := BrowserStatusTextChange;                  newBrowser.OnStatusTextChange   := BrowserStatusTextChange;
7569                  newBrowser.Navigate(BLANK_HTML);                  newBrowser.Navigate(BLANK_HTML);
7570                  ShowWindow(newBrowser.Handle, SW_HIDE);                  ShowWindow(newBrowser.Handle, SW_HIDE);
7571            GikoSys.ShowRefCount('Browser' + IntToStr(i), newBrowser.ControlInterface);
7572            GikoSys.ShowRefCount('Document' + IntToStr(i), newBrowser.ControlInterface.Document);
7573          end;          end;
7574          BrowserNullTab.Browser.BringToFront;          BrowserNullTab.Browser.BringToFront;
7575          ShowWindow(BrowserNullTab.Browser.Handle, SW_SHOW);          ShowWindow(BrowserNullTab.Browser.Handle, SW_SHOW);

Legend:
Removed from v.1.664  
changed lines
  Added in v.1.665

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