home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Delphi.5 / Samples / sourceD5 / browutil.exe / BROWSER / HTMLEDIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-03-08  |  5.7 KB  |  217 lines
  1. unit HtmlEdit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComCtrls, Menus, OleCtrls, NMHTML, ExtCtrls, ToolWin, Buttons;
  8.  
  9. type
  10.   TFrmHTMLEdit = class(TForm)
  11.     PopupMenu1: TPopupMenu;
  12.     Print1: TMenuItem;
  13.     SaveDialog1: TSaveDialog;
  14.     HTML1: THTML;
  15.     Panel1: TPanel;
  16.     ComboBox1: TComboBox;
  17.     ViewSource1: TMenuItem;
  18.     ToolBar1: TToolBar;
  19.     SpeedButton1: TSpeedButton;
  20.     SpeedButton2: TSpeedButton;
  21.     SpeedButton3: TSpeedButton;
  22.     SpeedButton4: TSpeedButton;
  23.     procedure FormActivate(Sender: TObject);
  24.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  25.     procedure FormDestroy(Sender: TObject);
  26.     procedure FormResize(Sender: TObject);
  27.     procedure Print1Click(Sender: TObject);
  28.     procedure ViewSource1Click(Sender: TObject);
  29.     procedure HTML1DoRequestDoc(Sender: TObject; const URL: WideString;
  30.       Element: HTMLElement; DocInput: DocInput;
  31.       var EnableDefault: WordBool);
  32.     procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;
  33.       Shift: TShiftState);
  34.     procedure HTML1MouseUp(Sender: TObject; Button: TMouseButton;
  35.       Shift: TShiftState; X, Y: Integer);
  36.     procedure SpeedButton1Click(Sender: TObject);
  37.     procedure SpeedButton2Click(Sender: TObject);
  38.     procedure SpeedButton3Click(Sender: TObject);
  39.     procedure SpeedButton4Click(Sender: TObject);
  40.   private
  41.     { Private declarations }
  42.     function ConvertHTMLPath(sString : String) : String;
  43.   public
  44.     { Public declarations }
  45.     sFileName : String;
  46.     procedure OpenHTMLFile(sHTMLFileName : String);
  47.     procedure SaveToFile(sHTMLFileName : String);
  48.   end;
  49.  
  50. var
  51.   FrmHTMLEdit: TFrmHTMLEdit;
  52.  
  53. implementation
  54.  
  55. uses Menu, Literals;
  56.  
  57. {$R *.DFM}
  58.  
  59. procedure TFrmHTMLEdit.OpenHTMLFile(sHTMLFileName : String);
  60. begin
  61.   sHTMLFileName := ConvertHTMLPath(sHTMLFileName);
  62. //  Self.Caption := HS_URLString+sHTMLFileName;
  63.   ComboBox1.Items.Clear;
  64.   if (sHTMLFileName <> '') then begin
  65.       sFileName := sHTMLFileName;
  66.       HTML1.RequestDoc(HS_URLString+sHTMLFileName);
  67.     end
  68.   else
  69.     begin
  70.       sFileName := '';
  71.       Self.Caption := 'Document';
  72.     end;
  73. //  FrmMenu.AddWindowItem(Self.Name,Self.Caption);
  74. end;
  75.  
  76. procedure TFrmHTMLEdit.SaveToFile(sHTMLFileName : String);
  77. begin
  78.   if (sHTMLFileName = '') then begin
  79.     SaveDialog1.FileName := 'Document';
  80.     if (SaveDialog1.Execute) then begin
  81.       sHTMLFileName := SaveDialog1.FileName;
  82.       sFileName := ExtractFileName(SaveDialog1.FileName);
  83.     end;
  84.   end;
  85. end;
  86.  
  87. procedure TFrmHTMLEdit.FormActivate(Sender: TObject);
  88. begin
  89.   FrmMenu.ShowClose(True);
  90.   FrmMenu.ShowQueryMenuItem(False);
  91.   FrmMenu.ShowTableMenuItem(False);
  92.   FrmMenu.ShowTextFileMenuItem(True);
  93. end;
  94.  
  95. procedure TFrmHTMLEdit.FormClose(Sender: TObject;
  96.   var Action: TCloseAction);
  97. begin
  98.   Action := caFree;
  99. end;
  100.  
  101. procedure TFrmHTMLEdit.FormDestroy(Sender: TObject);
  102. begin
  103.   FrmMenu.ShowClose(False);
  104. //  if (FindDialog1.Handle <> 0) then
  105. //    SendMessage(FindDialog1.Handle,WM_Close,0,0);
  106. //  FrmMenu.RemoveWindowItem(Self.Name)
  107. end;
  108.  
  109. function TFrmHTMLEdit.ConvertHTMLPath(sString : String) : String;
  110.   procedure ReplaceChr(var sText : String; sSearchChar, sReplaceChar : Char);
  111.   var
  112.     I : Integer;
  113.   begin
  114.     for I := 0 to Length(sText) do begin
  115.       if sText[I] = sSearchChar then
  116.         sText[I] := sReplaceChar;
  117.     end;
  118.   end;
  119. begin
  120.   ReplaceChr(sString,':','|');
  121.   ReplaceChr(sString,'\','/');
  122.   Result := sString;
  123. end;
  124.  
  125. procedure TFrmHTMLEdit.FormResize(Sender: TObject);
  126. begin
  127.   ComboBox1.Width := Panel1.Width; 
  128. end;
  129.  
  130. procedure TFrmHTMLEdit.Print1Click(Sender: TObject);
  131. begin
  132.   HTML1.AutoPrint(HTML1.Handle);
  133. end;
  134.  
  135. procedure TFrmHTMLEdit.ViewSource1Click(Sender: TObject);
  136. begin
  137.   HTML1.ViewSource := not HTML1.ViewSource;
  138.   if HTML1.ViewSource then
  139.     ViewSource1.Caption := 'View HTML'
  140.   else
  141.     ViewSource1.Caption := 'View Source';
  142. end;
  143.  
  144. procedure TFrmHTMLEdit.HTML1DoRequestDoc(Sender: TObject;
  145.   const URL: WideString; Element: HTMLElement; DocInput: DocInput;
  146.   var EnableDefault: WordBool);
  147. begin
  148.   ComboBox1.Items.Add(URL);
  149.   ComboBox1.ItemIndex := ComboBox1.Items.Count-1;
  150. end;
  151.  
  152. procedure TFrmHTMLEdit.ComboBox1KeyDown(Sender: TObject; var Key: Word;
  153.   Shift: TShiftState);
  154. begin
  155.   if (Key = 13) and (UpperCase(ComboBox1.Text) <> UpperCase(HTML1.URL)) then begin
  156.     try
  157.       HTML1.RequestDoc(ComboBox1.Text);
  158.     except
  159.       raise;
  160.     end;
  161.   end;
  162. end;
  163.  
  164. procedure TFrmHTMLEdit.HTML1MouseUp(Sender: TObject; Button: TMouseButton;
  165.   Shift: TShiftState; X, Y: Integer);
  166. begin
  167.   if (Button = mbRight) then begin
  168.     PopupMenu1.Popup(X,Y);
  169.   end;
  170. end;
  171.  
  172. procedure TFrmHTMLEdit.SpeedButton1Click(Sender: TObject);
  173. var
  174.   sURL : String;
  175. begin
  176.   sURL := '';
  177.   if (ComboBox1.ItemIndex < ComboBox1.Items.Count) then begin
  178.     sURL := ComboBox1.Items.Strings[ComboBox1.ItemIndex+1];
  179.     HTML1.RequestDoc(sURL);
  180.   end;
  181. end;
  182.  
  183. procedure TFrmHTMLEdit.SpeedButton2Click(Sender: TObject);
  184. var
  185.   sURL : String;
  186. begin
  187.   sURL := '';
  188.   if (ComboBox1.ItemIndex > ComboBox1.Items.Count) then begin
  189.     sURL := ComboBox1.Items.Strings[ComboBox1.ItemIndex-1];
  190.     HTML1.RequestDoc(sURL);
  191.   end;
  192. end;
  193.  
  194. procedure TFrmHTMLEdit.SpeedButton3Click(Sender: TObject);
  195. var
  196.   sURL : String;
  197. begin
  198.   sURL := '';
  199.   if (ComboBox1.ItemIndex < ComboBox1.Items.Count) then begin
  200.     sURL := ComboBox1.Items.Strings[ComboBox1.ItemIndex+1];
  201.     HTML1.RequestDoc(sURL);
  202.   end;
  203. end;
  204.  
  205. procedure TFrmHTMLEdit.SpeedButton4Click(Sender: TObject);
  206. var
  207.   sURL : String;
  208. begin
  209.   sURL := '';
  210.   if (ComboBox1.ItemIndex > ComboBox1.Items.Count) then begin
  211.     sURL := ComboBox1.Items.Strings[ComboBox1.ItemIndex-1];
  212.     HTML1.RequestDoc(sURL);
  213.   end;
  214. end;
  215.  
  216. end.
  217.