IHTMLDocument2 Events

[machstuhl]

<BR> anstatt <P> bei Enter im TWebbrowser

Delphi-Quellcode:

type
  //Create the procedure type to assign the event
  TObjectProcedure = procedure(Sender: TObject; Event: IHTMLEventObj) of object;

  //Create a  new class for manage the event from the twebbrowser
  TEventObject = class(TInterfacedObject, IDispatch)
  private
    FOnEvent2: TObjectProcedure;
  private
    constructor Create(const OnEvent: TObjectProcedure);
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  public
    property OnEvent: TObjectProcedure read FOnEvent2 write FOnEvent2;
  end;


procedure TFrameHTMLEditor.WebBrowser1OnKeyDown(Sender: TObject;
  EventObjIfc: IHTMLEventObj);
var
  selectionRange: IHtmlTxtRange;
begin
// DocInterFace ist Webbrowser.Document as IHTMLDocument2 

  if Not Assigned(WebBrowser1.Document) then
    Exit;

  // Wenn Enter gedrückt wird, soll kein Absatz eingefügt werden (sondern ein ganz normaler Zeilenumbruch)
  if DocInterface.parentWindow.event.keyCode = VK_RETURN then begin

    selectionRange := DocInterface.selection.createRange as IHtmlTxtRange;

    selectionRange.pasteHTML('<br>');
    // returnValue bewirkt, dass der ursprüngliche Wert (<p>) nicht zurückgegeben wird
    DocInterface.parentWindow.event.returnValue := False;
    DocInterface.parentWindow.event.keyCode :=0;
  end;
end;

constructor TEventObject.Create(const OnEvent: TObjectProcedure );
begin
  inherited Create;
  FOnEvent2 := OnEvent;
end;

function TEventObject.GetIDsOfNames( const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer;
  DispIDs: Pointer ): HResult;
begin
  Result := E_NOTIMPL;
end;

function TEventObject.GetTypeInfo( Index, LocaleID: Integer; out TypeInfo ): HResult;
begin
  Result := E_NOTIMPL;
end;

function TEventObject.GetTypeInfoCount( out Count: Integer ): HResult;
begin
  Result := E_NOTIMPL;
end;

function TEventObject.Invoke( DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params;
  VarResult, ExcepInfo, ArgErr: Pointer ): HResult;
var
  HTMLEventObjIfc: IHTMLEventObj;
begin
  if (DispID = 0) then begin
    if Assigned(FOnEvent2) then
      FOnEvent2(Self, HTMLEventObjIfc);
    Result := S_OK;
  end else
    Result := E_NOTIMPL;
end;

procedure TFrameHTMLEditor.WebBrowser1NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  if FCurDispatch = nil then
    FCurDispatch := pDisp;
  DocInterface.onkeydown := (TEventObject.Create(WebBrowser1OnKeyDown) as IDispatch);
end;

Damit die Nachwelt auch noch was von meiner Arbeit hat