VPF::отключ графики в embedded, webbrowsere, pagecontol

s2004

Дата 30.10.2006, 21:23 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 174
Регистрация: 30.10.2006

Репутация: нет
Всего: нет

пробовал embeddedwb с pagecontrol

Код


unit frmMain;

interface

uses
   Classes, Controls, Forms, OleCtrls, EmbeddedWB, ComCtrls, StdCtrls,
   IEAddress, ExtCtrls, Buttons;

type
   TForm1 = class(TForm)
      PageControl1: TPageControl;
      Panel1: TPanel;
      Button1: TButton;
      IEAddress1: TIEAddress;
      cbNewTab: TCheckBox;
      StatusBar1: TStatusBar;
    BitBtn1: TBitBtn;
      procedure PageControl1Change(Sender: TObject);
      procedure Button1Click(Sender: TObject);
      procedure FormShow(Sender: TObject);
   private
    { Private declarations }
      procedure DownloadCompleteEvent(Sender: TObject);
      function GetActiveEWB: TEmbeddedWB;
      procedure UpdateAddress;
      procedure UpdateTab;
      function CreateNewTabBrowser(Url: string): TTabSheet;
      procedure NewWindowEvent(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
      procedure NewWebStatusTextChange(Sender: TObject;
         const Text: WideString);
   public
    { Public declarations }
   end;

var
   Form1: TForm1;
   DesignTimeWB: TEmbeddedWB;
   NewTab: TTabSheet;
   i: integer;

implementation

{$R *.dfm}

//--------Private Section---------------------------------------------

procedure TForm1.UpdateTab;
begin
   PageControl1.ActivePage := NewTab;
   UpdateAddress;
end;

procedure TForm1.UpdateAddress;
var
   TEWB: TEMbeddedWB;
begin
   TEWB := GetActiveEWB;
   if TEWB <> nil then
      begin
         IEAddress1.EmbeddedWB := TEWB;
         IEAddress1.Text := TEWB.LocationURL;
         PageControl1.ActivePage.Caption := TEWB.LocationName;
      end;
end;

function TForm1.GetActiveEWB: TEmbeddedWB;
var
   i: integer;
begin
   Result := nil;
   if PageControl1.ActivePage <> nil then
      for i := 0 to PageControl1.ActivePage.ControlCount - 1 do
         begin
            if PageControl1.ActivePage.Controls[i] is TEmbeddedWB then
               begin
                  Result := TEmbeddedWB(PageControl1.ActivePage.Controls[i]);
                  Exit;
               end;
         end;
end;

procedure TForm1.DownloadCompleteEvent(Sender: TObject);
begin
   UpdateAddress;
end;

function TForm1.CreateNewTabBrowser(Url: string): TTabSheet;
begin
   NewTab := TTabSheet.Create(PageControl1);
   with NewTab do
      begin
         PageControl := PageControl1;
         Parent := PageControl1;
         Visible := true;
         PageIndex := PageControl1.ActivePageIndex;
      end;
   DesignTimeWB := TEmbeddedWB.Create(NewTab);
   TControl(DesignTimeWB).Parent := NewTab;
   with DesignTimeWB do
      begin
         EnableMessageHandler;
         Align := alClient;
         OnStatusTextChange := NewWebStatusTextChange;
         OnNewWindow2 := NewWindowEvent;
         OnDownloadComplete := DownloadCompleteEvent;
         if (URL) <> '' then
            DesignTimeWB.Navigate(URL);
         DesignTimeWB.Wait;
      end;
   PageControl1.ActivePage := NewTab;
   Result := NewTab;
end;

procedure TForm1.NewWindowEvent(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
begin
   CreateNewTabBrowser(DesignTimeWB.LocationURL);
   PageControl1.ActivePage := NewTab;
   ppdisp := DesignTimeWB.Application;
   UpdateTab;
end;

procedure TForm1.PageControl1Change(Sender: TObject);
begin
   UpdateAddress;
end;

procedure TForm1.NewWebStatusTextChange(Sender: TObject;
   const Text: WideString);
begin
   StatusBar1.SimpleText := Text;
end;

//--------End Of Private Section---------------------------------------------

procedure TForm1.FormShow(Sender: TObject);
begin
   CreateNewTabBrowser(DesignTimeWB.GetIEHomePage);
   UpdateTab;
end;


end.



и с MDI 


unit frmMain;

interface

uses
  SysUtils, Classes, Forms, Menus, Child, IEAddress, ExtCtrls,
  Controls, StdCtrls;

type
  TMainFrm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Newchild1: TMenuItem;
    Window1: TMenuItem;
    Tile1: TMenuItem;
    Cascade1: TMenuItem;
    ArrangeAll1: TMenuItem;
    N2: TMenuItem;
    CloseAll1: TMenuItem;
    N10: TMenuItem;
    MinimizeAll1: TMenuItem;
    N1: TMenuItem;
    ChildList: TMenuItem;
    Panel1: TPanel;
    IEAddress1: TIEAddress;
    Button1: TButton;
    N3: TMenuItem;
    Exit1: TMenuItem;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Newchild1Click(Sender: TObject);
    procedure CloseAll1Click(Sender: TObject);
    procedure Cascade1Click(Sender: TObject);
    procedure Tile1Click(Sender: TObject);
    procedure ArrangeAll1Click(Sender: TObject);
    procedure MinimizeAll1Click(Sender: TObject);
  private
    procedure CreateChildForm(const childName : string);
    { Private declarations }
  public
    { Public declarations }
  end;
var
  MainFrm: TMainFrm;

implementation
{$R *.DFM}

procedure TMainFrm.CreateChildForm(const childName : string);
var Child: TChildFrm;
begin
  Child := TChildFrm.Create(Application);
  Child.Caption := childName;
end;

procedure TMainFrm.NewChild1Click(Sender: TObject);
begin
   CreateChildForm('Child' + IntToStr(MDIChildCount + 1));
end;

procedure TMainFrm.CloseAll1Click(Sender: TObject);
var i: integer;
begin
for i:= 0 to MdiChildCount - 1 do
    MDIChildren[i].Close;
end;

procedure TMainFrm.Cascade1Click(Sender: TObject);
begin
 Cascade;
end;

procedure TMainFrm.Tile1Click(Sender: TObject);
begin
 if TileMode =  tbHorizontal then
    TileMode :=  tbVertical
 else
   TileMode :=  tbHorizontal;
 Tile;
end;

procedure TMainFrm.ArrangeAll1Click(Sender: TObject);
begin
  ArrangeIcons;
end;

procedure TMainFrm.MinimizeAll1Click(Sender: TObject);
var i: integer;
begin
for i:= MdiChildCount - 1 downto 0 do
    MDIChildren[i].WindowState:=wsMinimized;
end;

procedure TMainFrm.Button1Click(Sender: TObject);
begin
  if ActiveMDIChild <> nil then
     TChildFrm(ActiveMDIChild).EmbeddedWB1.Go(IEAddress1.Text);
end;
 
procedure TMainFrm.FormShow(Sender: TObject);
begin
  CreateChildForm('Child  #' + IntToStr(MDIChildCount + 1));
    if ActiveMDIChild <> nil then
       TChildFrm(ActiveMDIChild).EmbeddedWB1.Go(IEAddress1.Text);
end;

procedure TMainFrm.Exit1Click(Sender: TObject);
begin
   Close;
end;

end.

не работает процедура отключения загрузки графики хотя у меня с обычной SDI она прекрачсно работает

begin
EmbeddedWB1.DownloadOptions:=EmbeddedWb1.DownloadOptions
- [DLCTL_DLIMAGES, DLCTL_BGSOUNDS, DLCTL_VIDEOS]
+ [DLCTL_PRAGMA_NO_CACHE, DLCTL_NO_JAVA, DLCTL_NO_SCRIPTS];

end;

как исправить в этих двух примерах?

и по поводу отключения загрузки дя webbrowsera а не для embeddedawb вот в MSDN
написано

Controlling Download and Execution
The WebBrowser Control gives you control over what it downloads, displays, and executes. To gain this control, you need to implement your host's IDispatch so it handles DISPID_AMBIENT_DLCONTROL. When the WebBrowser Control is instantiated, it will call your IDispatch::Invoke with this ID. Set pvarResult to a combination of following flags, using the bitwise OR operator, to indicate your preferences.
DLCTL_DLIMAGES, DLCTL_VIDEOS, and DLCTL_BGSOUNDS: Images, videos, and background sounds will be downloaded from the server and displayed or played if these flags are set. They will not be downloaded and displayed if the flags are not set.
DLCTL_NO_SCRIPTS and DLCTL_NO_JAVA: Scripts and Java applets will not be executed.
DLCTL_NO_DLACTIVEXCTLS and DLCTL_NO_RUNACTIVEXCTLS : ActiveX controls will not be downloaded or will not be executed.
DLCTL_DOWNLOADONLY: The page will only be downloaded, not displayed.
DLCTL_NO_FRAMEDOWNLOAD: The WebBrowser Control will download and parse a frameSet, but not the individual frame objects within the frameSet.
DLCTL_RESYNCHRONIZE and DLCTL_PRAGMA_NO_CACHE: These flags cause cache refreshes. With DLCTL_RESYNCHRONIZE, the server will be asked for update status. Cached files will be used if the server indicates that the cached information is up-to-date. With DLCTL_PRAGMA_NO_CACHE, files will be re-downloaded from the server regardless of the update status of the files.
DLCTL_NO_BEHAVIORS: Behaviors are not downloaded and are disabled in the document.
DLCTL_NO_METACHARSET_HTML: Character sets specified in meta elements are suppressed.
DLCTL_URL_ENCODING_DISABLE_UTF8 and DLCTL_URL_ENCODING_ENABLE_UTF8: These flags function similarly to the DOCHOSTUIFLAG_URL_ENCODING_DISABLE_UTF8 and DOCHOSTUIFLAG_URL_ENCODING_ENABLE_UTF8 flags used with IDocHostUIHandler::GetHostInfo. The difference is that the DOCHOSTUIFLAG flags are checked only when the WebBrowser Control is first instantiated. The download flags here for the ambient property change are checked whenever the WebBrowser Control needs to perform a download.
DLCTL_NO_CLIENTPULL: No client pull operations will be performed.
DLCTL_SILENT: No user interface will be displayed during downloads.
DLCTL_FORCEOFFLINE: The WebBrowser Control always operates in offline mode.
DLCTL_OFFLINEIFNOTCONNECTED and DLCTL_OFFLINE: These flags are the same. The WebBrowser Control will operate in offline mode if not connected to the Internet.
DISPID_AMBIENT_DLCONTROL and the flag values are defined in mshtmdid.h.
Initially, when the function call to IDispatch::Invoke starts, the VARIANT to which the parameter pvarResult points is of type VT_EMPTY. You must switch the type to VT_I4 for any settings to have an effect. You can place your flag values in the lVal member of the VARIANT.
Most of the flag values have negative effects, that is, they prevent behavior that normally happens. For instance, scripts are normally executed by the WebBrowser Control if you don't customize its behavior. But if you set the DLCTL_NOSCRIPTS flag, no scripts will execute in that instance of the control. However, three flagsDLCTL_DLIMAGES, DLCTL_VIDEOS, and DLCTL_BGSOUNDSwork exactly opposite. If you set flags at all, you must set these three for the WebBrowser Control to behave in its default manner vis-a-vis images, videos and sounds.
The following code sample causes a WebBrowser Control instance to download and display images and videos, but not background sounds, since the DLCTL_BGSOUNDS is not explicitly set. Also, script execution on pages displayed by the WebBrowser Control is disabled.

Код


STDMETHODIMP CAtlBrCon::Invoke(DISPID dispidMember, REFIID riid,
                               LCID lcid, WORD wFlags, 
                               DISPPARAMS* pDispParams,
                               VARIANT* pvarResult, 
                               EXCEPINFO* pExcepInfo,
                               UINT* puArgErr)
{
    switch (dispidMember)
    {
    case DISPID_AMBIENT_DLCONTROL:
        pvarResult->vt = VT_I4;
        pvarResult->lVal = DLCTL_DLIMAGES | DLCTL_VIDEOS | DLCTL_NO_SCRIPTS;
        break;

    default:
        return DISP_E_MEMBERNOTFOUND;
    }

    return S_OK;
}

видим пример внизу но он на C++ как перевести на ltkmab именно для webbrowsera?

Это сообщение отредактировал(а) Girder - 2.11.2006, 10:36

Girder

Дата 2.11.2006, 10:38 (ссылка)

(нет голосов)

Загрузка ...

Лентяй 2

Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 6
Всего: 155

M
Girder

1. Пользуйся кнопкой КОД
2. Пользуйся поиском

PS: http://forum.vingrad.ru/index.php?showtopi...st&p=888278

--------------------

Как слышим, так и пишим.
Истина где-то там...

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: ActiveX/СОМ/CORBA \| Следующая тема »