Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 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.47 MB
Время: 0.041 c
11-1152569152
ANTPro
2006-07-11 02:05
2007.04.29
Unpacker для KOL


2-1175109539
arturich
2007-03-28 23:18
2007.04.29
Перевести буквы на другой язык


2-1175968783
Степан
2007-04-07 21:59
2007.04.29
Утекает память? али нет...


8-1154280779
Pent
2006-07-30 21:32
2007.04.29
TFastDIB


15-1175355393
Reactor
2007-03-31 19:36
2007.04.29
Доудаление касперского





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский