Текущий архив: 2006.09.24;
Скачать: CL | DM;

Вниз

загрузка html страницы   Найти похожие ветки 

← →
~viper~   (2006-08-13 22:54) [0]

Всем привет!
Как подцепить ProgressBar к WebBrowser?
Чтобы при загрузке сайта отображался ход загрузки...
Спасибо!

---

← →
DiamondShark ©   (2006-08-13 23:37) [1]

Очень просто.


unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 OleCtrls, SHDocVw, StdCtrls, ComCtrls;

type
 TForm1 = class(TForm, IUnknown, IDispatch)
   WebBrowser1: TWebBrowser;
   Button1: TButton;
   ProgressBar1: TProgressBar;
   procedure FormCreate(Sender: TObject);
   procedure Button1Click(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
   function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
   function GetIDsOfNames(const IID: TGUID; Names: Pointer;
     NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
   function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
     Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
 private
   FConnectionCookie: Integer;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

uses
 ComObj,
 ActiveX;

const
 DISPID_PROGRESSCHANGE = 108;

function TForm1.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
 LocaleID: Integer; DispIDs: Pointer): HResult;
begin
 Result := E_NOTIMPL;
end;

function TForm1.GetTypeInfo(Index, LocaleID: Integer;
 out TypeInfo): HResult;
begin
 Result := E_NOTIMPL;
end;

function TForm1.GetTypeInfoCount(out Count: Integer): HResult;
begin
 Result := E_NOTIMPL;
end;

function TForm1.Invoke(DispID: Integer; const IID: TGUID;
 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
 ArgErr: Pointer): HResult;
var
 dp: DISPPARAMS absolute Params;
begin
 case DispID of
   DISPID_PROGRESSCHANGE: begin
     ProgressBar1.Max := OleVariant(dp.rgvarg[0]);
     ProgressBar1.Position := OleVariant(dp.rgvarg[1]);
   end;
 end;
 Result := S_OK;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 cpc: IConnectionPointContainer;
 cp: IConnectionPoint;
begin
 cpc := WebBrowser1.ControlInterface as IConnectionPointContainer;
 OleCheck( cpc.FindConnectionPoint(DWebBrowserEvents2, cp) );
 OleCheck( cp.Advise(self as IDispatch, FConnectionCookie) );
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
 cpc: IConnectionPointContainer;
 cp: IConnectionPoint;
begin
 if FConnectionCookie <> 0 then
   begin
     cpc := WebBrowser1.ControlInterface as IConnectionPointContainer;
     OleCheck( cpc.FindConnectionPoint(DWebBrowserEvents2, cp) );
     OleCheck( cp.Unadvise(FConnectionCookie) );
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 WebBrowser1.Navigate("http://www.delphimaster.ru");
end;

end.


---

← →
Stexen   (2006-08-14 18:04) [2]

Там же ОнПрогресс был по моему, или я что-то путаю?

---

← →
DiamondShark ©   (2006-08-14 18:26) [3]

Он там должен быть, но почему-то нет. По крайней мере, в Дельфи 5.
А вот если деинсталировать борландовский пакет с WebBrowser и заново импортировать shdocvw.dll, то есть.

Наверное, борландцы свой WebBrowses с очень старого ИЕ импортировали.

---

Страницы: 1 вся ветка

Текущий архив: 2006.09.24;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.028 c