BrowseForm.pas
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:2k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit BrowseForm; interface uses   SysUtils, Types, Classes, Variants, QGraphics, QControls, QForms, QDialogs,   QStdCtrls, QComCtrls, IdBaseComponent, IdComponent, IdTCPConnection,   IdTCPClient, IdHTTP, QExtCtrls, IdURI; type   TForm1 = class(TForm)     ToolBar1: TToolBar;     ToolButton4: TToolButton;     PageControl1: TPageControl;     TabSheet1: TTabSheet;     TabSheet2: TTabSheet;     Memo1: TMemo;     ComboURL: TComboBox;     TextBrowser1: TTextBrowser;     IdHTTP1: TIdHTTP;     StatusBar1: TStatusBar;     ToolButton2: TToolButton;     procedure ToolButton4Click(Sender: TObject);     procedure ComboURLKeyPress(Sender: TObject; var Key: Char);     procedure TextBrowser1HighlightText(Sender: TObject;
  2.       const HighlightedText: WideString);     procedure TextBrowser1Click(Sender: TObject);     procedure ToolButton2Click(Sender: TObject);   private     LastUrl, NewRequest: String;     nPos: Integer;   public     procedure GoToUrl (NewUrl: String);   end; var   Form1: TForm1; implementation {$R *.xfm} procedure TForm1.ToolButton4Click(Sender: TObject); begin
  3.   GoToUrl (ComboUrl.Text);
  4.   // reset back button
  5.   nPos := 0;
  6. end;
  7. procedure TForm1.ComboURLKeyPress(Sender: TObject; var Key: Char); begin
  8.   if Key = #13 then
  9.     ToolButton4Click (Sender);
  10. end;
  11. procedure TForm1.TextBrowser1HighlightText(Sender: TObject;   const HighlightedText: WideString);
  12. begin
  13.   StatusBar1.SimpleText := 'Goto: ' + HighlightedText;
  14.   NewRequest := HighlightedText;
  15. end;
  16. procedure TForm1.TextBrowser1Click(Sender: TObject); var
  17.   Uri: TIdUri;
  18. begin
  19.   if NewRequest <> '' then
  20.   begin
  21.     Uri := TIdUri.Create (LastUrl);
  22.     if Pos ('http:', NewRequest) > 0 then
  23.       GoToUrl (NewRequest)
  24.     else if NewRequest [1] = '/' then
  25.       GoToUrl ('http://' + Uri.Host + NewRequest)
  26.     else
  27.       GoToUrl ('http://' + Uri.Host + Uri.Path + NewRequest);
  28.     nPos := 0;
  29.   end;
  30. end;
  31. procedure TForm1.GoToUrl(NewUrl: String); begin
  32.   // add to history list
  33.   if (NewUrl <> '') then
  34.   begin
  35.     if ComboURL.Items.IndexOf (NewUrl) < 0 then
  36.       ComboURL.Items.Insert (0, NewUrl);
  37.     ComboURL.Text := NewUrl;
  38.   end;
  39.   TextBrowser1.Text := IdHttp1.Get (NewUrl);
  40.   Memo1.Lines.Text := TextBrowser1.Text;
  41.   // TextBrowser1.Factory.FilePath.Add (NewUrl);
  42.   LastUrl := NewUrl;
  43.   NewRequest := '';
  44. end;
  45. procedure TForm1.ToolButton2Click(Sender: TObject); begin
  46.   Inc (nPos);
  47.   if NPos < ComboUrl.Items.Count then
  48.     GoToUrl(ComboUrl.Items[nPos])
  49.   else
  50.     ToolButton2.Enabled := False;
  51. end;
  52. end.