OnClick event i TWebBrowser

du kan sætte webbrowserens PopUpMenu property til at pege på en popmenu du lægger på formen

når jeg gør følgende:
WB.PopupMenu := PopUpMenu1;

sker der ikke noget \"nyt\" når jeg højreklikker på et link på siden i web browseren (eller andre steder på siden) ??

hvordan kaldes popupmenuens popup procedure ?

Du skal ikke sætte den runtime, men i object inspectoren før du compilerer

Nico22>> Nu blev der vist specifikt spurgt om hvordan man gør på runtime .. men du har da ret med mindere du ønsker at bruge to eller flere forskellige procedure til popupmenuens popup procedure kan man lige så godt sætte den på Designtime ...

Men under alleomstendighedder er det ingen skade til at vide hvor events kommer fra, og hvordan man sætter en event procedure på runtime ...

tknudsen >> Jeg har strikket et lille eksempel sammen til dig :

Du har din form med din TWebBrowser komponent og en popup menu ..

under private erklære du dig en procedure som følger :

  private
    Procedure OnPopupMenu1Popup(Sender : TObject);
  public
    { Public declarations }
  end;


...

I din forms on create event skriver du følgende :

procedure TForm1.FormCreate(Sender: TObject);
begin
  WebBrowser1.PopupMenu := PopupMenu1;
  PopupMenu1.OnPopup := OnPopupMenu1Popup;
end;

Så mangler vi bare at implemtere den procedure vi erklærede under privare :

procedure TForm1.OnPopupMenu1Popup(Sender: TObject);
begin
  Caption := \'Hest\';
end;

Og vupti nu er du i luften.

Jens B

hmmm - det virker fint hvis ikke der er loadet et dokument i browseren. Men hvis der er får jeg standart menuen !?

Og så var det jeg tænkte at jeg evt kunne override den message (WM_RBUTTONCLICK), som fremkalder menuen...

Jens b>>men det virker ikke hved enten man sætter den run - eller designtime

nico >> jow - jeg kan få begge metoder til at virke (vriiinsk)

nico22  >> Jo det gør det ... Og hvis det ikke er meningen at man vil skifte procedure under vejs så kan man lige så godt sætte den på designtime ..

tknudsen >> Den anden der med atsætten en ny pop up menu når der er loaded et dokument ind i dit WebKomponet kan jeg ikke lige knække ...


Jeg har prøver at SubcCasse WebBrowser komponenter, men uden helt. Jeg prøvede det følgende :

type
  pWNDPROC = function (hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall;
var
  oldWebBrowserWndProc : pWNDPROC;

function WebBrowserWndProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall;
begin
  if (uMsg >= WM_MOUSEFIRST) and (uMsg <= WM_MOUSELAST) then
  begin
    Result := 0;
    form1.Caption := InttoStr(uMsg);
  end
  else
    Result := oldWebBrowserWndProc(hwnd, uMsg, wParam, lParam);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  PopupMenu1.OnPopup := OnPopupMenu1Popup;
  oldWebBrowserWndProc := pWNDPROC(SetWindowLong(WebBrowser1.handle, GWL_WNDPROC, Integer(@WebBrowserWndProc)));
  WebBrowser1.Navigate(\'Http://Borrisholt.com\');
end;

procedure TForm1.OnPopupMenu1Popup(Sender: TObject);
begin
  Caption := \'Hest\';
end;

Men jeg får ikke alle events udleveres, hvilket må betyde det ikke er der rigtige windue jeg har lavet en SubClass på ....

Det eneste jeg har funder ud af er at

hvis du laver et CommandStateChange event alla det her :

procedure TForm1.WebBrowser1CommandStateChange(Sender: TObject;  Command: Integer; Enable: WordBool);
begin
  Caption := TimeToStr(Now);
end;


Kommer der godt nok noget i mit event men Command er enten -1 eller 1 og så er jeg lige vidt ...

Måske der sidder nogle kloge mennesker der ved der .... Spørg pellelil ham plejer jeg at spørge når der er noget jeg ikke lige ved ....

Jens B

opfordringen er hermed givet videre...evt med ekstra point

Jeg har kigget lidt på det og jeg kan ved at lave en under class af TwebBrowser og override WndProc fange WM_LBUTTONDOWN eller WM_LBUTTONUP og så kan du jo bare skrive et event til hver. HUSK AT LIGE \"INHERITED WNDPROC(MESSAGE);\" ELLERS VIRKER TWEBbROWSER IKKE MERE!
Jeg håber at det kan hjælpe lidt. bar spørg løs hvis der er noget du ikke forstår.
Hilsen Klaus

Jeg har skræver komponentet til dig. put koden ind i en nu unit kald uniten det samme som det filnavn du gemmer den i. og tryk component install osv.


unit WebBrowserOnClik;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shdocvw;

type
  TMitMouseEvent = procedure (Sender : TObject; X,Y : integer) of object;
  TWebBrowserOnClik = class(TWebBrowser)
  private
    FOnMouseDown : TMitMouseEvent;
    FOnMouseUp : TMitMouseEvent;
  protected
    procedure WndProc(var Message: TMessage); override;
  published
    property OnMouseDown : TMitMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseUp : TMitMouseEvent read FOnMouseUp write FOnMouseUp;
  end;

procedure Register;

implementation

procedure TWebBrowserOnClik.WndProc(var Message: TMessage);
begin
  inherited WndProc(Message);
  if message.Msg = WM_LBUTTONDOWN then
    if Assigned(OnMouseDown) then OnMouseDown(self,Message.LParamLo,Message.LParamHi);
  if message.Msg = WM_LBUTTONUP then
    if Assigned(OnMouseUp) then OnMouseUp(self,Message.LParamLo,Message.LParamHi);
end;

procedure Register;
begin
  RegisterComponents(\'Samples\', [TWebBrowserOnClik]);
end;

end.

Hvis der er noget du vil spørge om er du jo stadig velkommen til at spørge løs
Hilsen Klaus Mark.

loke-liscom>> Det er meget fint principielt .. altså ... Det du laver er det sammen som jeg gør blot bruger jeg ikke arv .....

Det jeg gør er at jeg siger jev vil have alle messages først .. Så behandler jeg dem og så giver jeg den etv videre .. Det samme ligger du op til. Det virker meget fint indtil du loader en hjemme side ind i den ....


Jens B

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, SHDocVw_TLB, MSHTML_TLB, Menus;

type
  THTMLNotifyEvent =
    procedure(EventObject: IHTMLEventObj; EventType: string) of object;

  THTMLClickEvent = class(TInterfacedObject, IDispatch)
  private
    FDoc: IHTMLDocument2;
    FOnClick: THTMLNotifyEvent;
    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, ExceptInfo, ArgErr: Pointer): HResult; stdcall;
    procedure DoClick;
  public
    property Doc: IHTMLDocument2 read FDoc write FDoc;
    property OnClick: THTMLNotifyEvent read FOnClick write FOnClick;
  end;

  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    PopupMenu1: TPopupMenu;
    Item11: TMenuItem;
    Item21: TMenuItem;
    Item31: TMenuItem;
    procedure WebBrowser1NavigateComplete2(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure FormCreate(Sender: TObject);
  private
    FEvent: THTMLClickEvent;
    FDoc: IHTMLDocument2;
    procedure WebDocClick(EventObject: IHTMLEventObj; EventType: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  ComObj;

{$R *.DFM}

{ THTMLClickEvent }

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

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

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

function THTMLClickEvent.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExceptInfo, ArgErr: Pointer): HResult; stdcall;
begin
  DoClick;
  Result := S_OK;
end;

procedure THTMLClickEvent.DoClick;
var
  EventObj: IHTMLEventObj;
  EventType: string;
begin
  if Assigned(FOnClick) then
  begin
    EventObj := nil;
    EventType := \'\';

    if Assigned(FDoc) and Assigned(FDoc.parentWindow) then
    begin
      EventObj := FDoc.parentWindow.event;
      if Assigned(EventObj) then
        EventType := EventObj.type_;
    end;

    FOnClick(EventObj, EventType);
  end;
end;

procedure TForm1.WebDocClick(EventObject: IHTMLEventObj; EventType: string);
var
  ScrPoint: TPoint;
begin
  PopupMenu1.Items[0].Caption := FDoc.nameProp;
  ScrPoint := ClientToScreen(Point(EventObject.x, EventObject.y));
  PopupMenu1.Popup(ScrPoint.x, ScrPoint.y);
end;

procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  FDoc := WebBrowser1.Document as IHTMLDocument2;
  FEvent.Doc := FDoc;
  FEvent.OnClick := WebDocClick;

  FDoc.onclick := FEvent as IDispatch;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  V1, V2, V3, V4: OleVariant;
begin
  FEvent := THTMLClickEvent.Create;
  WebBrowser1.Navigate(\'URL\', V1, V2, V3, V4);
end;

end.

mange tak for de fine svar...