Delphi/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-11-16 00:05:55 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Subclass CEF windows only once

Browse Source
This commit is contained in:
Salvador Díaz Fau 2018-04-02 14:53:03 +02:00
parent e5b1ceb5fd
commit 6c034fac25
2 changed files with 179 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
source/uCEFChromium.pas
View File

@ -105,9 +105,10 @@ type
FWebRTCIPHandlingPolicy : TCefWebRTCHandlingPolicy; FWebRTCIPHandlingPolicy : TCefWebRTCHandlingPolicy;
FWebRTCMultipleRoutes : TCefState; FWebRTCMultipleRoutes : TCefState;
FWebRTCNonProxiedUDP : TCefState; FWebRTCNonProxiedUDP : TCefState;
FOldBrowserCompWndPrc : Pointer;
FOldWidgetCompWndPrc : Pointer; FOldBrowserCompWndPrc : TFNWndProc;
FOldRenderCompWndPrc : Pointer; FOldWidgetCompWndPrc : TFNWndProc;
FOldRenderCompWndPrc : TFNWndProc;
FBrowserCompHWND : THandle; FBrowserCompHWND : THandle;
FWidgetCompHWND : THandle; FWidgetCompHWND : THandle;
FRenderCompHWND : THandle; FRenderCompHWND : THandle;
@ -315,8 +316,10 @@ type
procedure DelayedDragging; procedure DelayedDragging;
function SendCompMessage(aMsg : cardinal; wParam : cardinal = 0; lParam : integer = 0) : boolean; function SendCompMessage(aMsg : cardinal; wParam : cardinal = 0; lParam : integer = 0) : boolean;
procedure ToMouseEvent(grfKeyState : Longint; pt : TPoint; var aMouseEvent : TCefMouseEvent); procedure ToMouseEvent(grfKeyState : Longint; pt : TPoint; var aMouseEvent : TCefMouseEvent);
procedure WndProc(var aMessage: TMessage); procedure FreeAndNilStub(var aStub : pointer);
procedure CreateStub(const aMethod : TWndMethod; var aStub : Pointer);
procedure WndProc(var aMessage: TMessage);
procedure BrowserCompWndProc(var aMessage: TMessage); procedure BrowserCompWndProc(var aMessage: TMessage);
procedure WidgetCompWndProc(var aMessage: TMessage); procedure WidgetCompWndProc(var aMessage: TMessage);
procedure RenderCompWndProc(var aMessage: TMessage); procedure RenderCompWndProc(var aMessage: TMessage);
@ -804,25 +807,22 @@ begin
if (FBrowserCompHWND <> 0) and (FOldBrowserCompWndPrc <> nil) then if (FBrowserCompHWND <> 0) and (FOldBrowserCompWndPrc <> nil) then
begin begin
SetWindowLongPtr(FBrowserCompHWND, GWL_WNDPROC, NativeInt(FOldBrowserCompWndPrc)); SetWindowLongPtr(FBrowserCompHWND, GWL_WNDPROC, NativeInt(FOldBrowserCompWndPrc));
FreeObjectInstance(FBrowserCompStub); FreeAndNilStub(FBrowserCompStub);
FOldBrowserCompWndPrc := nil; FOldBrowserCompWndPrc := nil;
FBrowserCompStub := nil;
end; end;
if (FWidgetCompHWND <> 0) and (FOldWidgetCompWndPrc <> nil) then if (FWidgetCompHWND <> 0) and (FOldWidgetCompWndPrc <> nil) then
begin begin
SetWindowLongPtr(FWidgetCompHWND, GWL_WNDPROC, NativeInt(FOldWidgetCompWndPrc)); SetWindowLongPtr(FWidgetCompHWND, GWL_WNDPROC, NativeInt(FOldWidgetCompWndPrc));
FreeObjectInstance(FWidgetCompStub); FreeAndNilStub(FWidgetCompStub);
FOldWidgetCompWndPrc := nil; FOldWidgetCompWndPrc := nil;
FWidgetCompStub := nil;
end; end;
if (FRenderCompHWND <> 0) and (FOldRenderCompWndPrc <> nil) then if (FRenderCompHWND <> 0) and (FOldRenderCompWndPrc <> nil) then
begin begin
SetWindowLongPtr(FRenderCompHWND, GWL_WNDPROC, NativeInt(FOldRenderCompWndPrc)); SetWindowLongPtr(FRenderCompHWND, GWL_WNDPROC, NativeInt(FOldRenderCompWndPrc));
FreeObjectInstance(FRenderCompStub); FreeAndNilStub(FRenderCompStub);
FOldRenderCompWndPrc := nil; FOldRenderCompWndPrc := nil;
FRenderCompStub := nil;
end; end;
DestroyClientHandler; DestroyClientHandler;
@ -836,6 +836,20 @@ begin
FBrowserId := 0; FBrowserId := 0;
end; end;
procedure TChromium.CreateStub(const aMethod : TWndMethod; var aStub : Pointer);
begin
if (aStub = nil) then aStub := MakeObjectInstance(aMethod);
end;
procedure TChromium.FreeAndNilStub(var aStub : pointer);
begin
if (aStub <> nil) then
begin
FreeObjectInstance(aStub);
aStub := nil;
end;
end;
procedure TChromium.DestroyClientHandler; procedure TChromium.DestroyClientHandler;
begin begin
try try
@ -2838,6 +2852,7 @@ procedure TChromium.BrowserCompWndProc(var aMessage: TMessage);
var var
TempHandled : boolean; TempHandled : boolean;
begin begin
try
TempHandled := False; TempHandled := False;
if assigned(FOnBrowserCompMsg) then if assigned(FOnBrowserCompMsg) then
@ -2851,12 +2866,17 @@ begin
aMessage.Msg, aMessage.Msg,
aMessage.wParam, aMessage.wParam,
aMessage.lParam); aMessage.lParam);
except
on e : exception do
if CustomExceptionHandler('TChromium.BrowserCompWndProc', e) then raise;
end;
end; end;
procedure TChromium.WidgetCompWndProc(var aMessage: TMessage); procedure TChromium.WidgetCompWndProc(var aMessage: TMessage);
var var
TempHandled : boolean; TempHandled : boolean;
begin begin
try
TempHandled := False; TempHandled := False;
if assigned(FOnWidgetCompMsg) then if assigned(FOnWidgetCompMsg) then
@ -2870,12 +2890,17 @@ begin
aMessage.Msg, aMessage.Msg,
aMessage.wParam, aMessage.wParam,
aMessage.lParam); aMessage.lParam);
except
on e : exception do
if CustomExceptionHandler('TChromium.WidgetCompWndProc', e) then raise;
end;
end; end;
procedure TChromium.RenderCompWndProc(var aMessage: TMessage); procedure TChromium.RenderCompWndProc(var aMessage: TMessage);
var var
TempHandled : boolean; TempHandled : boolean;
begin begin
try
TempHandled := False; TempHandled := False;
if assigned(FOnRenderCompMsg) then if assigned(FOnRenderCompMsg) then
@ -2889,6 +2914,10 @@ begin
aMessage.Msg, aMessage.Msg,
aMessage.wParam, aMessage.wParam,
aMessage.lParam); aMessage.lParam);
except
on e : exception do
if CustomExceptionHandler('TChromium.RenderCompWndProc', e) then raise;
end;
end; end;
function TChromium.doOnClose(const browser: ICefBrowser): Boolean; function TChromium.doOnClose(const browser: ICefBrowser): Boolean;
@ -3389,7 +3418,8 @@ end;
procedure TChromium.doOnRenderViewReady(const browser: ICefBrowser); procedure TChromium.doOnRenderViewReady(const browser: ICefBrowser);
begin begin
if (browser <> nil) and if (browser <> nil) and
(browser.Host <> nil) then (browser.Host <> nil) and
(browser.Identifier = FBrowserId) then
begin begin
FBrowserCompHWND := browser.Host.WindowHandle; FBrowserCompHWND := browser.Host.WindowHandle;
@ -3399,26 +3429,26 @@ begin
if (FWidgetCompHWND <> 0) then if (FWidgetCompHWND <> 0) then
FRenderCompHWND := FindWindowEx(FWidgetCompHWND, 0, 'Chrome_RenderWidgetHostHWND', 'Chrome Legacy Window'); FRenderCompHWND := FindWindowEx(FWidgetCompHWND, 0, 'Chrome_RenderWidgetHostHWND', 'Chrome Legacy Window');
if assigned(FOnBrowserCompMsg) and (FBrowserCompHWND <> 0) then if assigned(FOnBrowserCompMsg) and (FBrowserCompHWND <> 0) and (FOldBrowserCompWndPrc = nil) then
begin begin
FBrowserCompStub := MakeObjectInstance(BrowserCompWndProc); CreateStub(BrowserCompWndProc, FBrowserCompStub);
FOldBrowserCompWndPrc := Pointer(SetWindowLongPtr(FBrowserCompHWND, FOldBrowserCompWndPrc := TFNWndProc(SetWindowLongPtr(FBrowserCompHWND,
GWL_WNDPROC, GWL_WNDPROC,
NativeInt(FBrowserCompStub))); NativeInt(FBrowserCompStub)));
end; end;
if assigned(FOnWidgetCompMsg) and (FWidgetCompHWND <> 0) then if assigned(FOnWidgetCompMsg) and (FWidgetCompHWND <> 0) and (FOldWidgetCompWndPrc = nil) then
begin begin
FWidgetCompStub := MakeObjectInstance(WidgetCompWndProc); CreateStub(WidgetCompWndProc, FWidgetCompStub);
FOldWidgetCompWndPrc := Pointer(SetWindowLongPtr(FWidgetCompHWND, FOldWidgetCompWndPrc := TFNWndProc(SetWindowLongPtr(FWidgetCompHWND,
GWL_WNDPROC, GWL_WNDPROC,
NativeInt(FWidgetCompStub))); NativeInt(FWidgetCompStub)));
end; end;
if assigned(FOnRenderCompMsg) and (FRenderCompHWND <> 0) then if assigned(FOnRenderCompMsg) and (FRenderCompHWND <> 0) and (FOldRenderCompWndPrc = nil) then
begin begin
FRenderCompStub := MakeObjectInstance(RenderCompWndProc); CreateStub(RenderCompWndProc, FRenderCompStub);
FOldRenderCompWndPrc := Pointer(SetWindowLongPtr(FRenderCompHWND, FOldRenderCompWndPrc := TFNWndProc(SetWindowLongPtr(FRenderCompHWND,
GWL_WNDPROC, GWL_WNDPROC,
NativeInt(FRenderCompStub))); NativeInt(FRenderCompStub)));
end; end;

68
source/uFMXChromium.pas
View File

@ -101,10 +101,11 @@ type
FWebRTCIPHandlingPolicy : TCefWebRTCHandlingPolicy; FWebRTCIPHandlingPolicy : TCefWebRTCHandlingPolicy;
FWebRTCMultipleRoutes : TCefState; FWebRTCMultipleRoutes : TCefState;
FWebRTCNonProxiedUDP : TCefState; FWebRTCNonProxiedUDP : TCefState;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
FOldBrowserCompWndPrc : Pointer; FOldBrowserCompWndPrc : TFNWndProc;
FOldWidgetCompWndPrc : Pointer; FOldWidgetCompWndPrc : TFNWndProc;
FOldRenderCompWndPrc : Pointer; FOldRenderCompWndPrc : TFNWndProc;
FBrowserCompHWND : THandle; FBrowserCompHWND : THandle;
FWidgetCompHWND : THandle; FWidgetCompHWND : THandle;
FRenderCompHWND : THandle; FRenderCompHWND : THandle;
@ -310,6 +311,8 @@ type
function GetParentForm : TCustomForm; function GetParentForm : TCustomForm;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
procedure FreeAndNilStub(var aStub : pointer);
procedure CreateStub(const aMethod : TWndMethod; var aStub : Pointer);
procedure BrowserCompWndProc(var aMessage: TMessage); procedure BrowserCompWndProc(var aMessage: TMessage);
procedure WidgetCompWndProc(var aMessage: TMessage); procedure WidgetCompWndProc(var aMessage: TMessage);
procedure RenderCompWndProc(var aMessage: TMessage); procedure RenderCompWndProc(var aMessage: TMessage);
@ -772,25 +775,22 @@ begin
if (FBrowserCompHWND <> 0) and (FOldBrowserCompWndPrc <> nil) then if (FBrowserCompHWND <> 0) and (FOldBrowserCompWndPrc <> nil) then
begin begin
SetWindowLongPtr(FBrowserCompHWND, GWL_WNDPROC, NativeInt(FOldBrowserCompWndPrc)); SetWindowLongPtr(FBrowserCompHWND, GWL_WNDPROC, NativeInt(FOldBrowserCompWndPrc));
FreeObjectInstance(FBrowserCompStub); FreeAndNilStub(FBrowserCompStub);
FOldBrowserCompWndPrc := nil; FOldBrowserCompWndPrc := nil;
FBrowserCompStub := nil;
end; end;
if (FWidgetCompHWND <> 0) and (FOldWidgetCompWndPrc <> nil) then if (FWidgetCompHWND <> 0) and (FOldWidgetCompWndPrc <> nil) then
begin begin
SetWindowLongPtr(FWidgetCompHWND, GWL_WNDPROC, NativeInt(FOldWidgetCompWndPrc)); SetWindowLongPtr(FWidgetCompHWND, GWL_WNDPROC, NativeInt(FOldWidgetCompWndPrc));
FreeObjectInstance(FWidgetCompStub); FreeAndNilStub(FWidgetCompStub);
FOldWidgetCompWndPrc := nil; FOldWidgetCompWndPrc := nil;
FWidgetCompStub := nil;
end; end;
if (FRenderCompHWND <> 0) and (FOldRenderCompWndPrc <> nil) then if (FRenderCompHWND <> 0) and (FOldRenderCompWndPrc <> nil) then
begin begin
SetWindowLongPtr(FRenderCompHWND, GWL_WNDPROC, NativeInt(FOldRenderCompWndPrc)); SetWindowLongPtr(FRenderCompHWND, GWL_WNDPROC, NativeInt(FOldRenderCompWndPrc));
FreeObjectInstance(FRenderCompStub); FreeAndNilStub(FRenderCompStub);
FOldRenderCompWndPrc := nil; FOldRenderCompWndPrc := nil;
FRenderCompStub := nil;
end; end;
{$ENDIF} {$ENDIF}
@ -3048,7 +3048,8 @@ procedure TFMXChromium.doOnRenderViewReady(const browser: ICefBrowser);
begin begin
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
if (browser <> nil) and if (browser <> nil) and
(browser.Host <> nil) then (browser.Host <> nil) and
(browser.Identifier = FBrowserId) then
begin begin
FBrowserCompHWND := browser.Host.WindowHandle; FBrowserCompHWND := browser.Host.WindowHandle;
@ -3058,26 +3059,26 @@ begin
if (FWidgetCompHWND <> 0) then if (FWidgetCompHWND <> 0) then
FRenderCompHWND := FindWindowEx(FWidgetCompHWND, 0, 'Chrome_RenderWidgetHostHWND', 'Chrome Legacy Window'); FRenderCompHWND := FindWindowEx(FWidgetCompHWND, 0, 'Chrome_RenderWidgetHostHWND', 'Chrome Legacy Window');
if assigned(FOnBrowserCompMsg) and (FBrowserCompHWND <> 0) then if assigned(FOnBrowserCompMsg) and (FBrowserCompHWND <> 0) and (FOldBrowserCompWndPrc = nil) then
begin begin
FBrowserCompStub := MakeObjectInstance(BrowserCompWndProc); CreateStub(BrowserCompWndProc, FBrowserCompStub);
FOldBrowserCompWndPrc := Pointer(SetWindowLongPtr(FBrowserCompHWND, FOldBrowserCompWndPrc := TFNWndProc(SetWindowLongPtr(FBrowserCompHWND,
GWL_WNDPROC, GWL_WNDPROC,
NativeInt(FBrowserCompStub))); NativeInt(FBrowserCompStub)));
end; end;
if assigned(FOnWidgetCompMsg) and (FWidgetCompHWND <> 0) then if assigned(FOnWidgetCompMsg) and (FWidgetCompHWND <> 0) and (FOldWidgetCompWndPrc = nil) then
begin begin
FWidgetCompStub := MakeObjectInstance(WidgetCompWndProc); CreateStub(WidgetCompWndProc, FWidgetCompStub);
FOldWidgetCompWndPrc := Pointer(SetWindowLongPtr(FWidgetCompHWND, FOldWidgetCompWndPrc := TFNWndProc(SetWindowLongPtr(FWidgetCompHWND,
GWL_WNDPROC, GWL_WNDPROC,
NativeInt(FWidgetCompStub))); NativeInt(FWidgetCompStub)));
end; end;
if assigned(FOnRenderCompMsg) and (FRenderCompHWND <> 0) then if assigned(FOnRenderCompMsg) and (FRenderCompHWND <> 0) and (FOldRenderCompWndPrc = nil) then
begin begin
FRenderCompStub := MakeObjectInstance(RenderCompWndProc); CreateStub(RenderCompWndProc, FRenderCompStub);
FOldRenderCompWndPrc := Pointer(SetWindowLongPtr(FRenderCompHWND, FOldRenderCompWndPrc := TFNWndProc(SetWindowLongPtr(FRenderCompHWND,
GWL_WNDPROC, GWL_WNDPROC,
NativeInt(FRenderCompStub))); NativeInt(FRenderCompStub)));
end; end;
@ -3207,10 +3208,25 @@ begin
end; end;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
procedure TFMXChromium.CreateStub(const aMethod : TWndMethod; var aStub : Pointer);
begin
if (aStub = nil) then aStub := MakeObjectInstance(aMethod);
end;
procedure TFMXChromium.FreeAndNilStub(var aStub : pointer);
begin
if (aStub <> nil) then
begin
FreeObjectInstance(aStub);
aStub := nil;
end;
end;
procedure TFMXChromium.BrowserCompWndProc(var aMessage: TMessage); procedure TFMXChromium.BrowserCompWndProc(var aMessage: TMessage);
var var
TempHandled : boolean; TempHandled : boolean;
begin begin
try
TempHandled := False; TempHandled := False;
if assigned(FOnBrowserCompMsg) then if assigned(FOnBrowserCompMsg) then
@ -3224,12 +3240,17 @@ begin
aMessage.Msg, aMessage.Msg,
aMessage.wParam, aMessage.wParam,
aMessage.lParam); aMessage.lParam);
except
on e : exception do
if CustomExceptionHandler('TFMXChromium.BrowserCompWndProc', e) then raise;
end;
end; end;
procedure TFMXChromium.WidgetCompWndProc(var aMessage: TMessage); procedure TFMXChromium.WidgetCompWndProc(var aMessage: TMessage);
var var
TempHandled : boolean; TempHandled : boolean;
begin begin
try
TempHandled := False; TempHandled := False;
if assigned(FOnWidgetCompMsg) then if assigned(FOnWidgetCompMsg) then
@ -3243,12 +3264,17 @@ begin
aMessage.Msg, aMessage.Msg,
aMessage.wParam, aMessage.wParam,
aMessage.lParam); aMessage.lParam);
except
on e : exception do
if CustomExceptionHandler('TFMXChromium.WidgetCompWndProc', e) then raise;
end;
end; end;
procedure TFMXChromium.RenderCompWndProc(var aMessage: TMessage); procedure TFMXChromium.RenderCompWndProc(var aMessage: TMessage);
var var
TempHandled : boolean; TempHandled : boolean;
begin begin
try
TempHandled := False; TempHandled := False;
if assigned(FOnRenderCompMsg) then if assigned(FOnRenderCompMsg) then
@ -3262,6 +3288,10 @@ begin
aMessage.Msg, aMessage.Msg,
aMessage.wParam, aMessage.wParam,
aMessage.lParam); aMessage.lParam);
except
on e : exception do
if CustomExceptionHandler('TFMXChromium.RenderCompWndProc', e) then raise;
end;
end; end;
{$ENDIF} {$ENDIF}