Форум программистов [Powered by Invision Power Board]

Код

unit Unit6;

interface

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

type

  IMyEventSink = interface(IDispatch)
    procedure SetSource(Value: OleVariant);
    property Source: OleVariant write SetSource;
  end;

  { onclick Handler }
  TEventSink = class(TInterfacedObject, IMyEventSink)
  private
    FSource: OleVariant;
    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;
    procedure SetSource(Value: OleVariant);
  end;

  TForm6 = class(TForm)
    WebBrowser1: TWebBrowser;
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FFontSink: IMyEventSink;
  end;

var
  Form6: TForm6;
  v: Variant;
  HTMLDocument: IHTMLDocument2;
  
implementation

{$R *.dfm}

procedure TForm6.Button1Click(Sender: TObject);
var
  Fonts: IHTMLElementCollection;
  FontEl: IHTMLElement2;
  i: integer;
begin
  if WebBrowser1.Document = nil then
  begin
    WebBrowser1.Navigate('about:blank');
    HTMLDocument:=WebBrowser1.Document as IHTMLDocument2;
    v:=VarArrayCreate([0, 0], varVariant);
    v[0]:='<STYLE> .KEY {font-size: 16px; font-family: "Courier"; font-weight: bold; background-color: #EEEEEE;}</STYLE>';
    HTMLDocument.Writeln(PSafeArray(TVarData(v).VArray));
  end;
  v[0]:='<b ID=MyDiv><font CLASS=KEY color = Red>'+Edit1.Text+'</font>: </b>'+Edit2.Text+'<br>';
  HTMLDocument.Writeln(PSafeArray(TVarData(v).VArray));

  with WebBrowser1 do
  begin
    while ReadyState < READYSTATE_INTERACTIVE do
      Forms.Application.ProcessMessages;
    Fonts := ((Document as IHTMLDocument2).body as IHTMLElement2).getElementsByTagName('FONT');
    //ShowMessage(IntToStr(Fonts.length));
    if Assigned(Fonts) then
    try
      FontEl := Fonts.item(Unassigned, 0) as IHTMLElement2;
      if Assigned(FontEl) then
      try
          { Назначение onclick для <FONT> }
          for i:= 0 to Fonts.length-1 do
          begin
          FFontSink.Source := FontEl;
          (Fonts.item(i,varEmpty) as IHTMLElement).onclick := FFontSink;
          end;
      finally
        FontEl := nil;
      end;
    finally
      Fonts := nil;
    end;
  end;
end;

{ TEventSink }

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

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

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

function TEventSink.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
  objElement: ihtmlELement;
begin
  Result := S_OK;
  objElement:=(Form6.WebBrowser1.Document as IHTMLDOcument2).parentWindow.event.srcElement;
  if objElement.className='KEY' then
  begin
    Form6.Edit3.Text:=OleVariant(Form6.WebBrowser1.Document).parentWindow.event.srcElement.InnerText;
  end;
end;

procedure TEventSink.SetSource(Value: OleVariant);
begin
  FSource := Value;
end;

procedure TForm6.FormCreate(Sender: TObject);
begin
  FFontSink := TEventSink.Create;
end;

end.