demo.pas

delphi老牌的浏览器控件

   Close;
end;

procedure TfrmMain.SaveAs1Click(Sender: TObject);
begin
   EmbeddedWB1.SaveDialog;
end;

procedure TfrmMain.SavepagetextClick(Sender: TObject);
begin
   EmbeddedWB1.SavePageTextDialog;
end;

procedure TfrmMain.ViewSourceHtmlClick(Sender: TObject);
begin
   EmbeddedWB1.ViewPageSourceHtml;
end;

procedure TfrmMain.PageSourceTextClick(Sender: TObject);
begin
   EmbeddedWB1.ViewPageSourceText;
end;

procedure TfrmMain.InternetOptions1Click(Sender: TObject);
begin
   EmbeddedWB1.ShowInternetOptions;
end;

procedure TfrmMain.CopyClick(Sender: TObject);
begin
   EmbeddedWB1.Copy;
end;

procedure TfrmMain.SelectAllClick(Sender: TObject);
begin
   EmbeddedWB1.SelectAll;
end;

procedure TfrmMain.FindDialogClick(Sender: TObject);
begin
   EmbeddedWB1.ShowFindDialog;
end;

procedure TfrmMain.SaveAllImagesClick(Sender: TObject);
begin
   EmbeddedWB1.SaveImagesDialog;
end;

procedure TfrmMain.GetIEHomePageClick(Sender: TObject);
begin
   ShowMessage(EmbeddedWB1.GetIEHomePage);
end;

procedure TfrmMain.SetIENewHomePageClick(Sender: TObject);
begin
   EmbeddedWB1.SetNewHomePage('http://groups.yahoo.com/group/delphi-webbrowser/');
end;

procedure TfrmMain.SendTheURLClick(Sender: TObject);
begin
   EmbeddedWB1.SendURLInMail;
end;

procedure TfrmMain.EmbeddedWB1DownloadComplete(Sender: TObject);
begin
   AddEventLog('OnDocumentComplete ' + EmbeddedWB1.LocationName);
   ProgressBar1.Visible := false;
   EmbeddedWB1.SetFocusToDoc;
end;

procedure TfrmMain.EmbeddedWB1TitleChange(ASender: TObject;
   const Text: WideString);
begin
   frmMain.Caption := ('Web Site Name: ' + EmbeddedWB1.LocationName);
   stBar.Panels[0].Text := Text;
end;

procedure TfrmMain.EmbeddedWB1StatusTextChange(ASender: TObject;
   const Text: WideString);
begin
   stBar.Panels[0].Text := Text;
end;

procedure TfrmMain.ToolBtnRefreshClick(Sender: TObject);
begin
   UpdateControls;
   EmbeddedWB1.Refresh;
end;

procedure TfrmMain.ToolBtnHomeClick(Sender: TObject);
begin
   UpdateControls;
   EmbeddedWB1.GoHome;
end;

procedure TfrmMain.ToolBtnSearchClick(Sender: TObject);
begin
   EmbeddedWB1.ShowFindDialog;
end;

procedure TfrmMain.ToolBtnAccesoriesClick(Sender: TObject);
begin
   if ToolBtnAccesories.Down then
      begin
         PanelACC.Visible := true;
      end
   else
      PanelACC.Visible := false;
end;

procedure TfrmMain.ToolBtnStopClick(Sender: TObject);
begin
   UpdateControls;
end;

procedure TfrmMain.ToolBtnForwardClick(Sender: TObject);
begin
   UpdateControls;
   EmbeddedWB1.GoForward;
end;

procedure TfrmMain.ToolbtnBackClick(Sender: TObject);
begin
   UpdateControls;
   EmbeddedWB1.GoBack;
end;

procedure TfrmMain.btnGoClick(Sender: TObject);
begin
   UpdateControls;
   EmbeddedWB1.Go(trim(IEAddress1.Text));
end;

procedure TfrmMain.EmbeddedWB1CommandStateChange(ASender: TObject;
   Command: Integer; Enable: WordBool);
begin
   case Command of
      CSC_NAVIGATEBACK:
         begin
            ToolbtnBack.Enabled := Enable;
            GoBack1.Enabled := Enable;
         end;
      CSC_NAVIGATEFORWARD:
         begin
            ToolbtnForward.Enabled := Enable;
            GoForward1.Enabled := Enable;
         end;
   end;
end;

procedure TfrmMain.EmbeddedWB1DownloadBegin(Sender: TObject);
begin
   AddEventLog('OnDownloadBegin');
   UpdateStopButton;
end;

procedure TfrmMain.EmbeddedWB1PropertyChange(ASender: TObject;
   const szProperty: WideString);
begin
   UpdateStopButton;
end;

procedure TfrmMain.EmbeddedWB1Refresh(Sender: TCustomEmbeddedWB; CmdID: Integer;
  var Cancel: Boolean);
begin
   AddEventLog('OnRefresh. CmdID: '+ IntToStr(CmdID));
end;

procedure TfrmMain.EmbeddedWB1ProgressChange(ASender: TObject; Progress,
   ProgressMax: Integer);
begin
   UpdateStopButton;
   if (Progress >= 1) and (ProgressMax > 1)
      then
      begin
         ProgressBar1.Position := Round((Progress * 100) div ProgressMax);
         ProgressBar1.Visible := True;
        // Stbar.Panels[3].Text  := 'Download Progress: '+ Format('%d %', [Progress Div 100]);
      end
   else
      begin
         ProgressBar1.Position := 1;
        //  stBar.Panels[3].Text:='';
         ProgressBar1.Visible := False;
      end;
end;

procedure TfrmMain.Smallest1Click(Sender: TObject);
var
   k: Integer;
begin
   if not EmbeddedWB1.Busy then
      begin
         for k := 0 to Zoom1.Count - 1 do
            begin
               Zoom1.Items[k].Checked := False;
            end;
         TMenuItem(Sender).Checked := True;
         EmbeddedWb1.Zoom := ((Sender as TMenuitem).Tag);
      end;
end;

procedure TfrmMain.Zoom1Click(Sender: TObject);
var
   ZoomIndex: integer;
begin
   ZoomIndex := EmbeddedWB1.Zoom;
   case ZoomIndex of
      4: Largest1.Checked := True;
      3: Large1.Checked := True;
      2: Medium1.Checked := True;
      1: Small1.Checked := True;
      0: Smallest1.Checked := True;
   end;
end;

procedure TfrmMain.Cut1Click(Sender: TObject);
begin
   EmbeddedWB1.Cut;
end;

procedure TfrmMain.Pastefromclipboard1Click(Sender: TObject);
begin
   EmbeddedWB1.Paste;
end;

procedure TfrmMain.ScrollToTheTop1Click(Sender: TObject);
begin
   EmbeddedWB1.ScrollToTop;
end;

procedure TfrmMain.Scrolltothebottom1Click(Sender: TObject);
begin
   EmbeddedWB1.ScrollToBottom;
end;

procedure TfrmMain.ScrolToPosition1Click(Sender: TObject);
begin
   EmbeddedWB1.ScrollToPosition(200, 200);
end;

procedure TfrmMain.GetCachedPathClick(Sender: TObject);
begin
   ShowMessage(EmbeddedWB1.GetCachedFileFromURL(IEAddress1.Text));
end;

procedure TfrmMain.CharSetAutomatic1Click(Sender: TObject);
begin
   if EmbeddedWB1.SetCharartersSet(TMenuItem(Sender).Hint) then
      TMenuItem(Sender).Checked := True;
end;

procedure TfrmMain.CookiesCheck1Click(Sender: TObject);
var
   st: string;
begin
   st := EmbeddedWB1.GetCookie;
   SetLength(st, 180);
   if st <> '' then
      ShowMessage('The web site has just added a cookie:'
         + #10 + #13 + st)
   else
      ShowMessage('No cookies were found.');
end;

procedure TfrmMain.spdBtnGoogleSearchClick(Sender: TObject);
begin
   EmbeddedWB1.GoSearchInGoogle(edtSearch.Text);
end;

procedure TfrmMain.edtSearchDblClick(Sender: TObject);
begin
  edtSearch.SelectAll;
end;

procedure TfrmMain.GetCookiesPath1Click(Sender: TObject);
var
   st: string;
begin
   st := EmbeddedWB1.GetCookiesPath;
   ShowMessage(st);
end;

procedure TfrmMain.GetHistoryPath1Click(Sender: TObject);
var
   st: string;
begin
   st := EmbeddedWB1.GetHistoryPath;
   ShowMessage(st);
end;

procedure TfrmMain.GetFavoritesPath1Click(Sender: TObject);
var
   st: string;
begin
   st := EmbeddedWB1.GetHistoryPath;
   ShowMessage(st);
end;

procedure TfrmMain.ShowOrganizeFavorites1Click(Sender: TObject);
begin
   EmbeddedWB1.ShowOrganizeFavorites;
end;

procedure TfrmMain.IEAddress1KeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
begin
   if (key = 13) then
      begin
         UpdateControls;
         EmbeddedWB1.Go(trim(IEAddress1.Text));
      end;
end;

procedure TfrmMain.EmbeddedWB1NewWindow2(ASender: TObject;
   var ppDisp: IDispatch; var Cancel: WordBool);
begin
   AddEventLog('OnNewWindow');
   if tbBlock.Down then
      Cancel := True
   else
      EmbeddedWB1.Navigate(InitialURL);
end;

procedure TfrmMain.OpenAddressBook1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenAddressBook;
end;

procedure TfrmMain.OpenMailClient1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenOutlookMail;
end;

procedure TfrmMain.OpenNewsClient1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenNewsClient;
end;

procedure TfrmMain.OpenCalender1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenCalendar;
end;

procedure TfrmMain.OpenNetMeetingClick(Sender: TObject);
begin
   EmbeddedWB1.OpenNetMeeting;
end;

procedure TfrmMain.OpenYahooMail1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenYahooMail;
end;

procedure TfrmMain.OpenOutlookExpress1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenOutlookExpressMail;
end;

procedure TfrmMain.OpenOutlook1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenOutlookMail;
end;

procedure TfrmMain.OpenGoogleMail1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenGoogleMail;
end;

procedure TfrmMain.OpenHotmailMail1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenHotmailMail;
end;

procedure TfrmMain.OpenOtherBrowsersFavorites1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenOtherWBFavorites;
end;

procedure TfrmMain.EmbeddedWB1BeforeNavigate2(ASender: TObject;
   const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
   Headers: OleVariant; var Cancel: WordBool);
begin

   lvEventLog.Clear;
   AddEventLog('OnBeforeNavigate2 ' + URL);
   if tbBlock.Marked then
      Cancel := True
   else
      Cancel := false;
end;

procedure TfrmMain.EmbeddedWB1NavigateComplete2(ASender: TObject;
   const pDisp: IDispatch; var URL: OleVariant);
begin
   AddEventLog('OnNavigateComplete2 ' + URL);
   IEAddress1.Text := EmbeddedWB1.LocationURL;
   UpdateSecurityZone;
   UpdateSSLStatus;
end;

procedure TfrmMain.EmbeddedWB1DocumentComplete(ASender: TObject;
   const pDisp: IDispatch; var URL: OleVariant);
begin
   AddEventLog('OnDocumentComplete: ' + URL);
end;

procedure TfrmMain.EmbeddedWB1Unload(Sender: TObject);
begin
   AddEventLog('OnUnload');
end;

procedure TfrmMain.EmbeddedWB1FullScreen(ASender: TObject;
   FullScreen: WordBool);
begin
   if FullScreen then
      AddEventLog('OnFullScreen: ' + 'FullScreen');
end;

procedure TfrmMain.EmbeddedWB1Visible(ASender: TObject; Visible: WordBool);