delphi Activex 和父表单错误

Question

我尝试修复我的 activex 项目，但我有错误，我的 activex 项目中有 2 个表单，第一个表单保持 tmemo 和按钮调用第二个表单作为父表单，到目前为止一切正常，但是我无法设置从第二种形式到第一种形式的任何记录控件总是遇到访问冲突所以我决定在第一种形式中设置 tmemo.text 控件之前显示结果并且实际上结果正在显示但但不能设置为第一种形式这里是我的项目代码

unit main1;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls, embed_TLB, StdVcl, Vcl.StdCtrls;

type
  Tform1 = class(TForm, Iform1)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }


  protected
    { Protected declarations }

  public
    { Public declarations }
    procedure showEmo(L,T:Integer);

  end;

  var
  Form1 : Tform1;

implementation

uses ComObj, ComServ, main2;

{$R *.DFM}

{ Tform1 }

procedure Tform1.Button1Click(Sender: TObject);
var
  Rect: TRect;
begin
  GetWindowRect(Self.button1.Handle, Rect);
  showEmo(Rect.Left + 70,(Rect.Top - 290));
end;

procedure Tform1.FormCreate(Sender: TObject);
begin
  Form2 := TForm2.Createparented(0);
end;

procedure TForm1.showEmo(L,T:Integer);
var
  Rect: TRect;
begin
  try
    GetWindowRect(button1.Handle, Rect);
    begin
      Form2.FormStyle := fsStayOnTop;
    end;
    Form2.Left := L;//Rect.Left;
    Form2.top := T;//Rect.Top - emo.Height;
  finally
    Form2.Visible := not (Form2.visible);
  end;

end;

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    Tform1,
    Class_form1,
    0,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);
end.

表格 2

unit main2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw_EWB, EwbCore,
  EmbeddedWB, MSHTML_EWB, Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    ewbpage: TEmbeddedWB;
    load: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure ewbpageBeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
      var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
      var Cancel: WordBool);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses main1;

{$R *.dfm}

procedure TForm2.ewbpageBeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
  var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
  var Cancel: WordBool);
  var
  MousePos: TPoint;
  HtmlElement: IHTMLElement;
  iHTMLDoc: IHtmlDocument2;
begin
  if Pos('#sm',URL)>0 then
  begin
    if Supports(ewbpage.Document, IHtmlDocument2, iHTMLDoc) then
    begin
      if GetCursorPos(MousePos) then
      begin
        MousePos := ewbpage.ScreenToClient(MousePos);
        HtmlElement := iHTMLDoc.ElementFromPoint(MousePos.X, MousePos.Y);
        if Assigned(HtmlElement) then
          showmessage(HtmlElement.getAttribute('id', 0));
        form1.Memo1.Text :=  HtmlElement.getAttribute('id', 0);
        Cancel := True;
        Self.Close;
      end;
    end;
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  ewbpage.LoadFromStrings(load.Lines);
end;

end.

问题是为什么我会收到此错误

Access violation at address 07C734FC in module 'EMBEDA~1.OCX'. Read of address 000003B4.

在这一行

form1.Memo1.Text :=  HtmlElement.getAttribute('id', 0);

为什么我不能将第二种形式的结果设置为第一种形式？我在这里做错的是完整的项目，以便更好地理解

http://www.mediafire.com/download/zn7hzoxze2390a3/embeddedactivex.zip

Answer 1

一旦您开始正确格式化代码，您就会看到这个问题

procedure TForm2.ewbpageBeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
  var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
  var Cancel: WordBool);
  var
  MousePos: TPoint;
  HtmlElement: IHTMLElement;
  iHTMLDoc: IHtmlDocument2;
begin
  if Pos('#sm',URL)>0 then
  begin
    if Supports(ewbpage.Document, IHtmlDocument2, iHTMLDoc) then
    begin
      if GetCursorPos(MousePos) then
      begin
        MousePos := ewbpage.ScreenToClient(MousePos);
        HtmlElement := iHTMLDoc.ElementFromPoint(MousePos.X, MousePos.Y);

        // if we have a valid HtmlElement ...
        if Assigned(HtmlElement) 
        then // show a message
          showmessage(HtmlElement.getAttribute('id', 0));

        // now we do not care about if HtmlElement is valid or not
        form1.Memo1.Text :=  HtmlElement.getAttribute('id', 0);

        Cancel := True;
        Self.Close;
      end;
    end;
  end;
end;

要仅解决您当前的访问冲突，您只需在将使用 HtmlElement.

的所有行周围放置一个 begin end 块

        HtmlElement := iHTMLDoc.ElementFromPoint( MousePos.X, MousePos.Y );

        if Assigned( HtmlElement ) 
        then
          begin
            showmessage( HtmlElement.getAttribute( 'id', 0 ) );
            form1.Memo1.Text := HtmlElement.getAttribute( 'id', 0 );
          end;

但是您的代码中还有一些问题。您不应使用全局变量 form1 和 form2。而是将表单实例传递给创建的 TForm2 实例或更好的回调方法。

delphi Activex 和父表单错误

delphi Activex and parented forms error

forms

delphi

activex

delphi-xe7