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.

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

模块“EMBEDA~1.OCX”中地址 07C734FC 的访问冲突。阅读 地址 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 实例，或者更好的回调方法。