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}
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.WindowlessRenderingEnabled := True;
GlobalCEFApp.EnableHighDPISupport := True;
CreateGlobalCEFApp;
if GlobalCEFApp.StartMainProcess then
begin
@ -69,6 +67,5 @@ begin
Application.Run;
end;
GlobalCEFApp.Free;
GlobalCEFApp := nil;
DestroyGlobalCEFApp;
end.

19
demos/SimpleOSRBrowser/uSimpleOSRBrowser.dfm
View File

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

45
demos/SimpleOSRBrowser/uSimpleOSRBrowser.pas
View File

@ -52,6 +52,11 @@ uses
{$ENDIF}
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
TForm1 = class(TForm)
NavControlPnl: TPanel;
@ -107,6 +112,7 @@ type
procedure Timer1Timer(Sender: TObject);
procedure SnapshotBtnEnter(Sender: TObject);
procedure ComboBox1Enter(Sender: TObject);
procedure Panel1PaintParentBkg(Sender: TObject);
protected
FPopUpBitmap : TBitmap;
@ -149,6 +155,8 @@ type
var
Form1: TForm1;
procedure CreateGlobalCEFApp;
implementation
{$R *.dfm}
@ -168,6 +176,20 @@ uses
// 3- chrmosr.OnBeforeClose is triggered because the internal browser was destroyed.
// 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);
var
TempKeyEvent : TCefKeyEvent;
@ -663,6 +685,8 @@ begin
FResizeCS := TCriticalSection.Create;
FIMECS := TCriticalSection.Create;
Panel1.Transparent := TRANSPARENT_BROWSER;
InitializeLastClick;
end;
@ -696,7 +720,11 @@ begin
end
else
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);
// The IME handler needs to be created when Panel1 has a valid handle
@ -797,6 +825,21 @@ begin
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);
begin
DoResize;

63
source/uBufferPanel.pas
View File

@ -52,7 +52,7 @@ uses
{$ELSE}
{$IFDEF MSWINDOWS}Windows, imm, {$ENDIF} Classes, Forms, Controls, Graphics,
{$IFDEF FPC}
LCLProc, LCLType, LCLIntf, LResources, LMessages, InterfaceBase,
LCLProc, LCLType, LCLIntf, LResources, LMessages, InterfaceBase, Win32Extra,
{$ELSE}
Messages,
{$ENDIF}
@ -70,6 +70,8 @@ type
FMutex : THandle;
FBuffer : TBitmap;
FScanlineSize : integer;
FTransparent : boolean;
FOnPaintParentBkg : TNotifyEvent;
{$IFDEF MSWINDOWS}
FIMEHandler : TCEFOSRIMEHandler;
FOnIMECancelComposition : TNotifyEvent;
@ -86,11 +88,14 @@ type
function GetBufferWidth : integer;
function GetBufferHeight : integer;
procedure SetTransparent(aValue : boolean);
function CopyBuffer : boolean;
function SaveBufferToFile(const aFilename : string) : boolean;
procedure Paint; override;
{$IFDEF MSWINDOWS}
procedure CreateParams(var Params: TCreateParams); override;
procedure WndProc(var aMessage: TMessage); override;
procedure WMEraseBkgnd(var aMessage : TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMIMEStartComp(var aMessage: TMessage);
@ -120,6 +125,7 @@ type
property BufferBits : pointer read GetBufferBits;
property DockManager;
property Canvas;
published
{$IFDEF MSWINDOWS}
@ -127,6 +133,9 @@ type
property OnIMECommitText : TOnIMECommitTextEvent read FOnIMECommitText write FOnIMECommitText;
property OnIMESetComposition : TOnIMESetCompositionEvent read FOnIMESetComposition write FOnIMESetComposition;
{$ENDIF}
property OnPaintParentBkg : TNotifyEvent read FOnPaintParentBkg write FOnPaintParentBkg;
property Transparent : boolean read FTransparent write SetTransparent default False;
property Align;
property Alignment;
@ -233,6 +242,7 @@ begin
FMutex := 0;
FBuffer := nil;
FTransparent := False;
{$IFDEF MSWINDOWS}
FIMEHandler := nil;
@ -361,16 +371,38 @@ begin
end;
function TBufferPanel.CopyBuffer : boolean;
var
TempFunction : TBlendFunction;
begin
Result := False;
if BeginBufferDraw then
try
if (FBuffer <> nil) then
begin
Result := (FBuffer <> nil) and
BitBlt(Canvas.Handle, 0, 0, Width, Height,
if FTransparent then
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,
SrcCopy);
end;
finally
EndBufferDraw;
end;
end;
@ -387,7 +419,7 @@ begin
Canvas.Rectangle(0, 0, Width, Height);
end
else
if not(CopyBuffer) then
if not(CopyBuffer) and not(FTransparent) then
begin
Canvas.Brush.Color := Color;
Canvas.Brush.Style := bsSolid;
@ -396,6 +428,14 @@ begin
end;
{$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);
begin
case aMessage.Msg of
@ -543,6 +583,18 @@ begin
Result := 0;
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);
begin
if (FBuffer <> nil) then FBuffer.Canvas.Draw(x, y, aBitmap);
@ -563,6 +615,7 @@ begin
FBuffer.HandleType := bmDIB;
FBuffer.Width := aWidth;
FBuffer.Height := aHeight;
FScanlineSize := FBuffer.Width * SizeOf(TRGBQuad);
Result := True;
end;

12
source/uCEFApplication.pas
View File

@ -59,7 +59,7 @@ uses
const
CEF_SUPPORTED_VERSION_MAJOR = 3;
CEF_SUPPORTED_VERSION_MINOR = 3626;
CEF_SUPPORTED_VERSION_RELEASE = 1886;
CEF_SUPPORTED_VERSION_RELEASE = 1891;
CEF_SUPPORTED_VERSION_BUILD = 0;
CEF_CHROMEELF_VERSION_MAJOR = 72;
@ -114,6 +114,8 @@ type
FCustomCommandLines : TStringList;
FCustomCommandLineValues : TStringList;
FFlashEnabled : boolean;
//FEnableMediaStream : boolean;
//FEnableSpeechInput : boolean;
FEnableGPU : boolean;
FCheckCEFFiles : boolean;
FLibLoaded : boolean;
@ -352,6 +354,8 @@ type
property DeleteCache : boolean read FDeleteCache write FDeleteCache;
property DeleteCookies : boolean read FDeleteCookies write FDeleteCookies;
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 CheckCEFFiles : boolean read FCheckCEFFiles write FCheckCEFFiles;
property ShowMessageDlg : boolean read FShowMessageDlg write FShowMessageDlg;
@ -524,6 +528,8 @@ begin
FDeleteCache := False;
FDeleteCookies := False;
FFlashEnabled := True;
//FEnableMediaStream := True;
//FEnableSpeechInput := True;
FEnableGPU := False;
FCustomCommandLines := nil;
FCustomCommandLineValues := nil;
@ -1474,6 +1480,10 @@ begin
commandLine.AppendSwitch('--enable-system-flash');
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
begin