TWebbrowser Gridshow und Snap-to-grid CtoPas

[Mavarik]

Hallo Zusammen...

Ein Problem habe ich noch vielleicht kann ja einer von Euch besser C.

Ich würde gerne im TWebbrowser ein Grid anzeigen...

Delphi-Quellcode:

error := ((HTMLDocument2Ifc as IHTMLDocument2).body as IHTMLElement2).addBehavior('',vFactory);

Hierbei müsste "nur" noch VFactory richtig gesetzt werden. Als Interface Procedure auf eine IHTMLPainter Routinen...

In C sieht die so aus:

Delphi-Quellcode:

STDMETHODIMP CHTMLEditControlSite::XHTMLPainter::Draw(RECT rcBounds, RECT /*rcUpdate*/, LONG /*lDrawFlags*/, HDC hdc, LPVOID /*pvDrawObject*/)
{
   if (m_bGrid != FALSE)
   {
      HPEN redPen   = (HPEN) CreatePen(PS_DOT, 0, RGB(0xff, 0x99, 0x99));
      HPEN oldPen = (HPEN) SelectObject(hdc, redPen);

      long lFirstLine = rcBounds.left + m_iGrid;

      for (int i = lFirstLine; i <= rcBounds.right; i += m_iGrid)
      {
         MoveToEx(hdc, i, rcBounds.top, NULL);
         LineTo(hdc, i, rcBounds.bottom);
      }

      lFirstLine = rcBounds.top + m_iGrid;

      for (i = lFirstLine ; i <= rcBounds.bottom; i += m_iGrid)
      {
         MoveToEx(hdc, rcBounds.left, i,  NULL);
         LineTo(hdc, rcBounds.right, i);
      }

      SelectObject(hdc, oldPen);
      DeleteObject(redPen);
   }

   return S_OK;
}

Auf ähnliche Weise muss die SnaptoGrid eingebunden werden...

Hat einer von Euch das als Delphi Source?

Ich habe auch noch 2* Source und Demo in C gefunden:

Einmal hier
und hier (msdn)

Danke im Voraus

Frank :coder:

[Mavarik]

Hallo Zusammen...

Vielleicht hat ja einer von Euch eine Idee, wie ich eine QueryService procedure in mein Form-Object implementiere.

Das würde mir schon helfen.

Frank :coder:

[marabu]

Hallo Frank,

meinst du das hier?

Delphi-Quellcode:

uses
  {...} ActiveX;

type
  TForm1 = class(TForm, IServiceProvider)
  public
    function QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
  end;

Grüße vom marabu

[Mavarik]

Zitat:

Zitat von marabu

Hallo Frank,

meinst du das hier?

Delphi-Quellcode:

uses
  {...} ActiveX;

type
  TForm1 = class(TForm, IServiceProvider)
  public
    function QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
  end;

Grüße vom marabu

Ja genau, aber diese QueryService wird bei mir NIE aufgerufen, genau das ist mein Problem!

Meine Test Unit:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw,ActiveX,MSHTML;

type
  TForm1 = class(TForm,IServiceProvider)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    function QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Webbrowser1.Navigate('http://www.delphipraxis.net');
end;

function TForm1.QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
begin
  Caption := 'Query'; // Wird nie Aufgerufen
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  (Webbrowser1.Document as IHTMLDocument2).designMode := 'on';
end;

end.

Frank :wiejetzt:

[marabu]

Vielleicht weil deine Form nicht der Host für die TWebBrowser-Komponente ist.

Nachtrag: wenn ich richtig gelesen habe, dann muss deine Form auch die Schnittstelle IOleClientSite implementieren, deren Methode QueryInterface verwendet wird um den ServiceProvider zu ermitteln.

marabu

[Mavarik]

Zitat:

Zitat von marabu

Vielleicht weil deine Form nicht der Host für die TWebBrowser-Komponente ist.

Nachtrag: wenn ich richtig gelesen habe, dann muss deine Form auch die Schnittstelle IOleClientSite implementieren, deren Methode QueryInterface verwendet wird um den ServiceProvider zu ermitteln.

marabu

:wiejetzt: Kannst Du das mal In Delphi antworten... Das habe ich jetzt nicht verstanden!

Frank

[Mavarik]

Zitat:

Zitat von marabu

Vielleicht weil deine Form nicht der Host für die TWebBrowser-Komponente ist.

Nachtrag: wenn ich richtig gelesen habe, dann muss deine Form auch die Schnittstelle IOleClientSite implementieren, deren Methode QueryInterface verwendet wird um den ServiceProvider zu ermitteln.

marabu

OK Habe mittlerweile verstanden was Du damit meinst....

Wenn ich jedoch IOleClientSite und IHTMLPainter und IHTMLBehavior und IHTMLBehaviorFactory in mein TForm include...

:wall: :wiejetzt:

Wie kann ich unterschiedliche QueryInterface declarieren?

Frank :coder: :roteyes: :spin2:

[marabu]

Wieso denn "unterschiedliche" QueryInterface? Die Interfaces teilen sich doch eine Implementierung dieser Methode - oder verstehe ich dich falsch?

marabu

[Mavarik]

Zitat:

Zitat von marabu

Wieso denn "unterschiedliche" QueryInterface? Die Interfaces teilen sich doch eine Implementierung dieser Methode - oder verstehe ich dich falsch?

marabu

Schon, jedoch ist in diesem C-Beispiel folgendes:

Delphi-Quellcode:

STDMETHODIMP CHTMLEditControlSite::XHTMLEditHost::QueryInterface(REFIID iid, LPVOID far* ppvObj)     
{
   METHOD_PROLOGUE(CHTMLEditControlSite, HTMLEditHost);

   return pThis->ExternalQueryInterface(&iid, ppvObj);
}

und

Delphi-Quellcode:

STDMETHODIMP CHTMLEditControlSite::XHTMLElementBehaviorFactory::QueryInterface(REFIID iid, LPVOID far* ppvObj)     
{
   METHOD_PROLOGUE(CHTMLEditControlSite, HTMLElementBehaviorFactory);

   *ppvObj = NULL;

   if (IsEqualIID(iid, IID_IElementBehaviorFactory))
   {
      *ppvObj = (IUnknown *) this;
      return S_OK;
   }
   else if (IsEqualIID(iid, IID_IElementBehavior))
   {
      *ppvObj = (IUnknown *) &pThis->m_xHTMLElementBehavior;
      return S_OK;
   }

   return E_NOTIMPL;
}

und

Delphi-Quellcode:

STDMETHODIMP CHTMLEditControlSite::XHTMLPainter::QueryInterface(REFIID iid, LPVOID far* ppvObj)     
{
   METHOD_PROLOGUE(CHTMLEditControlSite, HTMLPainter);

   return pThis->ExternalQueryInterface(&iid, ppvObj);
}

Also drei Mal QueryInterface mit unterschiedlichen Auswirkungen...

Ich habe es jetzt so gelöst, da das ursprüngliche Obj kein Interface ist und ich keinen TypCast hingekiregt habe...

Delphi-Quellcode:

function TForm1.MyQuery(out Obj: IInterface): HRESULT;
begin
  Obj := Self as IHTMLPainter;
  Result := S_OK;
end;

function TForm1.MyQuery2(out Obj: IInterface): HRESULT;
begin
  Obj := Self;
  Result := S_OK;
end;

function TForm1.MyQuery3(out Obj: IInterface): HRESULT;
begin
  Obj := Self as IElementBehaviorFactory;
  Result := S_OK;
end;

function TForm1.MyQuery4(out Obj: IInterface): HRESULT;
begin
  Obj := Self as IElementBehavior;
  Result := S_OK;
end;

function TForm1.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
begin
  Inherited QueryInterface(IID,Obj);

  if IsEqualGUID(IID,IID_IElementBehaviorFactory) then
    begin
      result := MyQuery3(IUnknown(Obj));
      exit;
    end;

  if IsEqualGUID(IID,IID_IElementBehavior) then
    begin
      result := MyQuery4(IUnknown(Obj));
      exit;
    end;

  if IsEqualGUID(IID, IID_IHTMLPainter) then
    begin
      result := MyQuery(IUnknown(Obj));
      exit;
    end;
  if IsEqualGUID(IID, IID_IUnKnown) then
    begin
      result := MyQuery2(IUnknown(Obj));
      exit;
    end;
  result := E_NOTIMPL;
end;

Ich habe ein Testprogramm mit EmbeddedWB! Diese Unit "schafft" es den QueryInterface zu erhalten.

Bei mit kommt im Queryinterface immer nur ein TGUID = '{00000000-0000-0000-C000-000000000046}'
einmal und sonst NIX!

Frank :wall: :wall:

[marabu]

Zitat:

Zitat von Mavarik

Also drei Mal QueryInterface mit unterschiedlichen Auswirkungen...

Naja, nicht ganz.

Wolltest du es vielleicht so?

Delphi-Quellcode:

// ungetestet

function TForm1.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
begin
  Result := S_OK;
  if IsEqualGUID(IID, IID_IElementBehaviorFactory) then
    IInterface(Obj) := self as IElementBehaviorFactory else
  if IsEqualGUID(IID, IID_IElementBehavior) then
    IInterface(Obj) := self as IElementBehavior else
  if IsEqualGUID(IID, IID_IHTMLPainter) then
    IInterface(Obj) := self as IHTMLPainter else
  Result := inherited QueryInterface(IID, Obj);
end;

marabu