Форум: "Основная";
Текущий архив: 2006.09.24;
Скачать: [xml.tar.bz2];
Вниззагрузка 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;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.043 c