demo.pas

delphi老牌的浏览器控件

                           if (pos('Links', Text) > 0) or (pos('Imported', Text) > 0)
                           then
                              begin
                                 HasChildren := true;
                                 ImageIndex := 6
                              end
                           else
                              ImageIndex := 8
      end;
end;

procedure TfrmMain.EmbeddedWB1ScriptError(Sender: TObject; ErrorLine,
   ErrorCharacter, ErrorCode, ErrorMessage, ErrorUrl: string;
   var ScriptErrorAction: TScriptErrorAction);
begin
  AddEventLog('OnNavigateError '+ ErrorMessage+ '  ' +ErrorCode );
end;

procedure TfrmMain.EmbeddedWB1SetSecureLockIcon(ASender: TObject;
   SecureLockIcon: Integer);
begin
   case SecureLockIcon of
      0: EncryptionSt := 'UnSecure';
      1: EncryptionSt := 'Mixed';
      2: EncryptionSt := 'Unknown Bits';
      3: EncryptionSt := '40 Bit';
      4: EncryptionSt := '56 Bit';
      5: EncryptionSt := 'Fortezza';
      6: EncryptionSt := '128 Bit';
   end;
   EncryptionSt := 'Secure Level: ' + EncryptionSt;
   lblLevel.Caption := EncryptionSt;
end;

procedure TfrmMain.EmbeddedWB1ShowDialog(Sender: TObject; h: Cardinal;
   StyleEx: Integer; var NewCaption: WideString; var Cancel: Boolean);
begin
   AddEventLog('OnShowDialog');
end;

procedure TfrmMain.SetDesignModeClick(Sender: TObject);
begin
   if EmbeddedWB1.DesignMode then
      Stbar.Panels[4].Text := 'Design Mode ';
end;

//********* LinksBar & IEDownload*********************************************

procedure TfrmMain.AddTheSiteToTheList1Click(Sender: TObject);
begin
   LinksBar1.AddToLinksList(EmbeddedWB1.LocationName, EmbeddedWB1.LocationURL);
end;

procedure TfrmMain.RemoveTheSiteFromTheList1Click(Sender: TObject);
begin //remmmber to add links to the list before using this feature
   LinksBar1.RemoveFromLinksList(EmbeddedWB1.LocationName);
end;

procedure TfrmMain.ShowTheList1Click(Sender: TObject);
var
   lst: TstringList;
   Count: integer;
begin
   Lst := TStringList.Create;
   Count := 0;
   UpdateEditor;
   LinksBar1.GetTheLinksList(lst);
   RichEditWB1.Lines.AddStrings(lst);
   RichEditWB1.Lines.Add('**** You have total of ' + IntToStr(Count) + ' links in your list****');
end;

procedure TfrmMain.NavigateToLinkItem1Click(Sender: TObject);
var
   st: string;
begin //remmmber to add links to the list before using this feature
   st := ('delphi-webbrowser : Delphi: Using IE''s WebBrowser');
   LinksBar1.NavigateToItem(st);
end;

procedure TfrmMain.ViewHidethelinksbar1Click(Sender: TObject);
begin
   if ViewHidethelinksbar1.Checked then
      Linksbar1.Shown := false
   else
      Linksbar1.Shown := true;
end;

procedure TfrmMain.ViewHideTheLinksToolbar1Click(Sender: TObject);
begin
   ViewHidethelinksbar1.Click;
end;

procedure TfrmMain.ClearTheLinkList1Click(Sender: TObject);
begin
   LinksBar1.ClearTheLinksList;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
var
   i: Integer;
begin
   ClearResultsGrid;
   for i := 0 to links.count - 1 do
      IEDownload1.Go(Links[i]);
end;

function TfrmMain.IEDownload1Response(Sender: TBSCB; dwResponseCode: Cardinal;
   szResponseHeaders, szRequestHeaders: PWideChar;
   out szAdditionalRequestHeaders: PWideChar): HRESULT;
begin
   Result := E_ABORT;
end;

procedure TfrmMain.IEDownload1Complete(Sender: TBSCB; Stream: TStream;
   Result: HRESULT);
begin
   if Sender.Responsecode = 200 then
      StringGrid1.Cells[1, Links.IndexOf(Sender.Url) + 1] := 'Finished...'
   else
      if Sender.ResponseCode > 400 then
         StringGrid1.Cells[1, Links.IndexOf(Sender.Url) + 1] := ResponseCodeText(Sender.ResponseCode)
      else
         StringGrid1.Cells[1, Links.IndexOf(Sender.Url) + 1] := ErrorText(result);
   StringGrid1.Cells[2, Links.IndexOf(Sender.Url) + 1] := ResponseCodeText(Sender.ResponseCode);
   StringGrid1.Repaint; // For Synchronous download only
end;

procedure TfrmMain.IEDownload1Progress(Sender: TBSCB; ulProgress, ulProgressMax,
   ulStatusCode: Cardinal; szStatusText: PWideChar; Downloaded, ElapsedTime,
   Speed, RemainingTime, Status: string);
begin
   StringGrid1.Cells[1, Links.IndexOf(Sender.Url) + 1] := BindstatusText(ulStatusCode);
   StringGrid1.Repaint; // For Synchronous download only
end;

procedure TfrmMain.RadioButton1Click(Sender: TObject);
begin
   Iedownload1.Options := [GetNewestVersion, NoWriteCache, PullData];
end;

procedure TfrmMain.RadioButton2Click(Sender: TObject);
begin
   Iedownload1.Options := [Asynchronous, AsyncStorage, GetNewestVersion, NoWriteCache, PullData];
end;

procedure TfrmMain.CheckTheLinksClick(Sender: TObject);
var
   i: Integer;
   UrlList: TStringList;
begin
   UpdateLinksChecker;
   UrlList := TStringList.Create;
   try
      ClearAllGrid;
      LinksBar1.GetTheLinksURLs(UrlList);
      Links.Clear;
      Links.AddStrings(UrlList);
      for i := 0 to links.count - 1 do
         begin
            Stringgrid1.RowCount := i + 2;
            Stringgrid1.Cells[0, i + 1] := links[i];
         end;
      for i := 0 to links.count - 1 do
         IEDownload1.Go(Links[i]);
   finally
   end;
   UrlList.Free;
end;

procedure TfrmMain.CheckURLsFromALinkList1Click(Sender: TObject);
begin
   UpdateLinksChecker;
end;

//********* local embeddedWB*********************************************

procedure TfrmMain.sbRefreshClick(Sender: TObject);
begin
   EmbeddedWB2.Refresh;
end;

procedure TfrmMain.sbUpClick(Sender: TObject);
begin
   EmbeddedWB2.GoBack;
end;

procedure TfrmMain.sbConnectClick(Sender: TObject);
begin
   if (AnsiPos('ftp', IEAddress1.Text) > 0) then
      begin
         EmbeddedWB1.Navigate('ftp://' + edtUser.text + ':' + edtPassword.text + '@' + IEAddress1.text);
         repeat;
            Application.ProcessMessages;
         until
            EmbeddedWB1.Busy = false;
      end
   else
      begin
         ShowMessage('Check your address, Its not an ftp site.' + #10 + #13
            + 'You are being redirected to Microsoft FTP just for the test.');
         EmbeddedWB1.Navigate('ftp://ftp.microsoft.com/');
      end;
end;

procedure TfrmMain.EmbeddedWB2CommandStateChange(ASender: TObject;
   Command: Integer; Enable: WordBool);
begin
   case Command of
      CSC_NAVIGATEBACK: sbUp.Enabled := Enable;
   end;
end;
//************ Editor *******************************************

procedure TfrmMain.HighlighHTML1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.LoadHTMLFromBrowser;
   if RichEditWB1.HighlightHTML then
      RichEditWB1.DoHighlightHTML;
   RichEditWB1.ScrollToTop;
end;

procedure TfrmMain.HighLightURL1Click(Sender: TObject);
begin
   RichEditWB1.HighLightURL := True;
   UpdateEditor;
   EmbeddedWB1.ViewPageLinksToStrings(RichEditWB1.Lines);
   RichEditWB1.AddLineNumbering;
end;

procedure TfrmMain.SetSelectionAsAHyperLink1Click(Sender: TObject);
begin
   RichEditWB1.SetSelectionHyperlink(true);
end;

procedure TfrmMain.SetWordAsAHyperLink1Click(Sender: TObject);
begin
   RichEditWB1.SetWordHyperlink(true);
end;

procedure TfrmMain.AddBullets1Click(Sender: TObject);
begin
   RichEditWB1.AddBullets;
end;

procedure TfrmMain.AddLineNumbers1Click(Sender: TObject);
begin
   RichEditWB1.AddLineNumbering;
end;

procedure TfrmMain.AddRomanNumbers1Click(Sender: TObject);
begin
   RichEditWB1.AddRomanNumbering;
end;

procedure TfrmMain.New1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.New;
end;

procedure TfrmMain.Open2Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.Open;
end;

procedure TfrmMain.Save1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.Save;
end;

procedure TfrmMain.SaveAs2Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.SaveAs;
end;

procedure TfrmMain.SetFontColorClick(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.SetFontColor;
end;

procedure TfrmMain.AddBackroundColor1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.SetSelectedBgColor;
end;

procedure TfrmMain.SelectFonts1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.SelectFont;
end;

procedure TfrmMain.SetSize1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.SelectFont;
end;

procedure TfrmMain.SetBold1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.SetFontBold;
end;

procedure TfrmMain.SetSize2Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.SetFontSize;
end;

procedure TfrmMain.SetItalic1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.SetFontItalic;
end;

procedure TfrmMain.SetUnderLine1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.SetFontUnderLine;
end;

procedure TfrmMain.AddDateAndTime1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.AddDateAndTime;
end;

procedure TfrmMain.PreviewRichEditLinesInTheBrowser1Click(Sender: TObject);
begin
   RichEditWB1.PreviewInBrowser;
end;

procedure TfrmMain.LoadCodeFromBrowserStream1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.LoadStreamFromBrowser;
end;

procedure TfrmMain.SetColor1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.SetColor;
end;

procedure TfrmMain.Print1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.PrintAll;
end;

procedure TfrmMain.Find1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.Find;
end;

procedure TfrmMain.Replace1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.Replace;
end;

procedure TfrmMain.CreateASnapshot1Click(Sender: TObject);
begin
   UpdateImage;
   RichEditWB1.CreateSnapShot(ImageViewer.Picture.Bitmap);
end;

procedure TfrmMain.AddACheckBox1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.AddCheckBox(' bsalsa', 'cb', 20, 30, 170, true);
end;

procedure TfrmMain.AddTEditBox1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.AddEditBox('bsalsa', 'edt', 20, 30, 80);
end;

procedure TfrmMain.AddARadioButton1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.AddRadioButton('bsalsa', 'rb', 20, 30, 40, true);
end;

procedure TfrmMain.AddAButton1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.AddButton('bsalsa', 'btn', 20, 30, 130);
end;

procedure TfrmMain.GoToLineNumber1Click(Sender: TObject);
var
   Value: string;
begin
   UpdateEditor;
   InputQuery('Select A Line', 'Please Enter a line number to select..', Value);
   RichEditWB1.SelectLine(StrToInt(Trim(Value)));
end;

procedure TfrmMain.WrapLongLines1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.WordWrap := WrapLongLines1.Checked;
end;

procedure TfrmMain.MailSelectedText1Click(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.MailSelected;
end;

procedure TfrmMain.miSaveClick(Sender: TO