iecontroller.pas

delphi写的 HTML控制,简单代码,转

unit IEController;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  shdocvw;

type
  EIEControlError = class(Exception);
  EIEControlExecError = class(EIEControlError);
  TIEController = class(TComponent)
  private
    { Private declarations }
    FIE:       IWebBrowser2;
    function  GetIEAddressBarVisible: Boolean;
    function  GetIEFullScreen: Boolean;
    function  GetIEHeight: Integer;
    function  GetIELeft: Integer;
    function  GetIEMenuBarVisible: Boolean;
    function  GetIEOffLine: Boolean;
    function  GetIEResizable: Boolean;
    function  GetIESilent: Boolean;
    function  GetIEStatusBarVisible: Boolean;
    function  GetIEStatusText: String;
    function  GetIETheaterMode: Boolean;
    function  GetIEToolbarVisible: Boolean;
    function  GetIETop: Integer;
    function  GetIEVisible: Boolean;
    function  GetIEWidth: Integer;
    function  GetIEURL: String;
    procedure SetIEAddressBarVisible(const Value: Boolean);
    procedure SetIEFullScreen(const Value: Boolean);
    procedure SetIEHeight(const Value: Integer);
    procedure SetIELeft(const Value: Integer);
    procedure SetIEMenuBarVisible(const Value: Boolean);
    procedure SetIEOffline(const Value: Boolean);
    procedure SetIEResizable(const Value: Boolean);
    procedure SetIESilent(const Value: Boolean);
    procedure SetIEStatusBarVisible(const Value: Boolean);
    procedure SetIEStatusText(const Value: String);
    procedure SetIETheaterMode(const Value: Boolean);
    procedure SetIEToolbarVisible(const Value: Boolean);
    procedure SetIETop(const Value: Integer);
    procedure SetIEVisible(const Value: Boolean);
    procedure SetIEURL(const Value: String);
    procedure SetIEWidth(const Value: Integer);
  protected
    { Protected declarations }
    function IEExecWB(CmdId, CmdOption: Integer;
                      VarIn, VarOut: OleVariant): Boolean;
  public
    { Public declarations }
    function  GetIEWindowHandle: HWND;
    procedure IEClose;
    procedure IEGoBack;
    procedure IEGoForward;
    procedure IEGoHome;
    procedure IEGoSearch;
    procedure IEOpen;
    procedure IEPrint(ShowDlg: Boolean);
    procedure IEPrintPreview;
    procedure IERefresh;
    procedure IESave;
    procedure IESaveAs(FileName: String);
    procedure IEShow;
    procedure IEStop;
    function  IsIEBusy: Boolean;
    function  IsIEOpen: Boolean;
    property IEAddressBarVisible: Boolean read GetIEAddressBarVisible
               write SetIEAddressBarVisible;
    property IEFullScreen: Boolean read GetIEFullScreen
               write SetIEFullScreen; 
    property IEHeight: Integer read GetIEHeight write SetIEHeight;
    property IELeft: Integer read GetIELeft write SetIELeft;
    property IEMenuBarVisible: Boolean read GetIEMenuBarVisible
               write SetIEMenuBarVisible;
    property IEOffline: Boolean read GetIEOffline write SetIEOffline;
    property IEResizable: Boolean read GetIEResizable write SetIEResizable;
    property IESilent: Boolean read GetIESilent write SetIESilent;
    property IEStatusBarVisible: Boolean read GetIEStatusBarVisible
               write SetIEStatusBarVisible;
    property IEStatusText: String read GetIEStatusText write SetIEStatusText;
    property IETheaterMode: Boolean read GetIETheaterMode
               write SetIETheaterMode;
    property IEToolbarVisible: Boolean read GetIEToolbarVisible
               write SetIEToolbarVisible;
    property IETop: Integer read GetIETop write SetIETop;
    property IEVisible: Boolean read GetIEVisible write SetIEVisible;
    property IEWidth: Integer read GetIEWidth write SetIEWidth;
    property IEURL: String read GetIEURL write SetIEURL;
  published
    { Published declarations }
  end;

procedure Register;

implementation

uses ComObj;

procedure Register;
begin
  RegisterComponents('DGI', [TIEController]);
end;

{ TIEController }

function TIEController.IEExecWB(CmdId, CmdOption: Integer; VarIn,
  VarOut: OleVariant): Boolean;
begin
  if FIE.QueryStatusWB(CmdId) = OLECMDF_ENABLED + OLECMDF_SUPPORTED then
    try
      FIE.ExecWB(CmdId, CmdOption, VarIn, VarOut)
    except
      raise EIEControlExecError('Command execution failed. (Id: ' +
                                IntToStr(CmdId) + ')');
    end
  else
    raise EIEControlExecError.Create('The function you requested is not ' +
                                     'available. (Id: ' +
                                     IntToStr(CmdId) + ')');
end;

procedure TIEController.IEClose;
begin
  if IsIEOpen then
  begin
    FIE.Quit;
    FIE := nil;
  end;
end;

function TIEController.GetIEHeight: Integer;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_Height;
end;

function TIEController.GetIELeft: Integer;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_Left;
end;

function TIEController.GetIEWindowHandle: HWND;
begin
  try
    if Assigned(FIE) then
      Result := FIE.Get_HWND
    else
      Result := 0;
  except
    Result := 0;
  end;
end;

function TIEController.GetIEURL: String;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_LocationURL;
end;

function TIEController.GetIEAddressBarVisible: Boolean;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_AddressBar;
end;

function TIEController.IsIEBusy: Boolean;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_Busy;
end;

function TIEController.GetIEMenuBarVisible: Boolean;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_MenuBar;
end;

procedure TIEController.IEOpen;
begin
  FIE := CoInternetExplorer.Create;
end;

procedure TIEController.SetIEURL(const Value: String);
var
  Flags:             OleVariant;
  TargetFrameName:   OleVariant;
  PostData:          OleVariant;
  Headers:           OleVariant;
begin
  if not IsIEOpen then IEShow;
  FIE.Navigate(Value, Flags, TargetFrameName, PostData, Headers);
end;

procedure TIEController.SetIEAddressBarVisible(const Value: Boolean);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_AddressBar(Value);
end;

procedure TIEController.SetIEVisible(const Value: Boolean);
begin
  if not IsIEOpen then IEShow;
  FIE.Visible := Value;
end;

function TIEController.GetIEOffLine: Boolean;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_Offline;
end;

function TIEController.GetIEVisible: Boolean;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Visible;
end;

procedure TIEController.SetIEMenuBarVisible(const Value: Boolean);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_MenuBar(Value);
end;

procedure TIEController.SetIEHeight(const Value: Integer);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_Height(Value);
end;

procedure TIEController.SetIELeft(const Value: Integer);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_Left(Value);
end;

procedure TIEController.SetIEOffline(const Value: Boolean);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_Offline(Value);
end;

function TIEController.GetIETop: Integer;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_Top;
end;

procedure TIEController.SetIETop(const Value: Integer);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_Top(Value);
end;

function TIEController.GetIEWidth: Integer;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_Width;
end;

procedure TIEController.SetIEWidth(const Value: Integer);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_Width(Value);
end;

function TIEController.GetIEFullScreen: Boolean;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_FullScreen;
end;

procedure TIEController.SetIEFullScreen(const Value: Boolean);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_FullScreen(Value);
end;

function TIEController.GetIEResizable: Boolean;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_Resizable;
end;

procedure TIEController.SetIEResizable(const Value: Boolean);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_Resizable(Value);
end;

function TIEController.GetIESilent: Boolean;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_Silent;
end;

procedure TIEController.SetIESilent(const Value: Boolean);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_Silent(Value);
end;

function TIEController.GetIEStatusBarVisible: Boolean;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_StatusBar;
end;

procedure TIEController.SetIEStatusBarVisible(const Value: Boolean);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_StatusBar(Value);
end;

procedure TIEController.SetIEStatusText(const Value: String);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_StatusText(Value);
end;

function TIEController.GetIEStatusText: String;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_StatusText;
end;

function TIEController.GetIETheaterMode: Boolean;
begin
  if not IsIEOpen then IEShow;
  Result := FIE.Get_TheaterMode;
end;

procedure TIEController.SetIETheaterMode(const Value: Boolean);
begin
  if not IsIEOpen then IEShow;
  FIE.Set_TheaterMode(Value);
end;

function TIEController.GetIEToolbarVisible: Boolean;
var
  Visible:      Integer;
begin
  if not IsIEOpen then IEShow;
  Visible := FIE.Get_Toolbar;
  if Visible = 0 then
    Result := False
  else
    Result := True;
end;

procedure TIEController.SetIEToolbarVisible(const Value: Boolean);
begin
  if not IsIEOpen then IEShow;
  if Value then
    FIE.Set_ToolBar(1)
  else
    FIE.Set_ToolBar(0);
end;

procedure TIEController.IEGoBack;
begin
  if not IsIEOpen then IEShow;
  try
    FIE.GoBack;
  except
  end;
end;

procedure TIEController.IEGoForward;
begin
  if not IsIEOpen then IEShow;
  try
    FIE.GoForward;
  except
  end;
end;

procedure TIEController.IEGoHome;
begin
  if not IsIEOpen then IEShow;
  FIE.GoHome;
end;

procedure TIEController.IEGoSearch;
begin
  if not IsIEOpen then IEShow;
  FIE.GoSearch;
end;

procedure TIEController.IERefresh;
begin
  if not IsIEOpen then IEShow;
  FIE.Refresh;
end;

procedure TIEController.IEShow;
begin
  IEOpen;
  IEVisible := True;
end;

function TIEController.IsIEOpen: Boolean;
begin
  if GetIEWindowHandle = 0 then
    Result := False
  else
    Result := True;
end;

procedure TIEController.IEPrint(ShowDlg: Boolean);
var
  V:    OleVariant;
begin
  if ShowDlg then
    IEExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, V, V)
  else
    IEExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, V, V);
end;

procedure TIEController.IEPrintPreview;
var
  V:    OleVariant;
begin
  IEExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT, V, V);
end;

procedure TIEController.IESave;
var
  V:    OleVariant;
begin
  IEExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DODEFAULT, V, V);
end;

procedure TIEController.IESaveAs(FileName: String);
var
  VarIn,
  VarOut:    OleVariant;
begin
  VarIn := FileName;
  IEExecWB(OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT, VarIn, VarOut);
end;

procedure TIEController.IEStop;
var
  V:         OleVariant;
begin
  IEExecWB(OLECMDID_STOP, OLECMDEXECOPT_DODEFAULT, V, V);
end;

end.