Текущий архив: 2007.04.29;
Скачать: CL | DM;

Вниз

Как использовать свое Popupmenu в WebBrowser?   Найти похожие ветки 

← →
ppcumax ©   (2007-04-12 00:51) [0]

сабж.

---

← →
ppcumax ©   (2007-04-12 16:17) [1]

что вариантов нет?
все делаю как обычно при создании popup меню, но почему-то отображается обычное меню IE

---

← →
Dmitrij_K   (2007-04-12 17:03) [2]

http://www.google.ru/search?hl=ru&q=webbrowser+popup&btnG=%D0%9F%D0%BE%D0%B8%D1%81%D0%BA+%D0%B2+Google&lr=

---

← →
easy ©   (2007-04-12 17:28) [3]

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, OleCtrls, SHDocVw, COmObj, ActiveX, Menus;
type
 pDocHostUIInfo = ^TDocHostUIInfo;
 TDocHostUIInfo = packed record
   cbSize: ULONG;
   dwFlags: DWORD;
   dwDoubleClick: DWORD;
   pchHostCss: polestr;
   pchHostNS: polestr;
 end;
 IDocHostUIHandler = interface(IUnknown)
   ["{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}"]
   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 fRameWindow: 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;
 end;
 TWebBrowserWithPopup = class(TWebBrowser, IDocHostUIHandler)
 private
   { Private declarations }
   FPopupMenu: TPopupMenu;
   procedure SetPopupMenu(const Value: TPopupMenu);
 protected
   { Protected declarations }
 public
   { Public declarations }
   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 fRameWindow: 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;
 published
   { Published declarations }
   property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;

 end;
 
type
 TForm1 = class(TForm)
   PopupMenu1: TPopupMenu;
   First1: TMenuItem;
   Second1: TMenuItem;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure First1Click(Sender: TObject);
 private
   { Private declarations }
   WebBrowserWithPopup: TWebBrowserWithPopup;
 public
   { Public declarations }
 end;

---

← →
easy ©   (2007-04-12 17:29) [4]

var
 Form1: TForm1;

implementation

{$R *.dfm}

{ TWebBrowserWithPopup }

function TWebBrowserWithPopup.EnableModeless(const fEnable: BOOL): HRESULT;
begin
 result := S_FALSE;
end;

function TWebBrowserWithPopup.FilterDataObject(const pDO: IDataObject;
 out ppDORet: IDataObject): HRESULT;
begin
 result := S_FALSE;
end;

function TWebBrowserWithPopup.GetDropTarget(const pDropTarget: IDropTarget;
 out ppDropTarget: IDropTarget): HRESULT;
begin
 result := S_FALSE;
end;

function TWebBrowserWithPopup.GetExternal(
 out ppDispatch: IDispatch): HRESULT;
begin
 result := S_OK;
end;

function TWebBrowserWithPopup.GetHostInfo(
 var pInfo: TDOCHOSTUIINFO): HRESULT;
begin
 result := S_OK;
end;

function TWebBrowserWithPopup.GetOptionKeyPath(var pchKey: POLESTR;
 const dw: DWORD): HRESULT;
begin
 result := S_FALSE;
end;

function TWebBrowserWithPopup.HideUI: HRESULT;
begin
 result := S_FALSE;
end;

function TWebBrowserWithPopup.OnDocWindowActivate(
 const fActivate: BOOL): HRESULT;
begin
 result := S_FALSE;
end;

function TWebBrowserWithPopup.OnFrameWindowActivate(
 const fActivate: BOOL): HRESULT;
begin
 result := S_FALSE;
end;

function TWebBrowserWithPopup.ResizeBorder(const prcBorder: PRECT;
 const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT;
begin
 result := S_FALSE;
end;

procedure TWebBrowserWithPopup.SetPopupMenu(const Value: TPopupMenu);
begin
 FPopupMenu := Value;
end;

function TWebBrowserWithPopup.ShowContextMenu(const dwID: DWORD;
 const ppt: PPOINT; const pcmdtReserved: IInterface;
 const pdispReserved: IDispatch): HRESULT;
begin
 if FPopupMenu <> nil then begin
   FPopupMenu.Popup(ppt.X, ppt.Y);
   result := S_OK;
 end else
   result := S_FALSE;
end;

function TWebBrowserWithPopup.ShowUI(const dwID: DWORD;
 const pActiveObject: IOleInPlaceActiveObject;
 const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
 const pDoc: IOleInPlaceUIWindow): HRESULT;
begin
 result := S_FALSE;
end;

function TWebBrowserWithPopup.TranslateAccelerator(const lpMsg: PMSG;
 const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT;
begin
 result := S_FALSE;
end;

function TWebBrowserWithPopup.TranslateUrl(const dwTranslate: DWORD;
 const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HRESULT;
begin
 result := S_FALSE;
end;

function TWebBrowserWithPopup.UpdateUI: HRESULT;
begin
 result := S_FALSE;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 WebBrowserWithPopup := TWebBrowserWithPopup.Create(self);
 WebBrowserWithPopup.PopupMenu := PopupMenu1;
 WebBrowserWithPopup.Align := alClient;
 TControl(WebBrowserWithPopup).Parent := self;
 WebBrowserWithPopup.Navigate("ya.ru");
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 WebBrowserWithPopup.Free;
end;

procedure TForm1.First1Click(Sender: TObject);
begin
 ShowMessage(TMenuItem(Sender).Caption);
end;

end.

---

← →
easy ©   (2007-04-12 17:30) [5]

Unit1.dfm
object Form1: TForm1
 Left = 192
 Top = 138
 Width = 528
 Height = 388
 Caption = "Form1"
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "MS Sans Serif"
 Font.Style = []
 OldCreateOrder = False
 Position = poScreenCenter
 OnCreate = FormCreate
 OnDestroy = FormDestroy
 PixelsPerInch = 96
 TextHeight = 13
 object PopupMenu1: TPopupMenu
   Left = 24
   Top = 12
   object First1: TMenuItem
     Caption = "First"
     OnClick = First1Click
   end
   object Second1: TMenuItem
     Caption = "Second"
     OnClick = First1Click
   end
 end
end

---

← →
ppcumax ©   (2007-04-12 18:24) [6]

ого! что же так сложно? буду пробовать...

---

Страницы: 1 вся ветка

Текущий архив: 2007.04.29;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.038 c