⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 demo.pas

📁 delphi老牌的浏览器控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
begin
   if Visible then
      AddEventLog('OnVisible: ' + 'Visible');
end;

procedure TfrmMain.GoAboutBlank1Click(Sender: TObject);
begin
   EmbeddedWB1.GoAboutBlank;
end;

procedure TfrmMain.Godownloadafile1Click(Sender: TObject);
var
   URL: string;
begin
   UpdateControls;
   InputQuery('Download a file', 'Please Enter a valid path + file name', URL);
   EmbeddedWB1.GoDownloadFile(URL);
end;

procedure TfrmMain.GoDowloadMasked1Click(Sender: TObject);
const
   CSIDL_DESKTOPDIRECTORY = $0010;
begin
   UpdateControls;
   EmbeddedWB1.GoDownloadMaskedFile('http://www.google.com/intl/de/images/home_title.gif'
      , (EmbeddedWB1.GetSpecialFolderPath(Handle, CSIDL_DESKTOPDIRECTORY)) + '\google-image.gif', true);
end;

procedure TfrmMain.checkOnlineStatus2Click(Sender: TObject);
begin
   if not EmbeddedWB1.CheckOnlineStatus then
      MessageDlg('It looks like you are not connected to the internet!', mtWarning, mbOKCancel, 0);
end;

procedure TfrmMain.SaveThePageTofile1Click(Sender: TObject);
begin
   EmbeddedWB1.SaveToFile('Site.html');
   EmbeddedWB1.ExploreFolder(ExtractFilePath(application.ExeName));
end;

procedure TfrmMain.SendThePageInMail1Click(Sender: TObject);
begin
   EmbeddedWB1.SendPageInMailAsAttachment(FrmMain, 'Site.html', 'Check this site', 'With regards');
end;

procedure TfrmMain.CreateNewMail1Click(Sender: TObject);
begin
   EmbeddedWB1.CreateNewMail;
end;

procedure TfrmMain.GetSpecialFolderPath1Click(Sender: TObject);
const
   CSIDL_DESKTOPDIRECTORY = $0010;
 {MoreUses: (shlobj.pas)}
 {CSIDL_DESKTOP = $0000;      CSIDL_DRIVES   = $0011;
  CSIDL_PROGRAMS = $0002;     CSIDL_NETWORK  = $0012;
  CSIDL_CONTROLS = $0003;     CSIDL_NETHOOD  = $0013;
  CSIDL_PRINTERS = $0004;     CSIDL_FONTS    = $0014;
  CSIDL_PERSONAL = $0005;     CSIDL_TEMPLATES = $0015;
  CSIDL_FAVORITES = $0006;    CSIDL_TEMPLATES = $0015;
  CSIDL_STARTUP = $0007;      CSIDL_COMMON_STARTMENU = $0016;
  CSIDL_RECENT = $0008;       CSIDL_COMMON_PROGRAMS  = $0017;
  CSIDL_SENDTO = $0009;       CSIDL_COMMON_STARTUP   = $0018;
  CSIDL_BITBUCKET = $000a;    CSIDL_COMMON_DESKTOPDIRECTORY  = $0019;
  CSIDL_STARTMENU = $000b;    CSIDL_APPDATA                  = $001A;
  CSIDL_DESKTOPDIRECTORY = $0010;    CSIDL_PRINTHOOD         = $001B;}
begin
   ShowMessage('Desktop Path Is: ' + EmbeddedWB1.GetSpecialFolderPath(Handle, CSIDL_DESKTOPDIRECTORY));
end;

procedure TfrmMain.CreateAShortCutOnYourDeskTop1Click(Sender: TObject);
begin
   EmbeddedWB1.CreateDesktopShortcut;
end;

procedure TfrmMain.ExportFavorites1Click(Sender: TObject);
begin
   ExportFavorite1.ExportFavorites;
   if ExportFavorite1.SuccessFlag then
      EmbeddedWB1.Navigate(ExportFavorite1.NavigatePath);
end;

procedure TfrmMain.ImportFavorites1Click(Sender: TObject);
begin
   ImportFavorite1.ImportFavorites;
   UpdateView();
   if ImportFavorite1.SuccessFlag then
      EmbeddedWB1.ShowOrganizeFavorites;
end;

procedure TfrmMain.AddToFavorites1Click(Sender: TObject);
begin
   EmbeddedWB1.AddToFavorites(EmbeddedWB1.LocationURL, EmbeddedWB1.LocationName);
   UpdateView();
end;

procedure TfrmMain.FavoritesMenu1AddFavorites(const EmbeddedWB: TEmbeddedWB;
   Title, URL: WideString; Success: Integer);
begin
   ShowMessage(EmbeddedWB.GetNamePath + '' + Title + '' + URL);
end;

procedure TfrmMain.FavoritesTree1Expanded(Sender: TObject; Node: TTreeNode);
begin
   if (pos('Links', Node.Text) > 0) or (pos('Imported', Node.Text) > 0)
      then
      with node do
         begin
            HasChildren := true;
            if not Expanded then
               ImageIndex := 6
            else
               ImageIndex := 7;
         end
end;

procedure TfrmMain.GoWithQueryDetails1Click(Sender: TObject);
var
   Url, Query: string;
begin
   InputQuery('Browser Demo', 'Please enter the url', Url);
   InputQuery('Browser Demo', 'Please enter the Query', Query);
   EmbeddedWB1.GoWithQueryDetails(Url, Query);
end;

procedure TfrmMain.LoadFromStringsClick(Sender: TObject);
begin
   UpdateEditor;
   RichEditWB1.Lines.Add('<p><font size="7">This HTML is a test of: Browser - Load From Strings.  </font></p>');
   pctrlWB.Pages[1].Caption := 'Browser - Load From Strings';
   EmbeddedWB1.LoadFromStrings(RichEditWB1.Lines);
   RichEditWB1.DoHighlightHtml;
end;

procedure TfrmMain.SavePageToStrings1Click(Sender: TObject);
begin
   UpdateEditor;
   pctrlWB.Pages[1].Caption := 'Browser - Save To Strings';
   EmbeddedWB1.SaveToStrings(RichEditWB1.Lines);
end;

procedure TfrmMain.SavePageToStreamClick(Sender: TObject);
var
   Stm: TMemoryStream;
begin
   Stm := TMemoryStream.Create;
   try
      UpdateEditor;
      pctrlWB.Pages[1].Caption := 'Browser - Save To Stream';
      EmbeddedWB1.SaveToStream(Stm);
      Stm.Position := 0;
      RichEditWB1.Lines.LoadFromStream(Stm);
      RichEditWB1.DoHighlightHTML;
   finally
      Stm.Free;
   end;
end;

procedure TfrmMain.LoadFromStreamClick(Sender: TObject);
var
   Stm: TMemoryStream;
begin
   Stm := TMemoryStream.Create;
   try
      UpdateEditor;
      RichEditWB1.Lines.Add('<p><font size="7">This HTML is a test of: Browser - Load From Stream.  </font></p>');
      RichEditWB1.DoHighlightHTML;
      pctrlWB.Pages[1].Caption := 'Browser - Load From Stream';
      RichEditWB1.Lines.SaveToStream(Stm);
      Stm.Position := 0;
      EmbeddedWB1.LoadFromStream(Stm);
   finally
      Stm.Free;
   end;
end;

procedure TfrmMain.ImportExportWizard1Click(Sender: TObject);
begin
   EmbeddedWB1.ShowImportExportFavoritesAndCookies;
end;

procedure TfrmMain.ShowInternetExplorerVersion1Click(Sender: TObject);
begin
   EmbeddedWB1.ShowIEVersionInfo;
end;

procedure TfrmMain.GetHostAndIP1Click(Sender: TObject);
var
   HostN, HostIP, Err: string;
begin
   if EmbeddedWB1.GetIPAndHostName(HostN, HostIP, Err) then
      MessageDlg('PC Host Name: ' + HostN + #10 + #13 + 'Your Internal IP: ' + HostIP, mtInformation, [mbOk], 0)
   else
      MessageDlg(Err, mtError, [mbOk], 0);
end;

procedure TfrmMain.GetDefaultWebBrowserFromResistry1Click(Sender: TObject);
begin
   MessageDlg('Current Default Web Browser is: ' + EmbeddedWB1.GetDefaultBrowserFromRegistry, mtInformation, [mbOk], 0)
end;

procedure TfrmMain.ClearCache1Click(Sender: TObject);
begin
   EmbeddedWB1.ClearCache;
end;

procedure TfrmMain.DeleteHistory1Click(Sender: TObject);
begin
   EmbeddedWB1.ClearHistory;
end;

procedure TfrmMain.ClearAddressBarTypedURLs1Click(Sender: TObject);
begin
   EmbeddedWB1.ClearTypedURLs;
end;

procedure TfrmMain.PageSourceHtmlAsStrings1Click(Sender: TObject);
begin
   UpdateEditor;
   EmbeddedWB1.ViewPageSourceHtmlToStrings(RichEditWB1.Lines);
   if RichEditWB1.HighlightHTML then
      RichEditWB1.DoHighlightHTML;
end;

procedure TfrmMain.PageSourceTextAsStrings1Click(Sender: TObject);
begin
   UpdateEditor;
   EmbeddedWB1.ViewPageSourceTextToStrings(RichEditWB1.Lines);
end;

procedure TfrmMain.ViewPageLinksAsAList1Click(Sender: TObject);
begin
   UpdateEditor;
   EmbeddedWB1.ViewPageLinksToStrings(RichEditWB1.Lines);
end;

procedure TfrmMain.ViewPageImagesAsAList1Click(Sender: TObject);
begin
   UpdateEditor;
   EmbeddedWB1.ViewPageImagesToStrings(RichEditWB1.Lines);
end;

procedure TfrmMain.ViewPageFieldsAsAList1Click(Sender: TObject);
begin
   UpdateEditor;
   EmbeddedWB1.ViewPageFieldsToStrings(RichEditWB1.Lines);
end;

procedure TfrmMain.ViewPagePropertiesAsAList1Click(Sender: TObject);
begin
   UpdateEditor;
   EmbeddedWB1.ViewPagePropertiesToStrings(RichEditWB1.Lines);
end;

procedure TfrmMain.PageCtrlChange(Sender: TObject);
begin
   UpdateView();
end;

procedure TfrmMain.SearchImMsn1Click(Sender: TObject);
begin
   EmbeddedWB1.GoSearchInMSN('EmbeddedWB');
end;

procedure TfrmMain.SearchInGoogle1Click(Sender: TObject);
begin
   EmbeddedWB1.GoSearchInGoogle('EmbeddedWB');
end;

procedure TfrmMain.SearchInYahoo1Click(Sender: TObject);
begin
   EmbeddedWB1.GoSearchInYahoo('EmbeddedWB');
end;

procedure TfrmMain.FillFormWithPersonalDetails1Click(Sender: TObject);
begin
   EmbeddedWB1.Navigate('http://edit.yahoo.com/config/eval_register?.done=http://groups.yahoo.com%2fgroup%2fdelphi-webbrowser%2f&.src=ygrp&.intl=us');
   while EmbeddedWB1.ReadyState <> READYSTATE_COMPLETE do
      begin
         Forms.Application.ProcessMessages;
      end;
   with EmbeddedWB1 do
      begin
         FillForm('login', 'Mozart');
         FillForm('passwd', 'Bethoven');
         FillForm('.fn', 'lol1');
         FillForm('.ln', 'lol2');
         FillForm('.ln', 'lol2');
         FillForm('.pw', 'lol3333');
         FillForm('.pw2', 'lol444');
         FillForm('.pw_a', 'lolypop');
         FillForm('.pwqa_a', 'lolypop');
         FillForm('.em', 'loly@pop.com');
         FillForm('.pc', '123456');
         FillForm('.secword', ':)');
      end;
end;
///------------------Images-------------------------------------

procedure TfrmMain.ShowTheImageEditor1Click(Sender: TObject);
begin
   UpdateImage;
end;

procedure TfrmMain.getAScreanCapture1Click(Sender: TObject);
begin
   if EmbeddedWB1.GetBmpFromBrowser('site.bmp') then
      begin
         UpdateImage;
         ImageViewer.Picture.LoadFromFile('.\site.bmp');
         ShowMessage('The page screen capture is in your application folder.');
      end;
end;

procedure TfrmMain.GetThumbnailClick(Sender: TObject);
begin
   UpdateImage;
   EmbeddedWB1.GetThumbnail(ImageViewer);
end;

procedure TfrmMain.GetJpegPageCapture1Click(Sender: TObject);
begin
   if EmbeddedWB1.GetJpegFromBrowser('.\Site.jpg', Height, Width, Height, Width) then
      begin
         UpdateImage;
         ImageViewer.Picture.LoadFromFile('.\Site.jpg');
         ShowMessage('The page screen capture is in your application folder.')
      end;
end;

///------------------End of Images-------------------------------------

procedure TfrmMain.OpenFoldersExplore1Click(Sender: TObject);
begin
   EmbeddedWB1.ExploreFolder(ExtractFilePath(application.ExeName));
end;

procedure TfrmMain.OpenRegistryEditor1Click(Sender: TObject);
begin
   EmbeddedWB1.OpenRegistryEditor;
end;

procedure TfrmMain.PrintWithOptionsClick(Sender: TObject);
begin
   EmbeddedWB1.PrintWithOptions;
end;

procedure TfrmMain.AddToRestrictedZoneListClick(Sender: TObject);
begin
   EmbeddedWB1.AddToRestrictedSiteList(EmbeddedWB1.LocationURL);
end;

procedure TfrmMain.CheckIfInResrictedZoneList1Click(Sender: TObject);
begin
   if EmbeddedWB1.CheckIfInRestricredList(EmbeddedWB1.LocationURL, False) then
      MessageDlg('The page is in your Resricted sites list zone.', mtInformation, [mbOK], 0)
   else
      MessageDlg('The page is not in your Resricted sites list zone!', mtInformation, [mbOK], 0)
end;

procedure TfrmMain.AddToTrustedListZoneList1Click(Sender: TObject);
begin
   EmbeddedWB1.AddToTrustedSiteList(EmbeddedWB1.LocationURL);
end;

procedure TfrmMain.CheckIfInTrustedZoneList1Click(Sender: TObject);
begin
   if EmbeddedWB1.CheckIfInTrustedList(EmbeddedWB1.LocationURL, False) then
      MessageDlg('The page is in your truested sites list zone.', mtInformation, [mbOK], 0)
   else
      MessageDlg('The page is not in your truested sites list zone!', mtInformation, [mbOK], 0)
end;

procedure TfrmMain.CheckSiteSecurityLevel1Click(Sender: TObject);
var
   Name, Description: string;
begin
   if EmbeddedWB1.GetSSLStatus(Name, Description) then
      ShowMessage('Secure Type: ' + Name + #10 + #13 + 'Description: ' + Description)
   else
      ShowMessage('The site is not secured.');
end;

procedure TfrmMain.CheckSiteSecurityZone1Click(Sender: TObject);
var
   Name, Description: string;
   Icon: TIcon;
begin
   EmbeddedWB1.GetURLSecurityZone(Name, Description, Icon);
   ShowMessage('The Web SIte Security Zone Is: ' + Name);
end;

procedure TfrmMain.CheckPageSecurityEncryption1Click(Sender: TObject);
begin
   ShowMessage(EncryptionSt);
end;

procedure TfrmMain.FavoritesTree1NodeAdded(Sender: TObject;
   const aNode: TTreeNode; aNodeType: TNodeType);
begin
   with aNode do
      begin
         if Text = 'Tools' then
            ImageIndex := 0
         else
            if Text = 'Organize favorites' then
               ImageIndex := 1
            else
               if Text = 'Add To favorites' then
                  ImageIndex := 2
               else
                  if Text = 'Import favorites' then
                     ImageIndex := 3
                  else
                     if Text = 'Export favorites' then
                        ImageIndex := 4
                     else
                        if Text = 'Favorites' then
                           ImageIndex := 5
                        else
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -