pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-06-12 22:07:39 +02:00
Code Issues Actions Releases Activity

Update to CEF 3.3626.1891.g52be333

Browse Source 
- Added transparency support to TBufferPanel.
- Added TBufferPanel.Transparent property
- Added TBufferPanel.OnPaintParentBkg event
- Added the TRANSPARENT_BROWSER constant in SimpleOSRBrowser to enable transparency
This commit is contained in:
Salvador Díaz Fau
2019-02-20 12:44:07 +01:00
parent 86561f4913
commit b3213a1052
6 changed files with 198 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
bin/transparency.html Normal file
View File

@ -0,0 +1,63 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<title>Transparency Examples</title>
<style type="text/css">
body {
font-family: Verdana, Arial;
}
img {
opacity:0.4;
}
img:hover {
opacity:1.0;
}
.box_white, .box_black {
font-size: 14px;
font-weight: bold;
text-align: center;
padding: 10px;
display: inline-block;
width: 100px;
}
.box_white {
background-color: white;
border: 2px solid black;
color: black;
}
.box_black {
background-color: black;
border: 2px solid white;
color: white;
}
.box_0 {
opacity: 1.0;
}
.box_25 {
opacity: 0.75;
}
.box_50 {
opacity: 0.5;
}
.box_75 {
opacity: 0.25;
}
.box_100 {
opacity: 0;
}
</style>
</head>
<body>
<h1>Image Transparency</h1>
Hover over an image to make it fully opaque.<br>
<img src="http://www.w3schools.com/css/klematis.jpg" width="150" height="113" alt="klematis" />
<img src="http://www.w3schools.com/css/klematis2.jpg" width="150" height="113" alt="klematis" />
<h1>Block Transparency</h1>
<span class="box_white box_0">White 0%</span> <span class="box_white box_25">White 25%</span> <span class="box_white box_50">White 50%</span> <span class="box_white box_75">White 75%</span> <span class="box_white box_100">White 100%</span>
<br>
<span class="box_black box_0">Black 0%</span> <span class="box_black box_25">Black 25%</span> <span class="box_black box_50">Black 50%</span> <span class="box_black box_75">Black 75%</span> <span class="box_black box_100">Black 100%</span>
</body>
</html>

7
demos/SimpleOSRBrowser/SimpleOSRBrowser.dpr
View File

@ -55,9 +55,7 @@ uses
{$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE} {$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE}
begin begin
GlobalCEFApp := TCefApplication.Create; CreateGlobalCEFApp;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
if GlobalCEFApp.StartMainProcess then if GlobalCEFApp.StartMainProcess then
begin begin
@ -69,6 +67,5 @@ begin
Application.Run; Application.Run;
end; end;
GlobalCEFApp.Free; DestroyGlobalCEFApp;
GlobalCEFApp := nil;
end. end.

19
demos/SimpleOSRBrowser/uSimpleOSRBrowser.dfm
View File

@ -37,7 +37,7 @@ object Form1: TForm1
object ComboBox1: TComboBox object ComboBox1: TComboBox
Left = 5 Left = 5
Top = 5 Top = 5
Width = 909 Width = 907
Height = 21 Height = 21
Align = alClient Align = alClient
ItemIndex = 0 ItemIndex = 0
@ -51,12 +51,14 @@ object Form1: TForm1
'https://www.w3schools.com/tags/tryit.asp?filename=tryhtml5_selec' + 'https://www.w3schools.com/tags/tryit.asp?filename=tryhtml5_selec' +
't_form' 't_form'
'https://www.briskbard.com' 'https://www.briskbard.com'
'https://frames-per-second.appspot.com/') 'https://frames-per-second.appspot.com/'
'file:///transparency.html')
ExplicitWidth = 909
end end
object Panel2: TPanel object Panel2: TPanel
Left = 914 Left = 912
Top = 5 Top = 5
Width = 69 Width = 71
Height = 20 Height = 20
Margins.Left = 2 Margins.Left = 2
Margins.Top = 2 Margins.Top = 2
@ -80,7 +82,7 @@ object Form1: TForm1
OnEnter = GoBtnEnter OnEnter = GoBtnEnter
end end
object SnapshotBtn: TButton object SnapshotBtn: TButton
Left = 38 Left = 40
Top = 0 Top = 0
Width = 31 Width = 31
Height = 20 Height = 20
@ -99,6 +101,7 @@ object Form1: TForm1
TabOrder = 1 TabOrder = 1
OnClick = SnapshotBtnClick OnClick = SnapshotBtnClick
OnEnter = SnapshotBtnEnter OnEnter = SnapshotBtnEnter
ExplicitLeft = 38
end end
end end
end end
@ -110,8 +113,11 @@ object Form1: TForm1
OnIMECancelComposition = Panel1IMECancelComposition OnIMECancelComposition = Panel1IMECancelComposition
OnIMECommitText = Panel1IMECommitText OnIMECommitText = Panel1IMECommitText
OnIMESetComposition = Panel1IMESetComposition OnIMESetComposition = Panel1IMESetComposition
OnPaintParentBkg = Panel1PaintParentBkg
Align = alClient Align = alClient
Caption = 'Panel1' Ctl3D = False
ParentCtl3D = False
BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
TabStop = True TabStop = True
OnClick = Panel1Click OnClick = Panel1Click
@ -122,6 +128,7 @@ object Form1: TForm1
OnMouseUp = Panel1MouseUp OnMouseUp = Panel1MouseUp
OnResize = Panel1Resize OnResize = Panel1Resize
OnMouseLeave = Panel1MouseLeave OnMouseLeave = Panel1MouseLeave
ShowCaption = False
end end
object chrmosr: TChromium object chrmosr: TChromium
OnTooltip = chrmosrTooltip OnTooltip = chrmosrTooltip

45
demos/SimpleOSRBrowser/uSimpleOSRBrowser.pas
View File

@ -52,6 +52,11 @@ uses
{$ENDIF} {$ENDIF}
uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uBufferPanel; uCEFChromium, uCEFTypes, uCEFInterfaces, uCEFConstants, uBufferPanel;
const
// Set this constant to True and load "file://transparency.html" to test a
// transparent browser.
TRANSPARENT_BROWSER = False;
type type
TForm1 = class(TForm) TForm1 = class(TForm)
NavControlPnl: TPanel; NavControlPnl: TPanel;
@ -107,6 +112,7 @@ type
procedure Timer1Timer(Sender: TObject); procedure Timer1Timer(Sender: TObject);
procedure SnapshotBtnEnter(Sender: TObject); procedure SnapshotBtnEnter(Sender: TObject);
procedure ComboBox1Enter(Sender: TObject); procedure ComboBox1Enter(Sender: TObject);
procedure Panel1PaintParentBkg(Sender: TObject);
protected protected
FPopUpBitmap : TBitmap; FPopUpBitmap : TBitmap;
@ -149,6 +155,8 @@ type
var var
Form1: TForm1; Form1: TForm1;
procedure CreateGlobalCEFApp;
implementation implementation
{$R *.dfm} {$R *.dfm}
@ -168,6 +176,20 @@ uses
// 3- chrmosr.OnBeforeClose is triggered because the internal browser was destroyed. // 3- chrmosr.OnBeforeClose is triggered because the internal browser was destroyed.
// Now we set FCanClose to True and send WM_CLOSE to the form. // Now we set FCanClose to True and send WM_CLOSE to the form.
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
// If you need transparency leave the GlobalCEFApp.BackgroundColor property
// with the default value or set the alpha channel to 0
if TRANSPARENT_BROWSER then
GlobalCEFApp.BackgroundColor := CefColorSetARGB($00, $FF, $FF, $FF)
else
GlobalCEFApp.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
end;
procedure TForm1.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean); procedure TForm1.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
var var
TempKeyEvent : TCefKeyEvent; TempKeyEvent : TCefKeyEvent;
@ -663,6 +685,8 @@ begin
FResizeCS := TCriticalSection.Create; FResizeCS := TCriticalSection.Create;
FIMECS := TCriticalSection.Create; FIMECS := TCriticalSection.Create;
Panel1.Transparent := TRANSPARENT_BROWSER;
InitializeLastClick; InitializeLastClick;
end; end;
@ -696,7 +720,11 @@ begin
end end
else else
begin begin
// opaque white background color // If you need transparency leave the chrmosr.Options.BackgroundColor property
// with the default value or set the alpha channel to 0
if TRANSPARENT_BROWSER then
chrmosr.Options.BackgroundColor := CefColorSetARGB($00, $FF, $FF, $FF)
else
chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF); chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF);
// The IME handler needs to be created when Panel1 has a valid handle // The IME handler needs to be created when Panel1 has a valid handle
@ -797,6 +825,21 @@ begin
end; end;
end; end;
procedure TForm1.Panel1PaintParentBkg(Sender: TObject);
begin
// This event should only be used if you enabled transparency in the browser
if TRANSPARENT_BROWSER then
begin
// This event should copy the background image into Panel1.Canvas
// The TBufferPanel uses "AlphaBlend" to draw the browser contents over
// this background image.
// For simplicity, we just paint it green.
Panel1.Canvas.Brush.Color := clGreen;
Panel1.Canvas.Brush.Style := bsSolid;
Panel1.Canvas.FillRect(Rect(0, 0, Panel1.Width, Panel1.Height));
end;
end;
procedure TForm1.Panel1Resize(Sender: TObject); procedure TForm1.Panel1Resize(Sender: TObject);
begin begin
DoResize; DoResize;

63
source/uBufferPanel.pas
View File

@ -52,7 +52,7 @@ uses
{$ELSE} {$ELSE}
{$IFDEF MSWINDOWS}Windows, imm, {$ENDIF} Classes, Forms, Controls, Graphics, {$IFDEF MSWINDOWS}Windows, imm, {$ENDIF} Classes, Forms, Controls, Graphics,
{$IFDEF FPC} {$IFDEF FPC}
LCLProc, LCLType, LCLIntf, LResources, LMessages, InterfaceBase, LCLProc, LCLType, LCLIntf, LResources, LMessages, InterfaceBase, Win32Extra,
{$ELSE} {$ELSE}
Messages, Messages,
{$ENDIF} {$ENDIF}
@ -70,6 +70,8 @@ type
FMutex : THandle; FMutex : THandle;
FBuffer : TBitmap; FBuffer : TBitmap;
FScanlineSize : integer; FScanlineSize : integer;
FTransparent : boolean;
FOnPaintParentBkg : TNotifyEvent;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
FIMEHandler : TCEFOSRIMEHandler; FIMEHandler : TCEFOSRIMEHandler;
FOnIMECancelComposition : TNotifyEvent; FOnIMECancelComposition : TNotifyEvent;
@ -86,11 +88,14 @@ type
function GetBufferWidth : integer; function GetBufferWidth : integer;
function GetBufferHeight : integer; function GetBufferHeight : integer;
procedure SetTransparent(aValue : boolean);
function CopyBuffer : boolean; function CopyBuffer : boolean;
function SaveBufferToFile(const aFilename : string) : boolean; function SaveBufferToFile(const aFilename : string) : boolean;
procedure Paint; override; procedure Paint; override;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
procedure CreateParams(var Params: TCreateParams); override;
procedure WndProc(var aMessage: TMessage); override; procedure WndProc(var aMessage: TMessage); override;
procedure WMEraseBkgnd(var aMessage : TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMEraseBkgnd(var aMessage : TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMIMEStartComp(var aMessage: TMessage); procedure WMIMEStartComp(var aMessage: TMessage);
@ -120,6 +125,7 @@ type
property BufferBits : pointer read GetBufferBits; property BufferBits : pointer read GetBufferBits;
property DockManager; property DockManager;
property Canvas;
published published
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
@ -127,6 +133,9 @@ type
property OnIMECommitText : TOnIMECommitTextEvent read FOnIMECommitText write FOnIMECommitText; property OnIMECommitText : TOnIMECommitTextEvent read FOnIMECommitText write FOnIMECommitText;
property OnIMESetComposition : TOnIMESetCompositionEvent read FOnIMESetComposition write FOnIMESetComposition; property OnIMESetComposition : TOnIMESetCompositionEvent read FOnIMESetComposition write FOnIMESetComposition;
{$ENDIF} {$ENDIF}
property OnPaintParentBkg : TNotifyEvent read FOnPaintParentBkg write FOnPaintParentBkg;
property Transparent : boolean read FTransparent write SetTransparent default False;
property Align; property Align;
property Alignment; property Alignment;
@ -233,6 +242,7 @@ begin
FMutex := 0; FMutex := 0;
FBuffer := nil; FBuffer := nil;
FTransparent := False;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
FIMEHandler := nil; FIMEHandler := nil;
@ -361,16 +371,38 @@ begin
end; end;
function TBufferPanel.CopyBuffer : boolean; function TBufferPanel.CopyBuffer : boolean;
var
TempFunction : TBlendFunction;
begin begin
Result := False; Result := False;
if BeginBufferDraw then if BeginBufferDraw then
try
if (FBuffer <> nil) then
begin begin
Result := (FBuffer <> nil) and if FTransparent then
BitBlt(Canvas.Handle, 0, 0, Width, Height, begin
// TODO : To avoid flickering we should be using another bitmap
// for the background image. We should blend "FBuffer" with the
// "background bitmap" and then blit the result to the canvas.
if assigned(FOnPaintParentBkg) then FOnPaintParentBkg(self);
TempFunction.BlendOp := AC_SRC_OVER;
TempFunction.BlendFlags := 0;
TempFunction.SourceConstantAlpha := 255;
TempFunction.AlphaFormat := AC_SRC_ALPHA;
Result := AlphaBlend(Canvas.Handle, 0, 0, Width, Height,
FBuffer.Canvas.Handle, 0, 0, FBuffer.Width, FBuffer.Height,
TempFunction);
end
else
Result := BitBlt(Canvas.Handle, 0, 0, Width, Height,
FBuffer.Canvas.Handle, 0, 0, FBuffer.Canvas.Handle, 0, 0,
SrcCopy); SrcCopy);
end;
finally
EndBufferDraw; EndBufferDraw;
end; end;
end; end;
@ -387,7 +419,7 @@ begin
Canvas.Rectangle(0, 0, Width, Height); Canvas.Rectangle(0, 0, Width, Height);
end end
else else
if not(CopyBuffer) then if not(CopyBuffer) and not(FTransparent) then
begin begin
Canvas.Brush.Color := Color; Canvas.Brush.Color := Color;
Canvas.Brush.Style := bsSolid; Canvas.Brush.Style := bsSolid;
@ -396,6 +428,14 @@ begin
end; end;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
procedure TBufferPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if FTransparent then
Params.ExStyle := Params.ExStyle and not WS_EX_TRANSPARENT;
end;
procedure TBufferPanel.WndProc(var aMessage: TMessage); procedure TBufferPanel.WndProc(var aMessage: TMessage);
begin begin
case aMessage.Msg of case aMessage.Msg of
@ -543,6 +583,18 @@ begin
Result := 0; Result := 0;
end; end;
procedure TBufferPanel.SetTransparent(aValue : boolean);
begin
if (FTransparent <> aValue) then
begin
FTransparent := aValue;
{$IFDEF MSWINDOWS}
RecreateWnd{$IFDEF FPC}(self){$ENDIF};
{$ENDIF}
end;
end;
procedure TBufferPanel.BufferDraw(x, y : integer; const aBitmap : TBitmap); procedure TBufferPanel.BufferDraw(x, y : integer; const aBitmap : TBitmap);
begin begin
if (FBuffer <> nil) then FBuffer.Canvas.Draw(x, y, aBitmap); if (FBuffer <> nil) then FBuffer.Canvas.Draw(x, y, aBitmap);
@ -563,6 +615,7 @@ begin
FBuffer.HandleType := bmDIB; FBuffer.HandleType := bmDIB;
FBuffer.Width := aWidth; FBuffer.Width := aWidth;
FBuffer.Height := aHeight; FBuffer.Height := aHeight;
FScanlineSize := FBuffer.Width * SizeOf(TRGBQuad); FScanlineSize := FBuffer.Width * SizeOf(TRGBQuad);
Result := True; Result := True;
end; end;

12
source/uCEFApplication.pas
View File

@ -59,7 +59,7 @@ uses
const const
CEF_SUPPORTED_VERSION_MAJOR = 3; CEF_SUPPORTED_VERSION_MAJOR = 3;
CEF_SUPPORTED_VERSION_MINOR = 3626; CEF_SUPPORTED_VERSION_MINOR = 3626;
CEF_SUPPORTED_VERSION_RELEASE = 1886; CEF_SUPPORTED_VERSION_RELEASE = 1891;
CEF_SUPPORTED_VERSION_BUILD = 0; CEF_SUPPORTED_VERSION_BUILD = 0;
CEF_CHROMEELF_VERSION_MAJOR = 72; CEF_CHROMEELF_VERSION_MAJOR = 72;
@ -114,6 +114,8 @@ type
FCustomCommandLines : TStringList; FCustomCommandLines : TStringList;
FCustomCommandLineValues : TStringList; FCustomCommandLineValues : TStringList;
FFlashEnabled : boolean; FFlashEnabled : boolean;
//FEnableMediaStream : boolean;
//FEnableSpeechInput : boolean;
FEnableGPU : boolean; FEnableGPU : boolean;
FCheckCEFFiles : boolean; FCheckCEFFiles : boolean;
FLibLoaded : boolean; FLibLoaded : boolean;
@ -352,6 +354,8 @@ type
property DeleteCache : boolean read FDeleteCache write FDeleteCache; property DeleteCache : boolean read FDeleteCache write FDeleteCache;
property DeleteCookies : boolean read FDeleteCookies write FDeleteCookies; property DeleteCookies : boolean read FDeleteCookies write FDeleteCookies;
property FlashEnabled : boolean read FFlashEnabled write FFlashEnabled; property FlashEnabled : boolean read FFlashEnabled write FFlashEnabled;
//property EnableMediaStream : boolean read FEnableMediaStream write FEnableMediaStream;
//property EnableSpeechInput : boolean read FEnableSpeechInput write FEnableSpeechInput;
property EnableGPU : boolean read FEnableGPU write FEnableGPU; property EnableGPU : boolean read FEnableGPU write FEnableGPU;
property CheckCEFFiles : boolean read FCheckCEFFiles write FCheckCEFFiles; property CheckCEFFiles : boolean read FCheckCEFFiles write FCheckCEFFiles;
property ShowMessageDlg : boolean read FShowMessageDlg write FShowMessageDlg; property ShowMessageDlg : boolean read FShowMessageDlg write FShowMessageDlg;
@ -524,6 +528,8 @@ begin
FDeleteCache := False; FDeleteCache := False;
FDeleteCookies := False; FDeleteCookies := False;
FFlashEnabled := True; FFlashEnabled := True;
//FEnableMediaStream := True;
//FEnableSpeechInput := True;
FEnableGPU := False; FEnableGPU := False;
FCustomCommandLines := nil; FCustomCommandLines := nil;
FCustomCommandLineValues := nil; FCustomCommandLineValues := nil;
@ -1474,6 +1480,10 @@ begin
commandLine.AppendSwitch('--enable-system-flash'); commandLine.AppendSwitch('--enable-system-flash');
end; end;
// These switches appear in the CEF3 source but they didn't seem to do anything in last tests
//
//commandLine.AppendSwitchWithValue('--enable-media-stream', IntToStr(Ord(FEnableMediaStream)));
//commandLine.AppendSwitchWithValue('--enable-speech-input', IntToStr(Ord(FEnableSpeechInput)));
if not(FEnableGPU) then if not(FEnableGPU) then
begin begin