Главная » Использование компонента TWebBrowser
Вопрос: Что такое Веббраузер?

Ответ: Веббраузер это microsoft's internet explorer в виде activex контрола.
Его можно импортировать в delphi ide и размещать на форме на равне с другими компонентами.
Поэтому, чтобы превратить Ваше приложение в браузер, достаточно воспользоваться всей мощью ie.

Вопрос: Где можно найти документацию на webbrowser?

Ответ: Можно заглянуть на сайт microsoft в раздел webbrowser overview,
а так же на страницу webbrowser object.

Вопрос: Как использовать компонент webbrowser в своём delphi приложение?

Ответ: Для этого необходимо, чтобы у Вас был установлен internet explorer.
В меню в delphi ide, выберите " component - import activex control" .
Далее выберите " microsoft internet controls" и добавьте его как
новый исполняемы пакет. delphi сгенерирует файл shdocvw_tlb.pas и добавит
компонент webbrowser в закладку компонентов activex.

Вопрос: Я вижу 2 компонента в закладке компонетов activex,
webbrowser и webbrowser_v1. Какой из них нужно использовать?

Ответ: Если у Вас 2 компонента, то в системе установлен ie 4.x или выше.
Соответственно webbrowser это ie 4.x а webbrowser_v1 это ie 3.x. Если Вы видете только один компонент,
то будет использоваться webbrowser для ie 3.x.

Вопрос: Как определить, какая версия ie установлена на компьютере?

Ответ: Можно почитать на microsoft site.

Вопрос: Как производить Печать?

Ответ: Есть два способа вывода на печать.
Первый пример работает в ie 4.x и выше,
в то время как второй пример расчитан на ie 3.x:

var
vain, vaout: olevariant;

...

webbrowser.controlinterface.execwb(olecmdid_print,
olecmdexecopt_dontpromptuser, vain, vaout);

либо

procedure tform1.printie;
var
cmdtarget : iolecommandtarget;
vain, vaout: olevariant;
begin
if webbrowser1.document nil then
try
webbrowser1.document.queryinterface(iolecommandtarget, cmdtarget);
if cmdtarget nil then
try
cmdtarget.exec( pguid(nil), olecmdid_print,
olecmdexecopt_dontpromptuser, vain, vaout);
finally
cmdtarget._release;
end;
except
// Ничего
end;
end;

Обратите внимание: Если версия delphi ниже чем 3.02, то необходимо заменить

pguid(nil)
на

pguid(nil)^
. А лучше всего проапгрейдить до 3.02 (если Вы пользуетесь версиями 3.0 или 3.01).

Вопрос: Как вызвать команды find, option или view source?

Ответ: Вот пример вызова диалога find:

const
htmlid_find = 1;
htmlid_viewsource = 2;
htmlid_options = 3;

...

procedure tform1.findie;
const
cgid_webbrowser: tguid = '{ed016940-bd5b-11cf-ba4e-00c04fd70816}';
var
cmdtarget : iolecommandtarget;
vain, vaout: olevariant;
ptrguid: pguid;
begin
new(ptrguid);
ptrguid^ := cgid_webbrowser;
if webbrowser1.document nil then
try
webbrowser1.document.queryinterface(iolecommandtarget, cmdtarget);
if cmdtarget nil then
try
cmdtarget.exec( ptrguid, htmlid_find, 0, vain, vaout);
finally
cmdtarget._release;
end;
except
// Ничего
end;
dispose(ptrguid);
end;

Вопрос: Как запретить всплывающее меню при нажатии правой книпки мыши?

Ответ: Вам необходимо включить интерфейс idochostuihandler.
Для этого Вам понадобятся два файла: ieconst.pas и iedochostuihandler.pas.
В методе showcontextmenu интерфейса idochostuihandler,
необходимо изменить возвращаемое значение с e_notimpl на s_ok.
После этого меню перестанет реагировать на правое нажатие кнопки мыши.
Добавьте два модуля, упомянутые выше в секцию uses и добавьте следующий код:

...

var
form1: tform1;
fdochostuihandler: tdochostuihandler;
...

implementation
...

procedure tform1.formcreate(sender: tobject);
begin
fdochostuihandler := tdochostuihandler.create;
end;

procedure tform1.formclose(sender: tobject; var action: tcloseaction);
begin
fdochostuihandler.free;
end;

procedure tform1.webbrowser1navigatecomplete2(sender: tobject;
pdisp: idispatch; var url: olevariant);
var
hr: hresult;
custdoc: icustomdoc;
begin
hr := webbrowser1.document.queryinterface(icustomdoc, custdoc);
if hr = s_ok then
custdoc.setuihandler(fdochostuihandler);
end;

Вопрос: Как загрузить строковые данные в webbrowser не прибегая к открытию файла?

Ответ: Загрузите строку массив variant, а затем запишите в документ (document):

...

var
v: variant;
htmldocument: ihtmldocument2;
begin
htmldocument := webbrowser1.document as ihtmldocument2;
v := vararraycreate([0, 0], varvariant);
v[0] := htmlstring; // Это Ваша html строка
htmldocument.write(psafearray(tvardata(v).varray));
htmldocument.close;

...
end;

...

Автор: ron loewy

Вопрос: Как загрузить потоковые(stream) данные в webbrowser не прибегая к открытию файла?

Ответ: Вот пример кода:

function tform1.loadfromstream(const astream: tstream): hresult;
begin
astream.seek(0, 0);
result := (webbrowser1.document as
ipersiststreaminit).load(tstreamadapter.create(astream));
end;

Автор: per larsen

Вопрос: Как использовать протокол " about:" ?

Ответ: Протокол " about:" позволяет Вам просмотреть html строку:

procedure tform1.loadhtmlstring(shtml: string);
var
flags, targetframename, postdata, headers: olevariant;
begin
webbrowser1.navigate('about:' + shtml, flags, targetframename, postdata, headers)
end;

Вопрос: Как можно использовать протокол " res:" ?

Ответ: Протокол " res:" позволяет просмотреть html файл, сохранённый как ресурс.
Более подробная информация доступна на microsoft site:

procedure tform1.loadhtmlresource;
var
flags, targetframename, postdata, headers: olevariant;
begin
webbrowser1.navigate('res://' + application.exename + '/myhtml',
flags, targetframename, postdata, headers)
end;

Создайте файл ресурса (*.rc) со следующими строками и откомпилируйте
его при помощи brcc32.exe:

myhtml 23 " .htmlmyhtml.htm"

morehtml 23 " .htmlmorehtml.htm"

Отредактируйте файл проекта, чтобы он выглядел примерно так:

{$r *.res}
{$r html.res} //где html.rc будет скомпилирован в html.res

Вопрос: Как получить полный исходник html?

Ответ: В ie5, можно получить исходник используя свойство outerhtml тэгов
html. В ie4 или ie3, Вам понадобится записать документ в файл, а затем
загрузить файл в tmemo, tstrings, и т.д.

var
htmldocument: ihtmldocument2;
persistfile: ipersistfile;
begin
...
htmldocument := webbrowser1.document as ihtmldocument2;
persistfile := htmldocument as ipersistfile;
persistfile.save(stringtoolestr('test.htm'), true);

while htmldocument.readystate 'complete' do
application.processmessages;
...
end;

Автор: ron loewy

Обратите внимание: Вам понадобится импортировать библиотеку
mshtml и добавить mshtml_tlb как activex, в секцию uses.

Вопрос: Как получить post данные?

Ответ: Если данные передаются в формате 'animal=cat& color=brown' и т.д.,
то попробуйте использовать следующий код:

procedure tdbmodule.navigate(sturl, stpostdata: string; var wbwebbrowser: twebbrowser);
var
vwebaddr, vpostdata, vflags, vframe, vheaders: olevariant;
iloop: integer;
begin
{are we posting data to this url?}
if length(stpostdata)> 0 then
begin
{require this header information if there is stpostdata.}
vheaders:= 'content-type: application/x-www-form-urlencoded'+ #10#13#0;
{set the variant type for the vpostdata.}
vpostdata:= vararraycreate([0, length(stpostdata)], varbyte);
for iloop := 0 to length(stpostdata)- 1 do // iterate
begin
vpostdata[iloop]:= ord(stpostdata[iloop+ 1]);
end; // for
{final terminating character.}
vpostdata[length(stpostdata)]:= 0;
{set the type of variant, cast}
tvardata(vpostdata).vtype:= vararray;
end;
{and the other stuff.}
vwebaddr:= sturl;
{make the call rex.}
wbwebbrowser.navigate2(vwebaddr, vflags, vframe, vpostdata, vheaders);
end; {end of navigate procedure.}

Автор: craig foley

Ответ: А это другой способ:

procedure tform1.submitpostform;
var
strpostdata: string;
data: pointer;
url, flags, targetframename, postdata, headers: olevariant;
begin
{
< !-- submit this html form: -->
< form method=" post" action=" http://127.0.0.1/cgi-bin/register.pl" >
< input type=" text" name=" firstname" value=" hans" >
< input type=" text" name=" lastname" value=" gulo" >
< input type=" text" name=" note" value=" thats it" >
< input type=" submit" >
< /form>
}
strpostdata := 'firstname=hans& lastname=gulo& note=thats+it';
postdata := vararraycreate([0, length(strpostdata) - 1], varbyte);
data := vararraylock(postdata);
try
move(strpostdata[1], data^, length(strpostdata));
finally
vararrayunlock(postdata);
end;
url := 'http://127.0.0.1/cgi-bin/register.pl';
flags := emptyparam;
targetframename := emptyparam;
headers := emptyparam; // twebbrowse
// эти заголовки соответствующими значениями
webbrowser1.navigate2(url, flags, targetframename, postdata, headers);
end;

Автор: hans gulo.

Вопрос: Как сделать webbrowser плоским вместо 3d?

Ответ: Следующий пример устанавливает borderstyle:

procedure tform1.wbdocumentcomplete(sender: tobject;
const pdisp: idispatch; var url: olevariant);
var
doc : ihtmldocument2;
element : ihtmlelement;
begin
doc := ihtmldocument2(twebbrowser(sender).document);
if doc = nil then
exit;
element := doc.body;
if element = nil then
exit;
case make_flat of
true : element.style.borderstyle := 'none';
false : element.style.borderstyle := '';
end;
end;

Автор: donovan j. edye

Вопрос: Как сохранить веб страничку в bitmap?

Ответ: Вот пример:

procedure tform1.button1click(sender: tobject);
var
viewobject: iviewobject;
sourcedrawrect: trect;
begin
if embeddedwb1.document nil then
try
embeddedwb1.document.queryinterface(iviewobject, viewobject);
if viewobject nil then
try
sourcedrawrect := rect(0, 0, image1.width, image1.height);
viewobject.draw(dvaspect_content, 1, nil, nil, self.handle,
image1.canvas.handle, @sourcedrawrect, nil, nil, 0);
finally
viewobject._release;
end;
except
end;
end;

Автор: john

Ответ: А следующий пример позволяет сохранить её как jpeg:

procedure generatejpegfrombrowser(browser: iwebbrowser2; jpegfqfilename: string;
srcheight: integer; srcwidth: integer; tarheight: integer; tarwidth: integer);
var
sourcedrawrect : trect;
targetdrawrect: trect;
sourcebitmap: tbitmap;
targetbitmap: tbitmap;
jpeg: tjpegimage;
viewobject: iviewobject;
begin
sourcebitmap := tbitmap.create ;
targetbitmap := tbitmap.create ;
jpeg := tjpegimage.create ;
try
try
sourcedrawrect := rect(0,0, srcwidth , srcheight );
sourcebitmap.width := srcwidth ;
sourcebitmap.height := srcheight ;

viewobject := browser as iviewobject;

if viewobject = nil then
exit;

olecheck(viewobject.draw(dvaspect_content, 1, nil, nil, self.handle,
sourcebitmap.canvas.handle, @sourcedrawrect, nil, nil, 0));

// Изменяем размер исходного битмапа для конечного битмапа
targetdrawrect := rect(0,0, tarwidth, tarheight);
targetbitmap.height := tarheight;
targetbitmap.width := tarwidth;
targetbitmap.canvas.stretchdraw(targetdrawrect, sourcebitmap);

// Создаём jpeg из bitmap и сохраняем его
jpeg.assign(targetbitmap) ;
makefilewriteable(jpegfqfilename);
jpeg.savetofile (jpegfqfilename);
finally
jpeg.free;
sourcebitmap.free ;
targetbitmap.free;
end;
except
// Обработка ошибок
end;
end;

Автор: donall burns

Вопрос: Что такое dom?

Ответ: document object model это платформенно независимый интерфейс,
позволяющий программам и скриптам динамически обновлять и
изменять содержимое, структуру и стиль документов.

Вопрос: Где можно почитать документацию по dom?

Ответ: Обзор материалов по dom на w3c site , а так же faq.
Не забудьте заглянуть на document object на сайте microsoft.

Вопрос: Как работать со всеми фреймами, отображёнными в данный момент в webbrowser?

Ответ: Данный пример показывает как определить в каких фреймах разрешена команда 'copy':

procedure tform1.button1click(sender: tobject);
var
i: integer;
begin
for i := 0 to (webbrowser1.oleobject.document.frames.length - 1) do
if webbrowser1.oleobject.document.frames.item(i).document.querycommandenabled('copy') then
showmessage('copy command is enabled for frame no.' + inttostr(i));
end;

Автор: peter friese

Вопрос: Как работать со всеми ячейками ?

Ответ: Пример показывает как добавить содержимое каждой ячейки в tmemo:

procedure tform1.button1click(sender: tobject);
var
i, j: integer;
ovtable: olevariant;
begin
// Я использовал первую таблицу на странице в качестве примера
ovtable := webbrowser1.oleobject.document.all.tags('table').item(0);

for i := 0 to (ovtable.rows.length - 1) do
begin
for j := 0 to (ovtable.rows.item(i).cells.length - 1) do
begin
memo1.lines.add(ovtable.rows.item(i).cells.item(j).innertext;
end;
end;

end;

Вопрос: paste работает отлично, но cut и copy отказываются работать. В чём проблема?

Ответ: Вам нужно добавить следующие строки в начало unit:

initialization
oleinitialize(nil);

finalization
oleuninitialize;

Вопрос: Кобинации клавиш ctrl-c, ctrl-o, и т.д. не срабатывают. В чём проблема?

Ответ: Это не ошибка. Информацию по данному вопросу можно найти на сайте
microsoft knowledgebase статья q168777.
Приведённый ниже код, устраняет данную проблему:

...

var
form1: tform1;
foleinplaceactiveobject: ioleinplaceactiveobject;
savemessagehandler: tmessageevent;

...

implementation

...

procedure tform1.formactivate(sender: tobject);
begin
savemessagehandler := application.onmessage;
application.onmessage := mymessagehandler;
end;

procedure tform1.formdeactivate(sender: tobject);
begin
application.onmessage := savemessagehandler;
end;

procedure tform1.formclose(sender: tobject; var action: tcloseaction);
begin
application.onmessage := savemessagehandler;
foleinplaceactiveobject := nil;
end;

procedure tform1.mymessagehandler(var msg: tmsg; var handled: boolean);
var
ioipao: ioleinplaceactiveobject;
dispatch: idispatch;
begin
{ exit if we don't get back a webbrowser object }
if webbrowser = nil then
begin
handled := false;
exit;
end;

handled:=(isdialogmessage(webbrowser.handle, msg) = true);

if (handled) and (not webbrowser.busy) then
begin
if foleinplaceactiveobject = nil then
begin
dispatch := webbrowser.application;
if dispatch nil then
begin
dispatch.queryinterface(ioleinplaceactiveobject, ioipao);
if ioipao nil then
foleinplaceactiveobject := ioipao;
end;
end;

if foleinplaceactiveobject nil then
if ((msg.message = wm_keydown) or (msg.message = wm_keyup)) and
((msg.wparam = vk_back) or (msg.wparam = vk_left) or (msg.wparam = vk_right)) then
//nothing - do not pass on backspace, left or right arrows
else
foleinplaceactiveobject.translateaccelerator(msg);
end;
end; Категория: Языки программирования | Просмотров: 287