Нужно отследить нажатие СРЕДНЕЙ кнопки мыши по ссылке в webbrowser и на это событие открыть новое окно с переходом по этой ссылкой!

Напиши обработчик события.

WM_MBUTTONDBLCLK - ДВОЙНОЙ ЩЕЛЧОК СРЕДНЕЙ КНОПКОЙ МЫШИ В КЛИЕНТСКОЙ ЧАСТИ ОБЛАСТИ ОКНА
WM_MBUTTONDOWN - НАЖАТИЕ СРЕДНЕЙ КНОПКОЙ МЫШИ В КЛИЕНТСКОЙ ЧАСТИ ОБЛАСТИ ОКНА
WM_MBUTTONUP - ОТПУСКАНИЕ СРЕДНЕЙ КНОПКОЙ МЫШИ В КЛИЕНТСКОЙ ЧАСТИ ОБЛАСТИ ОКНА
WM_NCMBUTTONDBLCLK - ДВОЙНОЙ ЩЕЛЧОК СРЕДНЕЙ КНОПКОЙ МЫШИ ВНЕ КЛИЕНТСКОЙ ЧАСТИ ОБЛАСТИ ОКНА
WM_NCMBUTTONDOWN - НАЖАТИЕ СРЕДНЕЙ КНОПКОЙ МЫШИ ВНЕ КЛИЕНТСКОЙ ЧАСТИ ОБЛАСТИ ОКНА
WM_NCMBUTTONUP - ОТПУСКАНИЕ СРЕДНЕЙ КНОПКОЙ МЫШИ В КЛИЕНТСКОЙ ЧАСТИ ОБЛАСТИ ОКНА

Выбирай какое тебе нужно.

Albinos_x, а можно по подробнее, я начинающий!
....если не затруднит!

В общем я думаю надо сделать так:
При WM_MBUTTONDOWN (нажатие средней кнопки), определять изменился ли статусбар в нашем браузере, если изменился, то открывать новое окно с браузером и пихать туда текст изменившейся строки состояния, перед этим надо ее проверить на содержание 'http://'. Тут есть две проблемы.
1. Есть товарищи, которые на своих страницах вручную меняют статус бар
2. Как отловить сообщение посланное именно контролу TWebBrowser?
тут надо делать потомок от TWebBrowser и переопределять эту функцию, чтобы не вызывался "крестик" с прокруткой.
Или, хоть убейте не знаю, можно ли отловить сообщение формой, но посланное ее потомку? (если да, то напишите кто-то плиз код) тогда тут тоже проверяем не изменился ли статус бар в WebBrowser.

Проблема номер два. Ну не получается у меня вытянуть текст этой строки состояния, есть функция, преобразования WideStringToString, но вылетает run-time error, может я что-то не так делаю, с какими параметрами ее надо вызывать?

Код

function WideStringToString(const ws: WideString; codePage: Word): AnsiString; var  l: integer; begin  if ws = '' then    Result := ''  else  begin    l := WideCharToMultiByte(codePage,      WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,      @ws[1], - 1, nil, 0, nil, nil);    SetLength(Result, l - 1);    if l > 1 then      WideCharToMultiByte(codePage,        WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,        @ws[1], - 1, @Result[1], l - 1, nil, nil);  end; end; {

И еще:
Почему этот код работает, хотя не должен, ИМХО.

Код

var st:string; st2:widestring; begin st2:='test'; st:=st2; ShowMessage(st); end;

Так кстати тоже работает, это наверное в TWebBrowser какой-то WideString спецефический

Код

var st:string; st2:widestring; begin st2:='test'; st:=WideStringToString(st2,0); ShowMessage(st); end;

А еще, наверное, это можно сделать использовав Events TWebBrowser, но какие???


З.Ы. Профи, помогите, мне и самому интересно как это надо сделать по людски

Для поимки сообщения:
...
private
{ Private declarations }
procedure WMMouseSrButton(var ButtonMouse : WM_MBUTTONDOWN); message WM_MBUTTONDOWN;
....
implementation
...
procedure TForm1.WMMouseSrButton(var ButtonMouse : WM_MBUTTONDOWN);
begin
// здесь делаешь, то что тебе нужно
end;
...
Прости, дальше помочь не могу, с Браузером почти не работал и делфи под рукой нет, чтобы попробовать.

Albinos_x, выдаёт ошибку...мол WM_MBUTTONDOWN is not a type identifier...
Vex, если выдерать адрес ссылки из статус бара, то ни к чему хорошему это не приведёт...я уже через это прошёл! Несколько проблем ты осветил, но самую главную нет! Во время загрузги страницы статус бар отображает что-то типа "Открытие страницы http://.....", а кто из нас будет ждать полной загрузки, чтобы нажать на нужную нам ссылку? Да никто, а если выдирать ссылку из статус бара, то мы пойдём примяком на http://Открытие страницы http://...
Значит этот вариант нам не подходит!

Цитата

А еще, наверное, это можно сделать использовав Events TWebBrowser, но какие???

Есть такое событие в webbrowser как OnStatusTextChange:

Код

procedure TForm1.StatusText(Sender: TObject;  const Text: WideString); begin  status.SimpleText:=Text; // юзаем компонент типа TStatusBar                                           end;

Цитата

Для поимки сообщения: ... private { Private declarations } procedure WMMouseSrButton(var ButtonMouse : WM_MBUTTONDOWN); message WM_MBUTTONDOWN; .... implementation ... procedure TForm1.WMMouseSrButton(var ButtonMouse : WM_MBUTTONDOWN); begin // здесь делаешь, то что тебе нужно end;

Это будет работать только непосредственно на форме, при клике на браузере ничего не будет происходить.



x_byte, можно еще отлавливать изменение указателя мыши Но тут тоже есть проблема, часто на сайтах можно встретить выпадающие меню, какие-то аплеты, в общем не всегда это будет ссылка.

Чтобы отловить сообщение, подмени WinowProc:

Код

var OldWebProc : integer; function WebWndProc (wnd : HWND; uMsg : UINT; wP : WPARAM; lP : LPARAM) : LRESULT; stdcall; var  x, y : word; begin  if (uMsg = WM_PARENTNOTIFY) and (wP = WM_MBUTTONDOWN) then  begin    Result := 0;    x := word(lP);    y := lP shr 16;    // твои действия по открытию нового окна  end  else  begin    Result := CallWindowProc(Pointer(OldWebProc), wnd, uMsg, wP, lP);  end; end;

Там, где написано "// твои действия по открытию нового окна", делай то что написано . Для получения кликнутой ссылки я тебе уже код писал - координаты клика в переменных x и y...

Но чтобы всё это заработало, в OnCreate формы поставь такую строчку:

Код

procedure TForm1.FormCreate(Sender: TObject); begin  OldWebProc := SetWindowLong(WebBrowser1.Handle, GWL_WNDPROC, Integer(@WebWndProc)); end;

Это собственно и подменяет WindowProc...

PS: хоть мышь у меня и пятикнопочная, но на данный момент средней нет. Так что проверял для правой кнопки (вместо WM_MBUTTONDOWN было WM_RBUTTONDOWN)...

Это сообщение отредактировал(а) p0s0l - 9.7.2004, 15:38

p0s0l, спасибо




З.Ы. 2p0s0l: Я наверное пропустил очень большой кусок материала по Делфи, не подскажешь, статью, где можно очень подробно прочитать о работе с сообщениями.

Vex, моя библия - это MSDN - там же в подробности описаны все сообщения, их параметры и назначение...
К сожалению, книг не знаю (не читал ниодной), так что лучше обращайся сюда, задавай вопрос (в отдельной теме - правила, сам понимаешь...), и я (и не только я, а все мы) с радостью тебе поможем в освоении Delphi! Это я тебе обещаю!

p0s0l

Цитата

Код procedure TForm1.FormCreate(Sender: TObject); begin OldWebProc := SetWindowLong(WebBrowser1.Handle, GWL_WNDPROC, Integer(@WebWndProc)); end; Это собственно и подменяет WindowProc...

Вот в этом месте возникает проблема...у меня в программе при создании нового окна создаётся каждый раз новое окно webbrowser...что тогда писать в FormCreate...я использую массив wb[1..1000] типа TWebBrowser...и при создании нового окна содаётся компонент wb[pc]...где pc:=pc+1; после каждого создания!

Так... Тогда сложнее... У тебя, как я понял, изначально есть 1 браузер, а потом уже плодятся новые. Тогда на OnFormCreate поставь подмену WndProc этого первого браузера, а остальные будут так:

Тогда засунь эту строчку в место, где создаётся новый TWebBrowser. Будет типа:

Код

var  OldWebProc : array of integer;  BrowserWnd : array of HWND;  BrowserCount : integer; function WebWndProc (wnd : HWND; uMsg : UINT; wP : WPARAM; lP : LPARAM) : LRESULT; stdcall; var  x, y : word;  i : integer; begin  if (uMsg = WM_PARENTNOTIFY) and (wP = WM_RBUTTONDOWN) then  begin    Result := 0;    x := word(lP);    y := lP shr 16;    // твои действия по открытию окна    form1.Caption := inttostr(wnd);  end  else  begin    for i := 0 to BrowserCount-1 do      if BrowserWnd[i] = wnd then      begin        Result := CallWindowProc(Pointer(OldWebProc[i]), wnd, uMsg, wP, lP);        Break;      end;  end; end; procedure AddBrowser (wb : TWebBrowser); begin  Inc (BrowserCount);  SetLength (OldWebProc, BrowserCount);  SetLength (BrowserWnd, BrowserCount);  OldWebProc[BrowserCount-1] := SetWindowLong(wb.Handle, GWL_WNDPROC, Integer(@WebWndProc));  BrowserWnd[BrowserCount-1] := wb.Handle; end; procedure TForm1.FormCreate(Sender: TObject); begin  BrowserCount := 0;  AddBrowser (WebBrowser1);  WebBrowser1.Navigate('f:\posol\www.cats\_site\index.html'); end; procedure TForm1.WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); var  wb : TWebBrowser;  ts : TTabSheet; begin  ts := TTabSheet.Create(PageControl1);  ts.PageControl := PageControl1;  wb := TWebBrowser.Create(ts);  ppDisp := wb.DefaultInterface;  ts.InsertControl(wb);  wb.Align := alClient;  wb.Show;  wb.OnNewWindow2 := WebBrowser1NewWindow2;  AddBrowser(wb); end;

Т.е. как видишь, вместо одного OldWebProc, стало несколько, причем в оконной функции надо еще узнать адрес старой оконной функции...
Эх, если сразу вспомнить, что у тебя будет несколько окон, то написал бы другой вариант - написать свой класс с обработчиком сообщения:

Цитата

unit Unit1; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, OleCtrls, SHDocVw, ComCtrls; type   TMyWebBrowser = class (TWebBrowser)     procedure ParentNotify (var msg : TMessage); message WM_PARENTNOTIFY;   end; type   TForm1 = class(TForm)     PageControl1: TPageControl;     procedure FormCreate(Sender: TObject);     procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);   private   public     function AddBrowser : TMyWebBrowser;   end; var   Form1: TForm1; implementation {$R *.dfm} procedure TMyWebBrowser.ParentNotify; var x, y : word; begin   if (msg.WParam = WM_RBUTTONDOWN) then   begin     x := msg.LParamLo;     y := msg.LParamHi;     // твои действия по открытию окна     Form1.Caption := inttostr(Handle);   end end; function TForm1.AddBrowser; var ts : TTabSheet; begin   ts := TTabSheet.Create(PageControl1);   ts.PageControl := PageControl1;   Result := TMyWebBrowser.Create(ts);   ts.InsertControl(Result);   Result.Align := alClient;   Result.Show;   Result.OnNewWindow2 := WebBrowser1NewWindow2; end; procedure TForm1.FormCreate(Sender: TObject); begin   AddBrowser.Navigate('c:\abc\index.html'); end; procedure TForm1.WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); begin   ppDisp := AddBrowser.DefaultInterface; end; end.

В данном примере перехватывается правая кнопка мыши, при открытии нового окна в PageControl1 создаётся новая страница со своим браузером...
Т.е. создавай не TWebBrowser, а TMyWebBrowser...

Это сообщение отредактировал(а) p0s0l - 10.7.2004, 12:13