Lazarus中文社区

 找回密码
 立即注册(注册审核可向QQ群索取)

QQ登录

只需一步,快速开始

Lazarus IDE and 组件 下载地址版权申明
查看: 3888|回复: 0

[界面] lazarus中嵌入浏览器实践

[复制链接]

该用户从未签到

发表于 2015-3-3 22:26:39 | 显示全部楼层 |阅读模式

一、嵌入IE。
这方面资料网络上比较多,就不详细说。导入类型库完成之后,一般创建控件的代码是这样(如果你生成了TActiveXContainer的子类):
  Browser:=TAxcWebBrowser.Create(Self);
  Browser.Name:= 'WebBrowser1';
  Browser.Parent := Self;
  Browser.Active := True;
  Browser.BoundsRect := Rect(0, 0, 800, 600);
  //Browser.OleServer.Set_Silent(true); // 屏蔽script错误提示。
  Browser.OnStatusTextChange:=@OnStatusTextChange;

然而有网友报告一个问题,有时候游览某些网页时,会出错。这其实是某些浏览器插件的浮点异常,使用以下语句屏蔽之:
  SetExceptionMask(GetExceptionMask + [exInvalidOp]);
或者都屏蔽了:
  SetExceptionMask([exInvalidOp..exPrecision]);
SetExceptionMask不仅屏蔽了FPU的异常,对SSE指令引发的浮点异常也能屏蔽。

二、嵌入chromium。
有个Chromium Embeded Frame项目,目的就是在应用程序中嵌入Chrome浏览器。这早有delphi的控件,但一直没有LCL的版本。我试改了一下delphichromiumembededframe,几经周折,终于解决出现的问题,现在把解决的过程分享出来。
从这里下载源码 https://code.google.com/p/delphichromiumembedded/
或者从这里,可能比较新,示例有些不同:
https://github.com/svn2github/dcef3
(某组织无耻,有些可能连接不上)

1. 修改cef.inc
{$IFDEF FPC}
  // force multithreading message loop on FPC, still not work
  {$DEFINE CEF_MULTI_THREADED_MESSAGE_LOOP}
{$ENDIF}
取消{$DEFINE CEF_MULTI_THREADED_MESSAGE_LOOP},我认为LCL和VCL没多大差别,按VCL的方式搞即可。
2. 修改cefvcl.pas
    procedure CreateWindowHandle(const Params: TCreateParams); override;
LCL的TWinControl没这个,可以重载CreateWnd函数,把代码移过来。
    {$IFNDEF FPC}
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    {$ELSE}
    procedure CreateWnd; override;
    {$ENDIF}

{$IFNDEF FPC}
procedure TCustomChromium.CreateWindowHandle(const Params: TCreateParams);
begin
  inherited;
  CreateBrowser;
end;
{$ELSE}
procedure TCustomChromium.CreateWnd;
begin
  inherited;
  CreateBrowser;
end;
{$ENDIF}

需要uses LCLType, LMessages
3. 把它的示例guiclient改成Lazarus项目,具体过程不再详述,需要注意的是主窗体的crm控件,我们没安装,不能直接拖放,但可以动态创建。把原来crm占用的地方用一个TPanel替换,使用代码在FormCreate事件中创建crm,如下:

  crm := TChromium.Create(Self);
  with crm do
  begin
    Name := 'crm';
    Parent := BrowserContainer;
    Align := alClient;
    Color := clWhite;
    Align := alBottom;
    Anchors := [akLeft, akTop, akRight, akBottom];
    DefaultUrl := 'http://www.baidu.com';
   // Options.PluginsDisabled:= True;
   // Options.AcceleratedPaintingDisabled := False;
   // Options.AcceleratedFiltersDisabled := False;
   // Options.AcceleratedPluginsDisabled := False;
    OnLoadStart := @crmLoadStart;
    OnLoadEnd := @crmLoadEnd;
    OnAuthCredentials := @crmAuthCredentials;
    OnGetDownloadHandler := @crmGetDownloadHandler;
    OnAddressChange := @crmAddressChange;
    OnStatusMessage := @crmStatusMessage;
    OnTitleChange := @crmTitleChange;
  end;
4. 同样需要使用  SetExceptionMask([exInvalidOp..exPrecision]) 屏蔽浮点异常。


修改到编译通过,运行,好像可以浏览网页了。但问题出现了,动不动就报错。怎么回事呢,DELPHI的代码不会这样啊?仔细调试了好久,发现这个是FPC的RTL中多线程问题。
在RTL中启动一个线程,需要初始化一些数据。如果线程都是EXE自己创建的,本来没什么,但如果是外部库启动的,并且还回调你的函数呢?这就麻烦大了。有个重要地方必须要初始化,那就是threadvar,fpc的实现方式和delphi差不多,都是动态分配一个内存,通过系统的TlsGetValue来存取。delphi不管当前系统有几个线程,都通过系统存取这些数据。而fpc在单线程环境下直接存取这些数据,多线程才通过系统,这样导致了数据混乱(fpc 中的异常链就是用threadvar来存放)。解决方法很简单,创建一个什么都不做的线程,运行它,让RTL认为这是个多线程环境即可:
type
  TMyThread = class(TThread)
  protected
    procedure Execute; override;
  end;

procedure TMyThread.Execute;
begin
end;

在FormCreate中使用:
  with TMyThread.Create(True) do
  begin
    FreeOnTerminate := True;
    Start;
    WaitFor;
  end;

另一个问题是退出时偶尔报错,或逗留内存退不出,估计原因可能是没有等它内部线程完全退出,在 FormClose中试写段解决:
procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
  i: Integer = 0;
begin
  try
    crm.Load('about:blank');
    while i < 50 do
    begin
      inc(i);
      sysutils.Sleep(5);
      Application.ProcessMessages;
    end;
  except

  end;
end;

磕磕碰碰,我大lazarus终于也用上了cef了

附件只有代码,没有cef二进制包,请自行下载。












本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?立即注册(注册审核可向QQ群索取)

x
回复

使用道具 举报

*滑块验证:

本版积分规则

QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1 )

GMT+8, 2024-7-20 10:36 , Processed in 0.059073 second(s), 9 queries , Redis On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表