开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
WebDemoF.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：2k
源码类别：

Delphi控件源码

开发平台：

Delphi

WebDemoF.pas：源码内容
  1. unit WebDemoF;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Buttons, ExtCtrls, OleCtrls, StdCtrls, ComCtrls, ToolWin,
  8.   ImgList, shdocvw;
  10. type
  11.   TForm1 = class(TForm)
  12.     WebBrowser1: TWebBrowser;
  13.     OpenDialog1: TOpenDialog;
  14.     StatusBar1: TStatusBar;
  15.     ControlBar1: TControlBar;
  16.     Panel1: TPanel;
  17.     BtnOpen: TSpeedButton;
  18.     BtnGo: TSpeedButton;
  19.     ComboURL: TComboBox;
  20.     procedure BtnOpenClick(Sender: TObject);
  21.     procedure WebBrowser1DownloadComplete(Sender: TObject);
  22.     procedure WebBrowser1TitleChange(Sender: TObject;
  23.       const Text: WideString);
  24.     procedure BtnGoClick(Sender: TObject);
  25.     procedure ComboURLKeyPress(Sender: TObject; var Key: Char);
  26.     procedure FormShow(Sender: TObject);
  27.     procedure WebBrowser1StatusTextChange(Sender: TObject;
  28.       const Text: WideString);
  29.     procedure WebBrowser1DownloadBegin(Sender: TObject);
  30.   private
  31.     { Private declarations }
  32.   public
  33.     procedure GotoPage (ReqUrl: string);
  34.   end;
  36. var
  37.   Form1: TForm1;
  39. implementation
  41. {$R *.DFM}
  43. procedure TForm1.BtnOpenClick(Sender: TObject);
  44. begin
  45.   if OpenDialog1.Execute then
  46.       GotoPage (OpenDialog1.FileName);
  47. end;
  49. procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);
  50. var
  51.   NewUrl: string;
  52. begin
  53.   StatusBar1.Panels[0].Text := 'Done';
  54.   // add URL to combobox
  55.   NewUrl := WebBrowser1.LocationURL;
  56.   if (NewUrl <> '') and
  57.       (ComboURL.Items.IndexOf (NewUrl) < 0) then
  58.     ComboURL.Items.Add (NewUrl);
  59. end;
  61. procedure TForm1.WebBrowser1TitleChange(Sender: TObject;
  62.   const Text: WideString);
  63. begin
  64.   Caption := Text;
  65. end;
  67. procedure TForm1.BtnGoClick(Sender: TObject);
  68. begin
  69.   GotoPage (ComboUrl.Text);
  70. end;
  72. procedure TForm1.ComboURLKeyPress(Sender: TObject; var Key: Char);
  73. begin
  74.   if Key = #13 then
  75.     GotoPage (ComboUrl.Text);
  76. end;
  78. procedure TForm1.FormShow(Sender: TObject);
  79. begin
  80.   GotoPage (ExtractFilePath (Application.ExeName) +
  81.     'greeting.htm');
  82. end;
  84. procedure TForm1.GotoPage(ReqUrl: string);
  85. begin
  86.   WebBrowser1.Navigate (ReqUrl, EmptyParam, EmptyParam,
  87.     EmptyParam, EmptyParam);
  88. end;
  90. procedure TForm1.WebBrowser1StatusTextChange(Sender: TObject;
  91.   const Text: WideString);
  92. begin
  93.   StatusBar1.Panels[1].Text := Text;
  94. end;
  96. procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);
  97. begin
  98.   StatusBar1.Panels[0].Text := 'Downloading ' +
  99.     WebBrowser1.LocationURL + '...';
  100. end;
  102. end.