Code: Select all
program Project2;
{$I cef.inc}
uses
{$IFDEF DELPHI16_UP}
Vcl.Forms,
WinApi.Windows,
{$ELSE}
Forms,
Windows,
{$ENDIF }
uCEFApplication, uCEFConstants,
Unit2 in 'Unit2.pas' {Form2};
{$R *.res}
// CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes to use up to 3GB of RAM.
// If you don't add this flag the rederer process will crash when you try to load large images.
begin
GlobalCEFApp := TCefApplication.Create;
// 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
Application.Initialize;
{$IFDEF DELPHI11_UP}
Application.MainFormOnTaskbar := True;
{$ENDIF}
Application.CreateForm(TForm2, Form2);
Application.Run;
end;
DestroyGlobalCEFApp;
end.
Code: Select all
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.StrUtils,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.SyncObjs, uCEFApplication, uCEFChromiumCore,
uCEFChromium, uCEFInterfaces, uCEFTypes, uCEFConstants;
type
TForm2 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
th = class(TThread)
private
protected
procedure ChromiumClose(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
procedure ChromiumAfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure ChromiumBeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure ChromiumLoadEnd(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; httpStatusCode: Integer);
procedure Execute; Override;
public
constructor Сreate(createsuspended: boolean);
end;
var
Form2: TForm2;
cs:TCriticalSection;
work:boolean=true;
implementation
{$R *.dfm}
{ th }
constructor th.Сreate(createsuspended: boolean);
begin
inherited Create(CreateSuspended);
FreeOnTerminate:=True;
end;
procedure th.ChromiumAfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
//form2.Memo1.Lines.Add('2');
PostMessage(Browser.Host.OpenerWindowHandle, CEF_AFTERCREATED, 0, 0);
//PostThreadMessage(Browser.Host.WindowHandle, CEF_AFTERCREATED, 0, 0);
end;
procedure th.ChromiumBeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
//form2.Memo1.Lines.Add('1');
PostMessage(Browser.Host.OpenerWindowHandle, WM_QUIT, 0, 0);
FreeAndNil(Sender);
//PostThreadMessage(Browser.Host.WindowHandle, WM_QUIT, 0, 0);
end;
procedure th.ChromiumClose(Sender: TObject; const browser: ICefBrowser;
var aAction: TCefCloseBrowserAction);
begin
//form2.Memo1.Lines.Add('0');
PostMessage(Browser.Host.OpenerWindowHandle, CEF_DESTROY, 0, 0);
FreeAndNil(Sender);
//PostThreadMessage(Browser.Host.WindowHandle, CEF_DESTROY, 0, 0);
end;
procedure th.ChromiumLoadEnd(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; httpStatusCode: Integer);
begin
Browser.Host.CloseBrowser(True);
end;
procedure th.Execute;
var
Chrome:TChromium;
begin
while work do begin
if work then begin
Chrome:=TChromium.Create(nil);
Chrome.DefaultUrl:=('https://');
Chrome.OnLoadEnd:=ChromiumLoadEnd;
Chrome.OnAfterCreated:=ChromiumAfterCreated;
Chrome.OnBeforeClose:=ChromiumBeforeClose;
Chrome.OnClose:=ChromiumClose;
Chrome.CreateBrowser(nil);
end;
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
i:integer;
begin
cs:=TCriticalSection.Create;
//for i:=1 to 100 do
th.Create(False);
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
work:=False;
end;
end.