Форум: "Начинающим";
Текущий архив: 2007.04.29;
Скачать: [xml.tar.bz2];
ВнизКак использовать свое 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;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.04 c