秋·风

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::
一、出现的问题
用cef4delphi的lazarus any_os demo编译的程序在linux运行会出现以下错误:

二、解决方法
以demos\Lazarus_Linux_GTK2\SimpleBrowser为例
1、将interfacesgtk2.pas保存到project目录
interfacesgtk2.pas:

unit Interfacesgtk2;

{$mode objfpc}{$H+}

interface

{$IFDEF UNIX}{$IFNDEF DisableCWString}uses cwstring;{$ENDIF}{$ENDIF}

procedure CustomWidgetSetInitialization;
procedure CustomWidgetSetFinalization;

implementation

uses
 {$IFNDEF EnableLibOverlay}
 gtk2DisableLibOverlay,
 {$ENDIF}
 Gtk2Int, Forms, xlib;

function CustomX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl;
begin
  {$IFDEF DEBUG}
  XError := ErrorEv^.error_code;
  WriteLn('Error: ' + IntToStr(XError));
  {$ENDIF}
  Result := 0;
end;

function CustomXIOErrorHandler(Display:PDisplay):longint;cdecl;
begin
  Result := 0;
end;

procedure CustomWidgetSetInitialization;
begin
  CreateWidgetset(TGtk2WidgetSet);
  // Install xlib error handlers so that the application won't be terminated
  // on non-fatal errors. Must be done after initializing GTK.
  XSetErrorHandler(@CustomX11ErrorHandler);
  XSetIOErrorHandler(@CustomXIOErrorHandler);
end;

procedure CustomWidgetSetFinalization;
begin
  FreeWidgetSet;
end;

end.

2、修改lpr文件
在 uses增加 Interfacesgtk2,并根据系统类型指定cef的路径(GlobalCEFApp.FrameworkDirPath)。

program SimpleBrowser;

{$mode objfpc}{$H+}         

{$I ../../../source/cef.inc}

uses
  {$IFDEF UNIX}//{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}//{$ENDIF}
  SysUtils,
  {$ifdef linux}
    Interfacesgtk2,
  {$endif}
  Forms, Interfaces, uSimpleBrowser,
  { you can add units after this }
  uCEFApplication;

{$R *.res}

begin
  GlobalCEFApp := TCefApplication.Create;
  GlobalCEFApp.CheckCEFFiles:=False;
  {$ifdef linux}
  GlobalCEFApp.FrameworkDirPath:=Extractfilepath(Paramstr(0))+'gtk2';
  {$else}
  GlobalCEFApp.FrameworkDirPath:=Extractfilepath(Paramstr(0))+'win64';
  {$endif}

  // In case you want to use custom directories for the CEF3 binaries, cache and user data.
  // If you don't set a cache directory the browser will use in-memory cache.
{
  GlobalCEFApp.FrameworkDirPath     := 'c:\cef';
  GlobalCEFApp.ResourcesDirPath     := 'c:\cef';
  GlobalCEFApp.LocalesDirPath       := 'c:\cef\locales';
  GlobalCEFApp.EnableGPU            := True;      // Enable hardware acceleration
  GlobalCEFApp.cache                := 'c:\cef\cache';
  GlobalCEFApp.UserDataPath         := 'c:\cef\User Data';
}

  // You *MUST* call GlobalCEFApp.StartMainProcess in a if..then clause
  // with the Application initialization inside the begin..end.
  // Read this https://www.briskbard.com/index.php?lang=en&pageid=cef
  if GlobalCEFApp.StartMainProcess then
    begin
      // The LCL Widgetset must be initialized after the CEF initialization and
      // only in the browser process.
      {$ifdef linux}
      CustomWidgetSetInitialization;
      {$endif}
      RequireDerivedFormResource:=True;
      Application.Scaled:=True;
      Application.Initialize;
      Application.CreateForm(TForm1, Form1);
      Application.Run;
      {$ifdef linux}
      CustomWidgetSetFinalization;
      {$endif}
    end;

  GlobalCEFApp.Free;
  GlobalCEFApp := nil;
end.

经修改后的代码可以分别编译为 Linux GTK2和windows的程序。

2025-07-25更新:
之前的方法修改该编译为windows,程序运行结束后,程序会驻留在内存不会退出。根据使用的chromium类型,分2个解决方法。
1、使用TChromiumWindow:添加红色代码重新编译就可以。

unit uSimpleBrowser;

{$mode objfpc}{$H+}   

{$I ../../../source/cef.inc}

interface

uses
  {$ifdef windows}
  Windows, Messages,
  {$endif}
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, LMessages,
  uCEFConstants, uCEFTypes, uCEFInterfaces, uCEFChromiumEvents, uCEFChromiumWindow;


type
  { TForm1 }
  TForm1 = class(TForm)
    AddressEdt: TEdit;
    AddressPnl: TPanel;
    ChromiumWindow1: TChromiumWindow;
    GoBtn: TButton;
    Timer1: TTimer;

    procedure GoBtnClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

    procedure FormActivate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);

    procedure ChromiumWindow1AfterCreated(Sender: TObject);
    procedure ChromiumWindow1BeforeClose(Sender: TObject);
    {$ifdef windows}
    procedure ChromiumWindow1Close(Sender: TObject);
    {$endif}
  private

  protected
procedure TForm1.FormCreate(Sender: TObject);
begin
  FCanClose := False;
  FClosing  := False;

  // The browser will load the URL in AddressEdt initially.
  ChromiumWindow1.ChromiumBrowser.DefaultURL := UTF8Decode(AddressEdt.Text);
  {$ifdef windows}
  ChromiumWindow1.OnClose:=@ChromiumWindow1Close;//绑定close
  {$endif}
end;

{$ifdef windows}
procedure TForm1.ChromiumWindow1Close(Sender: TObject);
begin
  FCanClose := True;
  PostMessage(Handle, WM_CLOSE, 0, 0);
end;
{$endif}

2、使用TCEFWindowParent、TCEFLinkedWindowParent等非TChromiumWindow的方法:(以demos\Lazarus_Linux_GTK2\MiniBrowser这例子
添加红色代码就可以。

procedure TMiniBrowserFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := FCanClose;

  if not(FClosing) then
    begin
      FClosing := True;
      Visible  := False;

      // if TChromium.MultiBrowserMode is enabled then we have to close all
      // stored browsers and not only the main browser.
      Chromium1.CloseAllBrowsers;
      {$ifdef windows}
      if GlobalCEFApp.ChromeRuntime then
        CEFLinkedWindowParent1.Free;
      {$endif}
    end;
end;

 

posted on 2025-07-24 14:29  秋·风  阅读(258)  评论(0)    收藏  举报