-
есть страница, http://moj.com на этой странице несколько ссылок, некоторые из них вида http://moj.com/thread.html, другие же вида http://drugoj.com/для работы используется компонент TWEbbrowserкак сделать чтобы по клику на ссылке те, которые http://moj.com открывались в этом-же окне, а все другие чтобы в новом окне? как сделать проверку строки - я знаю,: if pos('http://moj.com/', s) > 0 then
else
-
Открываем новый экземпляр формы с TWEbbrowser-ом на борту.
-
> Открываем новый экземпляр формы с TWEbbrowser-ом на борту.
в смысле это как, подробнее можно? и в каком событии это делать?
-
а открыть в браузере который в системе по дефолту стоит никак нелзя?
-
> а открыть в браузере который в системе по дефолту стоит > никак нелзя?
можно
-
> можно
а как именно? сохранять урл на винт и запускать через shellexecute? на какое событие вешать?
-
ауу! что дальше общих фраз дело не пойдет? ну, как всегда...
-
> а как именно?
ShellExecute.
> сохранять урл на винт и запускать через shellexecute?
Зачем сохранять? Как параметр передавать.
-
так, хочу код :) дело в том, что я пробовал через shellexcute, не работает и еще важно, на какое событие браузера это дело повесить?
-
> хочу код
"Иванов на остановке, в ожиданьи кружки пива, в предкушеньи колесницы .." (С) БГ
Какой тебе еще код ?
Создавай новый экз-р TWEbbrowser и вызывай его метод Navigate
-
итак,резюме: открыть ссылку в браузере по дефолту через shellexecute не выйдет, разве что сохранять ее как файл *.url, но это к "мастерству" никакого отношения не имеет, а также - изврат. создавать новый экземпляр формы с браузером - меня не устраивает такое решение. к сожалению в который раз убедился, что "мастера" когда доходит до относительно сложных вопросов помочь ничем, кроме как напыщено заявлять "можно", "нельзя" не могут. печально.
-
> открыть ссылку в браузере по дефолту через shellexecute > не выйдет, разве что сохранять ее как файл *.url, но это > к "мастерству" никакого отношения не имеет, а также - изврат. >
Все выйдет еще как. Ты не пробовал в командной строке набирать:
C:\Program Files\Internet Explorer>iexplore.exe www.google.ru ???
Попробуй, удивишься.
-
> ivanov
Между прочим, при клике в TWebBrowser по ссылке, в теге которой указано "Открывать в новом окне" все прекрасно открывается в новом окне браузера. Если же ты хочешь ВСЕ ССЫЛКИ открывать в новом окне, то, очевидно, ShellExecute тебе в помощь.
> ivanov (21.05.08 17:48) [8] > > так, хочу код :) > дело в том, что я пробовал через shellexcute, не работает
Может покажешь как ты пробовал? Или ты и не пробовал вовсе?
> и еще важно, на какое событие браузера это дело повесить?
OnBeforeNavigate2.
-
procedure tform1.Button2Click(Sender: TObject);
var flags: OleVariant;
begin
flags := 0;
webbrowser1.Navigate('http://mail.ru', flags);
end;
procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
var s, n: string;
p: pchar;
begin
s := 'mail.ru';
n := url;
p := pchar(n);
cancel := false;
if (pos(s, url) <= 0) then begin
shellexecute(handle, 'open', p, ' target=_blank', nil, sw_shownormal);
cancel := true;
end;
end;
вот пожалуста. куча рекламных окон.
-
> > вот пожалуста. > куча рекламных окон. >
Что написал, то и получил, чему ж тут удивляться)
-
> Что написал, то и получил, чему ж тут удивляться)
??? что конкретнo здесь не правильно?
-
> что конкретнo здесь не правильно?
Конкретно надо отделять мух от котлет в OnBeforeNavigate2. Это событие возникает чаще, чем ты думаешь, особенно на навороченных страницах с баннерами во фреймах и.т.д.
-
так вы же сами написали в пост #12. каким образом тогда отделять мух от котлет, если неизвестно какие адреса реклама, а какие не реклама? получается это событие не подходит...
-
> что конкретнo здесь не правильно?
Каждая вызванная тобой ShellExecute стартует отдельный процесс браузера. Каждый стартованный процесс браузера создает как минимум одно окно.
> каким образом тогда отделять мух от котлет, если неизвестно > какие адреса реклама, а какие не реклама?
Ты предлагаешь определять это нам ?
Или ты полагаешь, что на свете существует супер-пупер-функция типа
function IsReklama(URL: String): Boolean;
которая сделает это сама ?
-
> ivanov
И вообще - если вся эта твоя хитромудрая затея сводится к необходимости блокировать запросы к нежелательным ресурсам, то реализуется все то гораздо проще: браузеру указывается прокси-сервер с требуемой функциональностью, который настраивается требуемым образом.
-
я вам ничего не предлагаю. я надеюсь, может DVM все-таки подскажет, на какое событие вешать, так как уже определили, что beforeNavigate2 не подходит.
-
> каким образом тогда отделять мух от котлет, если неизвестно > какие адреса реклама, а какие не реклама?
Дело не в рекламе. Дело в том, что ты пытаешься изменить правильное поведение браузера на заведомо неправильное. Браузер следут тому, что указано в параметрах ссылки - в новом окне, значит в новом, в текущем, значит в текущем. Ты же делаешь так, что при любом переходе по ссылке (а обновление баннера во фрейме с помощью джаваскрипта это тоже переход) ты всегда пытаешься создать новое окно. Вот и получается ерунда.
> получается это событие не подходит...
подходит оно, подходит.
-
> так как уже определили, что beforeNavigate2 не подходит
Где и кто это определил, кроме тебя самого в [20] ?
-
ладно, как тогда обработать для моей задачи щелчок по ссылке в браузере если не заморачиватся с событием beforeNavigate2?
-
> ivanov (22.05.08 14:37) [23]
Щелчок понятие растяжимое. Пример: при клике мышкой по некоторой картинке, которая не является ссылкой, браузер, благодаря скрипту на JavaScript или ActiveX или Flash или Java или .... уходит по некой ссылке. Или сам по себе, без клика по той же причине.
beforeNavigate2 возникнет, а вот ссылки и не было никакой.
Это гиблый подход.
-
> а вот ссылки и не было никакой.
точнее клика по ссылке <a href>...</a>
-
шелчок по гиперссылке (напр. <a href="www.ssilka.com">ssilka</a>) как обработать?
-
> шелчок по гиперссылке
Никак. Можно лишь понять что браузер собрался в путь по какой-то гиперссылке и разрешить/запретить ему это или поменять что-то во флагах перед навигацией.
Чудак-человек, пойми, что кликать можно не только по ссылкам. А вот при переходе всегда ссылка будет.
-
-
> а может можно через метод onclick объектной модели документа?
Так это клик вообще, а не по ссылке. К тому же я уже говорил, что браузер мождет перейти по ссылке и без кликов вообще.
-
значит задача не решаема. жаль.
-
> ivanov (23.05.08 11:14) [30] > значит задача не решаема.
А зачем это все нужно в конечном итоге? Ты бы рассказал - может другое решение есть.
-
вкратце: есть один форум. у него неизменяемый дизайн (скажем красный). это с течением времени сильно напрягло глаза и мозг. решил сделать специально под него клиент (дизайн - вовсе не единственная причина написания программы) в котором могу подключить свой CSS. идея простая, на винте лежит файл CSS, в ктором прописаны те цвета, кот я хочу. программа при загрузке страницы подключает мой css вместо ихнего, и показывает в webbrowser форум с красивыми цветами. :) все довольны, и форум и я. но есть одна проблема, люди на форуме в тредах дают ссылки на другие сайты, и когда переходишь по такой ссылке часто (но не всегда) лезут ошибки. эти ошибки объясняются просто - попытка использования файла стилей, который к данной странице не подходит. этим и обусловлена задача отделения одних ссылок от других, с тем, чтобы "чужие" ссылки открывались в новом окне дефолтного браузера, и мой файл стилеj к нему отношения не имел. как говоритса "с глаз долой - из сердца вон"
а можно чтоб здесь не размазывать кашу вам на мыло написать. к тому-ж не хочется адрес в паблик светить.
-
> этим и обусловлена задача отделения одних ссылок от других, > с тем, чтобы "чужие" ссылки открывались в новом окне дефолтного > браузера, и мой файл стилеj к нему отношения не имел.
Дык не подключать свой файл стилей к тем страницам которые не содержат адреса форума. Т.е. перед навигацией на страницу ты должен смотреть, если в URL адрес форума, если есть - подключай свой файл стилей, если нет - не подключай.
> а можно чтоб здесь не размазывать кашу вам на мыло написать. >
Обсуждение лучше все же здесь, это может быть кому то еще интересно окажется.
-
> если есть - подключай свой файл стилей, если нет - не подключай.
делал. проблема в том, что при проверке старый цвет лезет.
-
> проблема в том, что при проверке старый цвет лезет.
Что значит лезет? Момент проверки он в BeforeNavigate как там может что-то лезть? Давай код, в котором лезет, на примере, скажем, этого сайта.
Вообще, если все же открывать в новые окна, наверное получится так:
1) В BeforeNavigate смотрим по флагам в новом или не в новом окне собралась открываться страница. 2) Если в новом - нехай открывается как есть - скорее всего это внешняя ссылка. 3) Если не в новом, то смотрим адрес форума в URL содержится или нет. Если содержится, то меняем таблицу стилей, если не содержится - не меняем.
-
вот когда по ссылкам переходить, видно, что старый дизайн на некоторое время появляется.
procedure tform1.updateStyle;
var s: string;
begin
s := 'file:///c:/my.css';
if webbrowser1.Document <> nil then
webbrowser1.OleObject.Document.styleSheets.Item(0).href := s;
end;
procedure tform1.updateStyle2(fs: string);
var s: string;
begin
s := 'file:///c:/my.css';
if (pos('www.delphimaster.ru', s) > 0) then begin
if (webbrowser1.Document <> nil) then
webbrowser1.OleObject.Document.styleSheets.Item(0).href := s;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
webbrowser1.Navigate('http://www.delphimaster.ru/cgi-bin/http://pda.delphimaster.net/?n=4');
end;
procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
begin
updatestyle2(url);
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
begin
updatestyle;
end;
-
в посте 36 опечатка. в функции updatestyle2 вместо
(pos('www.delphimaster.ru', s) > 0)
нужно
(pos('www.delphimaster.ru', fs) > 0)
-
> ivanov (23.05.08 18:53) [37]
По-моему вот так все нормально работает. По форуму фон красный, по остальным ссылкам стандартный:
procedure tform1.updateStyle2(fs: string);
var
s: string;
begin
s := 'file:///c:/my.css';
if (pos('www.delphimaster.ru/cgi-bin/http://pda.delphimaster.net/', fs) > 0) then
begin
if (webbrowser1.Document <> nil) then
webbrowser1.OleObject.Document.styleSheets.Item(0).href := s;
end;
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
updatestyle2(URL);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
webbrowser1.Navigate('http://www.delphimaster.ru/cgi-bin/http://pda.delphimaster.net/?n=4');
end;
В my.css все то же, что у форума delphimaster, только исправил: body, td, ol, ul, li, p { font: 10pt Verdana, Arial, Helvetica, Tahoma, sans-serif; background-color: red; }
-
можно без файла стилей проверить, он не нужен. так вот, событие ondocumentcomplete наступает когда документ загрузился, и на него замену стиля вешать конечно нужно, но уже как-бы поздно, т.к. пока документ грузится, мелькает старый дизайн. если-бы эта прога была только для меня, тут этой ветки бы не было, я бы и с мельканием смирился. идеальным вариантом является событие onbeforenavigate2, но тут проблема что под чужие страницы свой стиль подсовывать не кошерно выходит. вообщем, как я понял мой вопрос решению не подлежит, не буду толочь воду в ступе. спасибо за участие.
-
> ivanov (23.05.08 22:39) [39]
Вот еще вариант, у меня не мелькает. Точнее мелькает несколько, но уже по другой причине, и это мелькает не старое оформление.
unit Main;
interface
uses
Forms, Menus, OleCtrls, SHDocVw, Classes, Controls, StdCtrls, XPMan,
UContainer, ExtCtrls, ShellAPI;
type
TMainForm = class(TForm)
WebBrowser1: TWebBrowser;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
fWBContainer: TWBContainer;
end;
var
MainForm: TMainForm;
implementation
uses
SysUtils, Windows, Graphics, Dialogs;
procedure TMainForm.FormCreate(Sender: TObject);
var
FmtCSS: string; begin
FmtCSS := 'body #13#10
+ ' background-color: red;'#13#10
+ '}';
fWBContainer := TWBContainer.Create(WebBrowser1);
fWBContainer.UseCustomCtxMenu := True;
fWBContainer.Show3DBorder := False;
fWBContainer.ShowScrollBars := False;
fWBContainer.AllowTextSelection := False;
fWBContainer.CSS := FmtCSS;
fWBContainer.HostedBrowser.Navigate('http://www.delphimaster.ru/cgi-bin/http://pda.delphimaster.net/?n=4');
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
fWBContainer.Free;
end;
end.
-
unit UContainer;
interface
uses
Windows, ActiveX, ShDocVw,
UNulContainer, IntfDocHostUIHandler;
type
TWBContainer = class(TNulWBContainer, IDocHostUIHandler, IOleClientSite)
private
fUseCustomCtxMenu: Boolean;
fShowScrollBars: Boolean;
fShow3DBorder: Boolean;
fAllowTextSelection: Boolean;
fCSS: string;
protected
function ShowContextMenu(
const dwID: DWORD;
const ppt: PPOINT;
const pcmdtReserved: IUnknown;
const pdispReserved: IDispatch): HResult; stdcall;
function GetHostInfo(
var pInfo: TDocHostUIInfo): HResult; stdcall;
public
constructor Create(const HostedBrowser: TWebBrowser);
property UseCustomCtxMenu: Boolean
read fUseCustomCtxMenu write fUseCustomCtxMenu default False;
property Show3DBorder: Boolean
read fShow3DBorder write fShow3DBorder default True;
property ShowScrollBars: Boolean
read fShowScrollBars write fShowScrollBars default True;
property AllowTextSelection: Boolean
read fAllowTextSelection write fAllowTextSelection default True;
property CSS: string
read fCSS write fCSS;
end;
implementation
uses
SysUtils, Themes;
function TaskAllocWideString(const S: string): PWChar;
var
StrLen: Integer; begin
StrLen := Length(S) + 1;
Result := CoTaskMemAlloc(StrLen * SizeOf(WideChar));
if Assigned(Result) then
StringToWideChar(S, Result, StrLen);
end;
constructor TWBContainer.Create(const HostedBrowser: TWebBrowser);
begin
inherited;
fUseCustomCtxMenu := False;
fShowScrollBars := True;
fShow3DBorder := True;
fAllowTextSelection := True;
fCSS := '';
end;
function TWBContainer.GetHostInfo(
var pInfo: TDocHostUIInfo): HResult;
begin
try
ZeroMemory(@pInfo, SizeOf(TDocHostUIInfo));
pInfo.cbSize := SizeOf(TDocHostUIInfo);
if not fShowScrollBars then
pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_SCROLL_NO;
if not fShow3DBorder then
pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_NO3DBORDER;
if not fAllowTextSelection then
pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_DIALOG;
if ThemeServices.ThemesEnabled then
pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_THEME
else if ThemeServices.ThemesAvailable then
pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_NOTHEME;
pInfo.pchHostCss := TaskAllocWideString(fCSS);
if not Assigned(pInfo.pchHostCss) then
raise Exception.Create('Task allocator can''t allocate CSS string');
Result := S_OK;
except
// Return E_FAIL on error
Result := E_FAIL;
end;
end;
function TWBContainer.ShowContextMenu(
const dwID: DWORD;
const ppt: PPOINT;
const pcmdtReserved: IInterface;
const pdispReserved: IDispatch): HResult;
begin
if fUseCustomCtxMenu then
begin
// tell IE we're handling the context menu
Result := S_OK;
if Assigned(HostedBrowser.PopupMenu) then
HostedBrowser.PopupMenu.Popup(ppt.X, ppt.Y);
end
else
Result := S_FALSE;
end;
end.
-
unit IntfDocHostUIHandler;
interface
uses
Windows, ActiveX;
const
DOCHOSTUIFLAG_DIALOG = $00000001;
DOCHOSTUIFLAG_DISABLE_HELP_MENU = $00000002;
DOCHOSTUIFLAG_NO3DBORDER = $00000004;
DOCHOSTUIFLAG_SCROLL_NO = $00000008;
DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE = $00000010;
DOCHOSTUIFLAG_OPENNEWWIN = $00000020;
DOCHOSTUIFLAG_DISABLE_OFFSCREEN = $00000040;
DOCHOSTUIFLAG_FLAT_SCROLLBAR = $00000080;
DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = $00000100;
DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY = $00000200;
DOCHOSTUIFLAG_OVERRIDEBEHAVIORFACTORY = $00000400;
DOCHOSTUIFLAG_CODEPAGELINKEDFONTS = $00000800;
DOCHOSTUIFLAG_URL_ENCODING_DISABLE_UTF8 = $00001000;
DOCHOSTUIFLAG_URL_ENCODING_ENABLE_UTF8 = $00002000;
DOCHOSTUIFLAG_ENABLE_FORMS_AUTOCOMPLETE = $00004000;
DOCHOSTUIFLAG_ENABLE_INPLACE_NAVIGATION = $00010000;
s window. For instance,
if this flag is set, you can click a link in HTML mail and navigate in the
mail instead of opening a new IE window}
DOCHOSTUIFLAG_IME_ENABLE_RECONVERSION = $00020000;
DOCHOSTUIFLAG_THEME = $00040000;
DOCHOSTUIFLAG_NOTHEME = $00080000;
DOCHOSTUIFLAG_NOPICS = $00100000;
DOCHOSTUIFLAG_NO3DOUTERBORDER = $00200000;
DOCHOSTUIFLAG_DISABLE_EDIT_NS_FIXUP = $1;
DOCHOSTUIFLAG_LOCAL_MACHINE_ACCESS_CHECK = $1;
DOCHOSTUIFLAG_DISABLE_UNTRUSTEDPROTOCOL = $1;
DOCHOSTUIDBLCLK_DEFAULT = 0;
DOCHOSTUIDBLCLK_SHOWPROPERTIES = 1;
DOCHOSTUIDBLCLK_SHOWCODE = 2;
s source}
DOCHOSTUITYPE_BROWSE = 0;
DOCHOSTUITYPE_AUTHOR = 1;
-
type
TDocHostUIInfo = record
cbSize: ULONG;
dwFlags: DWORD;
dwDoubleClick: DWORD;
pchHostCss: PWChar;
pchHostNS: PWChar;
;' delimited namespace list that allows declaration of
namespaces for custom tags on the page}
end;
PDocHostUIInfo = ^TDocHostUIInfo;
IDocHostUIHandler = interface(IUnknown)
['']
function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HResult;
stdcall;
function GetHostInfo(var pInfo: TDocHostUIInfo): HResult; stdcall;
s 3-D border can be disabled.
+ The browser's scroll bars can be disabled or change their appearance
can be changed.
+ Scripts can be disabled.
+ Handling of double-clicks can be modified.
@param pInfo [in, out] reference to a TDocHostUIInfo structure that
receives the host's UI capabilities.
@return S_OK if successful, or an error value otherwise or if we don't
make any changes to pInfo.
}
function ShowUI(const dwID: DWORD;
const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HResult; stdcall;
s AddRef method to save the interface
for later use. If the host calls the interface's AddRef method, the host
must also call the interface's Release method when the interface is no
longer required.
@param dwID [in] receives a DOCHOSTUITYPE_* value indicating the type of
user interface (UI).
@param pActiveObject [in] IOleInPlaceActiveObject interface reference
for the active object.
@param pCommandTarget [in] IOleCommandTarget interface for the object.
@pFrame [in] IOleInPlaceFrame interface for the object. Menus and
toolbars must use this parameter.
@param pDoc [in] an IOleInPlaceUIWindow interface for the object.
Toolbars must use this parameter.
@return S_OK if host displayed its own UI (MSHTML will not display its
UI); S_FALSE if host did not display its own UI (MSHTML will display
its UI) or DOCHOST_E_UNKNOWN if host did not recognize the UI
identifier. MSHTML will either try an alternative identifier for
compatibility with a previous version or display its own UI.
}
function HideUI: HResult; stdcall;
function UpdateUI: HResult; stdcall;
function EnableModeless(const fEnable: BOOL): HResult; stdcall;
function OnDocWindowActivate(const fActivate: BOOL): HResult; stdcall;
-
function OnFrameWindowActivate(const fActivate: BOOL): HResult; stdcall;
function ResizeBorder(const prcBorder: PRECT;
const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;
stdcall;
s window's border is about to
be changed.
@param prcBorder [in] Constant pointer to a RECT for the new outer
rectangle of the border.
@param pUIWindow [in] reference to an IOleInPlaceUIWindow interface for
the frame or document window whose border is to be changed.
@param fFrameWindow [in] flag True if the frame window is calling
IDocHostUIHandler.ResizeBorder, or FALSE otherwise.
@return S_OK on success or error value on failure.
}
function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
const nCmdID: DWORD): HResult; stdcall;
function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD ): HResult;
stdcall;
function GetDropTarget(const pDropTarget: IDropTarget;
out ppDropTarget: IDropTarget): HResult; stdcall;
t provide an alternative drop target
we must return a failure code such as E_NOTIMPL or E_FAIL.
@return S_OK if successful, or an error value otherwise.
}
function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;
function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
var ppchURLOut: POLESTR): HResult; stdcall;
function FilterDataObject(const pDO: IDataObject;
out ppDORet: IDataObject): HResult; stdcall;
end;
implementation
end.
-
unit UNulContainer;
interface
uses
Windows, ActiveX, SHDocVw,
IntfDocHostUIHandler;
type
TNulWBContainer = class(TObject,
IUnknown, IOleClientSite, IDocHostUIHandler)
private
fHostedBrowser: TWebBrowser;
procedure SetBrowserOleClientSite(const Site: IOleClientSite);
protected
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
function SaveObject: HResult; stdcall;
function GetMoniker(dwAssign: Longint;
dwWhichMoniker: Longint;
out mk: IMoniker): HResult; stdcall;
function GetContainer(
out container: IOleContainer): HResult; stdcall;
function ShowObject: HResult; stdcall;
function OnShowWindow(fShow: BOOL): HResult; stdcall;
function RequestNewObjectLayout: HResult; stdcall;
function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HResult;
stdcall;
function GetHostInfo(var pInfo: TDocHostUIInfo): HResult; stdcall;
function ShowUI(const dwID: DWORD;
const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HResult; stdcall;
function HideUI: HResult; stdcall;
function UpdateUI: HResult; stdcall;
function EnableModeless(const fEnable: BOOL): HResult; stdcall;
function OnDocWindowActivate(const fActivate: BOOL): HResult; stdcall;
function OnFrameWindowActivate(const fActivate: BOOL): HResult; stdcall;
function ResizeBorder(const prcBorder: PRECT;
const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;
stdcall;
function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
const nCmdID: DWORD): HResult; stdcall;
function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD ): HResult;
stdcall;
function GetDropTarget(const pDropTarget: IDropTarget;
out ppDropTarget: IDropTarget): HResult; stdcall;
function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;
function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
var ppchURLOut: POLESTR): HResult; stdcall;
function FilterDataObject(const pDO: IDataObject;
out ppDORet: IDataObject): HResult; stdcall;
public
constructor Create(const HostedBrowser: TWebBrowser);
destructor Destroy; override;
property HostedBrowser: TWebBrowser read fHostedBrowser;
end;
-
implementation
uses
SysUtils;
constructor TNulWBContainer.Create(const HostedBrowser: TWebBrowser);
begin
Assert(Assigned(HostedBrowser));
inherited Create;
fHostedBrowser := HostedBrowser;
SetBrowserOleClientSite(Self as IOleClientSite);
end;
destructor TNulWBContainer.Destroy;
begin
SetBrowserOleClientSite(nil);
inherited;
end;
function TNulWBContainer.EnableModeless(const fEnable: BOOL): HResult;
begin
Result := S_OK;
end;
function TNulWBContainer.FilterDataObject(const pDO: IDataObject;
out ppDORet: IDataObject): HResult;
begin
ppDORet := nil;
Result := S_FALSE;
end;
function TNulWBContainer.GetContainer(
out container: IOleContainer): HResult;
begin
container := nil;
Result := E_NOINTERFACE;
end;
function TNulWBContainer.GetDropTarget(const pDropTarget: IDropTarget;
out ppDropTarget: IDropTarget): HResult;
begin
ppDropTarget := nil;
Result := E_FAIL;
end;
function TNulWBContainer.GetExternal(out ppDispatch: IDispatch): HResult;
begin
ppDispatch := nil;
Result := E_FAIL;
end;
function TNulWBContainer.GetHostInfo(var pInfo: TDocHostUIInfo): HResult;
begin
Result := S_OK;
end;
function TNulWBContainer.GetMoniker(dwAssign, dwWhichMoniker: Integer;
out mk: IMoniker): HResult;
s client site}
begin
mk := nil;
Result := E_NOTIMPL;
end;
function TNulWBContainer.GetOptionKeyPath(var pchKey: POLESTR;
const dw: DWORD): HResult;
begin
Result := E_FAIL;
end;
function TNulWBContainer.HideUI: HResult;
begin
Result := S_OK;
end;
function TNulWBContainer.OnDocWindowActivate(
const fActivate: BOOL): HResult;
begin
Result := S_OK;
end;
function TNulWBContainer.OnFrameWindowActivate(
const fActivate: BOOL): HResult;
begin
Result := S_OK;
end;
function TNulWBContainer.OnShowWindow(fShow: BOOL): HResult;
s window
is about to become visible or invisible}
begin
Result := S_OK;
end;
function TNulWBContainer.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TNulWBContainer.RequestNewObjectLayout: HResult;
begin
t support requests for a new layout }
Result := E_NOTIMPL;
end;
function TNulWBContainer.ResizeBorder(const prcBorder: PRECT;
const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;
begin
Result := S_FALSE;
end;
function TNulWBContainer.SaveObject: HResult;
begin
Result := S_OK;
end;
procedure TNulWBContainer.SetBrowserOleClientSite(
const Site: IOleClientSite);
var
OleObj: IOleObject;
begin
Assert((Site = Self as IOleClientSite) or (Site = nil));
if not Supports(
fHostedBrowser.DefaultInterface, IOleObject, OleObj
) then
raise Exception.Create(
'Browser''s Default interface does not support IOleObject'
);
OleObj.SetClientSite(Site);
end;
function TNulWBContainer.ShowContextMenu(const dwID: DWORD;
const ppt: PPOINT; const pcmdtReserved: IInterface;
const pdispReserved: IDispatch): HResult;
begin
t display a menu and to
let browser display its own menu }
Result := S_FALSE
end;
function TNulWBContainer.ShowObject: HResult;
begin
Result := S_OK;
end;
function TNulWBContainer.ShowUI(const dwID: DWORD;
const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HResult;
begin
Result := S_OK;
end;
function TNulWBContainer.TranslateAccelerator(const lpMsg: PMSG;
const pguidCmdGroup: PGUID; const nCmdID: DWORD): HResult;
begin
Result := S_FALSE;
end;
function TNulWBContainer.TranslateUrl(const dwTranslate: DWORD;
const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HResult;
begin
Result := E_FAIL;
end;
function TNulWBContainer.UpdateUI: HResult;
begin
Result := S_OK;
end;
function TNulWBContainer._AddRef: Integer;
begin
Result := -1;
end;
function TNulWBContainer._Release: Integer;
begin
Result := -1;
end;
end.
-
спасибо, я попробую, но уже завтра. еще бы разобраться, что к чему..
в 40 реализация. 41 - UContainer 42,43 и 44 - IntfDocHostUIHandler (один юнит) 45 и 46 - UNulContainer (тоже один) правильно?
-
> правильно?
да
-
а должно исчезнуть мелькание после подключения этого всего? у меня ничего не произошло, как мелькало так и продолжает :(
-
> у меня ничего не произошло, как мелькало так и продолжает > :(
Это уже другое мельканье. Если зайти в какую-то ветку и переходить по циферкам скажем 1,2,3 - страницы ветки, то ничего не мелькает. Прсто красный цвет он слишком резкий и лично у меня все мелькание заключается лишь в том, что красный фон накрывают потом синие картинки и кажется, что все мелькает. Но старый фон не мелькает вообще.
-
Можешь проверить включив запись в видеофайл содержимого десктопа и потом посмотри замедленно - будет видно есть мелькание старого фона или нет. У меня нет.
-
Вообще этот способ с контейнером он довольно известный - позволяет поменять многое в стандартном поведении TWebBrowser.
-
> ivanov (23.05.08 11:14) [30] > значит задача не решаема.жаль.
попробуй сделать так: 1) создаем глобальную пер-ю IsWBClicked: Boolean; 2) TWebBrowser.OnClick - обрабатываем IsWBClicked := True; 3) в OnBeforeNavigate2 проверяем: If IsWBClicked then begin
end else begin
end;
IsWBClicked := False;
подругому имхо - никак! :)
-
ничего у меня не получаитса :(
> TWebBrowser.OnClick - обрабатываем
это где такое событие есть?
-
> это где такое событие есть?
создай свой наследник TWebBrowser и отлавливай событие - сделай свой OnClick
-
Удалено модератором
-
Удалено модератором
|