fweb.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

unit fWeb;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, MSHTMLEvents2, ComCtrls, ieConst, IEDocHostUIHandler, ie5tools, MSHTML_TLB,
  SHDocVw_TLB, ExtCtrls;

type
  TfrmWeb = class(TForm)
    stbWeb: TStatusBar;
    www: TWebBrowser;
    procedure wwwTitleChange(Sender: TObject; const Text: WideString);
    procedure wwwProgressChange(Sender: TObject; Progress,
      ProgressMax: Integer);
    procedure wwwStatusTextChange(Sender: TObject; const Text: WideString);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure wwwCommandStateChange(Sender: TObject; Command: Integer;
      Enable: WordBool);
    procedure FormActivate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure wwwNavigateComplete2(Sender: TObject; const pDisp: IDispatch;
      var URL: OleVariant);
    function MSHTMLHTMLElementEvents1keypress(Sender: TObject): WordBool;
    procedure MSHTMLHTMLElementEvents21mouseleave(Sender: TObject;
      const pEvtObj: IHTMLEventObj);
    function MSHTMLHTMLDocumentEvents1keypress(Sender: TObject): WordBool;
    procedure MSHTMLHTMLDocumentEvents1keydown(Sender: TObject);
  private
    pStatus: Real;
    pbWeb: TProgressBar;
    FDocHostUIHandler: TDocHostUIHandler;
    { Private declarations }

  public
    { Public declarations }
  end;

var
  frmWeb: TfrmWeb;

implementation

uses fMain;

{$R *.dfm}

procedure TfrmWeb.wwwTitleChange(Sender: TObject; const Text: WideString);
var
  idx: Integer;
begin
  Self.Caption := Text;
  idx := frmMain.tcFiles.Tabs.IndexOfObject(Self);
  frmMain.tcFiles.Tabs[idx] := Text;
end;

procedure TfrmWeb.wwwProgressChange(Sender: TObject; Progress,
  ProgressMax: Integer);
begin
  if ProgressMax <> 0 then begin
    pStatus := (Progress / ProgressMax) * 100;
    pbWeb.Max := ProgressMax;
    pbWeb.Position := Progress;
    stbWeb.Panels[2].Text := Format('%n%%', [pStatus]);
  end;
end;

procedure TfrmWeb.wwwStatusTextChange(Sender: TObject;
  const Text: WideString);
begin
  stbWeb.Panels[0].Text := Text;
end;

procedure TfrmWeb.FormClose(Sender: TObject; var Action: TCloseAction);
var
  idx: Integer;
begin
  idx := frmMain.tcFiles.Tabs.IndexOfObject(Self);
  if idx > -1 then begin
    frmMain.tcFiles.Tabs.Delete(idx);
  end;
  FDocHostUIHandler.Free;
  
  Action := caFree;
end;

procedure TfrmWeb.wwwCommandStateChange(Sender: TObject; Command: Integer;
  Enable: WordBool);
begin
      case Command of
        CSC_NAVIGATEBACK :
        begin
          frmMain.tbbBack.Enabled := Enable;
        end;

        CSC_NAVIGATEFORWARD :
        begin
          frmMain.tbbForward.Enabled := Enable;
        end;
      end;



end;

procedure TfrmWeb.FormActivate(Sender: TObject);
var
  idx: Integer;
begin
  idx := frmMain.tcFiles.Tabs.IndexOfObject(Self);
  if (idx > -1) and (idx <> frmMain.tcFiles.TabIndex) then begin
    frmMain.tcFiles.TabIndex := idx;
    frmMain.tcFilesChange(nil);
  end;
end;

procedure TfrmWeb.FormResize(Sender: TObject);
begin
  stbWeb.Panels[0].Width := (stbWeb.ClientWidth - 300);
  pbWeb.Left := stbWeb.Panels.Items[0].Width + 4;
  pbWeb.Top := 4;
  pbWeb.Height := stbWeb.Height - 6;
  pbWeb.Width := stbWeb.Panels.Items[2].Width - 6;  
end;

procedure TfrmWeb.FormCreate(Sender: TObject);
var
  ProgressBarStyle: LongInt;
begin
  {create a run progress bar in the status bar}
  DisableFileNew(false);
  FDocHostUIHandler := TDocHostUIHandler.Create;

  pbWeb := TProgressBar.Create(stbWeb);
  pbWeb.Parent := stbWeb;
  pbWeb.Smooth := True;  
  {remove progress bar border}
  ProgressBarStyle := GetWindowLong(pbWeb.Handle, GWL_EXSTYLE);
  ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
  SetWindowLong(pbWeb.Handle, GWL_EXSTYLE, ProgressBarStyle);
  {set progress bar position and size - put in Panel[2]}

  {set range and initial state}
  pbWeb.Min := 0;
  pbWeb.Max := 100;
  pbWeb.Step := 1;
  pbWeb.Position := 0;
  FormResize(nil);
end;

procedure TfrmWeb.wwwNavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  hr: HResult;
  CustDoc: ICustomDoc;
begin
  hr := www.Document.QueryInterface(ICustomDoc, CustDoc);
  if hr = S_OK then
    CustDoc.SetUIHandler(FDocHostUIHandler);

end;

function TfrmWeb.MSHTMLHTMLElementEvents1keypress(
  Sender: TObject): WordBool;
begin
  MessageBox(0, 'test', 'test', 0);
end;

procedure TfrmWeb.MSHTMLHTMLElementEvents21mouseleave(Sender: TObject;
  const pEvtObj: IHTMLEventObj);
begin
  messageBOx(0, 'test1', 'test', 0);
end;

function TfrmWeb.MSHTMLHTMLDocumentEvents1keypress(
  Sender: TObject): WordBool;
begin
  MessageBox(0, 'test', 'test', 0);
end;

procedure TfrmWeb.MSHTMLHTMLDocumentEvents1keydown(Sender: TObject);
begin
  MessageBox(0, 'test', 'test', 0);
end;

end.