diff --git a/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm b/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm index a5e46f9d..2b7ee251 100644 --- a/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm +++ b/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm @@ -270,7 +270,7 @@ object MiniBrowserFrm: TMiniBrowserFrm OnNavigationVisitorResultAvailable = Chromium1NavigationVisitorResultAvailable OnDownloadImageFinished = Chromium1DownloadImageFinished OnCookiesFlushed = Chromium1CookiesFlushed - OnExecuteTaskOnCefThread = Chromium1ExecuteTaskOnCefThread + OnZoomPctAvailable = Chromium1ZoomPctAvailable OnRenderCompMsg = Chromium1RenderCompMsg OnLoadEnd = Chromium1LoadEnd OnLoadError = Chromium1LoadError diff --git a/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas b/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas index 859fdd36..3d892f79 100644 --- a/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas +++ b/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas @@ -84,7 +84,6 @@ const MINIBROWSER_CONTEXTMENU_GETNAVIGATION = MENU_ID_USER_FIRST + 12; MINIBROWSER_CONTEXTMENU_MUTEAUDIO = MENU_ID_USER_FIRST + 13; MINIBROWSER_CONTEXTMENU_UNMUTEAUDIO = MENU_ID_USER_FIRST + 14; - MINIBROWSER_CONTEXTMENU_SHOWZOOMPCT = MENU_ID_USER_FIRST + 15; type TMiniBrowserFrm = class(TForm) @@ -234,9 +233,9 @@ type pluginUrl: ustring; isMainFrame: Boolean; const topOriginUrl: ustring; const pluginInfo: ICefWebPluginInfo; var pluginPolicy: TCefPluginPolicy; var aResult: Boolean); - procedure Chromium1ExecuteTaskOnCefThread(Sender: TObject; - aTaskID: Cardinal); procedure Acceptlanguage1Click(Sender: TObject); + procedure Chromium1ZoomPctAvailable(Sender: TObject; + const aZoomPct: Double); protected FResponse : TStringList; @@ -389,7 +388,6 @@ begin model.AddItem(MINIBROWSER_CONTEXTMENU_JSWRITEDOC, 'Modify HTML document'); model.AddItem(MINIBROWSER_CONTEXTMENU_JSPRINTDOC, 'Print using Javascript'); model.AddItem(MINIBROWSER_CONTEXTMENU_SHOWRESPONSE, 'Show server headers'); - model.AddItem(MINIBROWSER_CONTEXTMENU_SHOWZOOMPCT, 'Show ZoomPct'); if DevTools.Visible then model.AddItem(MINIBROWSER_CONTEXTMENU_HIDEDEVTOOLS, 'Hide DevTools') @@ -569,9 +567,6 @@ begin MINIBROWSER_CONTEXTMENU_MUTEAUDIO : Chromium1.AudioMuted := True; - - MINIBROWSER_CONTEXTMENU_SHOWZOOMPCT : - Chromium1.ExecuteTaskOnCefThread(TID_UI, 1); end; end; @@ -626,12 +621,6 @@ begin end; end; -procedure TMiniBrowserFrm.Chromium1ExecuteTaskOnCefThread(Sender: TObject; - aTaskID: Cardinal); -begin - ShowStatusText('ZoomPct : ' + floattostr(Chromium1.ZoomPct)); -end; - procedure TMiniBrowserFrm.Chromium1FullScreenModeChange(Sender: TObject; const browser: ICefBrowser; fullscreen: Boolean); begin @@ -996,6 +985,12 @@ begin caption := 'MiniBrowser'; end; +procedure TMiniBrowserFrm.Chromium1ZoomPctAvailable(Sender: TObject; + const aZoomPct: Double); +begin + ShowStatusText('Zoom : ' + floattostr(aZoomPct) + '%'); +end; + procedure TMiniBrowserFrm.Flushcookies1Click(Sender: TObject); begin if not(Chromium1.FlushCookieStore(False)) then diff --git a/demos/Lazarus/CookieVisitor/CookieVisitor.lps b/demos/Lazarus/CookieVisitor/CookieVisitor.lps index 109dbd88..d3c3831e 100644 --- a/demos/Lazarus/CookieVisitor/CookieVisitor.lps +++ b/demos/Lazarus/CookieVisitor/CookieVisitor.lps @@ -4,7 +4,7 @@ - + @@ -52,128 +52,135 @@ + + + + + + + + + + + + + + + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - - - - - - - - diff --git a/demos/Lazarus/MiniBrowser/MiniBrowser.lps b/demos/Lazarus/MiniBrowser/MiniBrowser.lps index 8079f0ad..21ea97c1 100644 --- a/demos/Lazarus/MiniBrowser/MiniBrowser.lps +++ b/demos/Lazarus/MiniBrowser/MiniBrowser.lps @@ -22,13 +22,13 @@ - - + + - + - + @@ -98,123 +98,123 @@ - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + diff --git a/demos/Lazarus/MiniBrowser/uMiniBrowser.lfm b/demos/Lazarus/MiniBrowser/uMiniBrowser.lfm index 16db2813..61c7cf39 100644 --- a/demos/Lazarus/MiniBrowser/uMiniBrowser.lfm +++ b/demos/Lazarus/MiniBrowser/uMiniBrowser.lfm @@ -245,6 +245,7 @@ object MiniBrowserFrm: TMiniBrowserFrm OnNavigationVisitorResultAvailable = Chromium1NavigationVisitorResultAvailable OnDownloadImageFinished = Chromium1DownloadImageFinished OnCookiesFlushed = Chromium1CookiesFlushed + OnZoomPctAvailable = Chromium1ZoomPctAvailable OnRenderCompMsg = Chromium1RenderCompMsg OnLoadEnd = Chromium1LoadEnd OnLoadError = Chromium1LoadError diff --git a/demos/Lazarus/MiniBrowser/uMiniBrowser.pas b/demos/Lazarus/MiniBrowser/uMiniBrowser.pas index 229f1f22..fcedada9 100644 --- a/demos/Lazarus/MiniBrowser/uMiniBrowser.pas +++ b/demos/Lazarus/MiniBrowser/uMiniBrowser.pas @@ -135,6 +135,8 @@ type procedure Chromium1CookiesFlushed(Sender: TObject); procedure Chromium1DownloadImageFinished(Sender: TObject; const imageUrl: ustring; httpStatusCode: Integer; const image: ICefImage); + procedure Chromium1ZoomPctAvailable(Sender: TObject; const aZoomPct: double + ); procedure FormShow(Sender: TObject); procedure BackBtnClick(Sender: TObject); procedure ForwardBtnClick(Sender: TObject); @@ -389,7 +391,7 @@ end; procedure TMiniBrowserFrm.Resetzoom1Click(Sender: TObject); begin - Chromium1.ResetZoomStep; + Chromium1.ResetZoomLevel; end; procedure TMiniBrowserFrm.Resolvehost1Click(Sender: TObject); @@ -1116,6 +1118,12 @@ begin end; end; +procedure TMiniBrowserFrm.Chromium1ZoomPctAvailable(Sender: TObject; + const aZoomPct: double); +begin + ShowStatusText('Zoom : ' + floattostr(aZoomPct) + '%'); +end; + procedure TMiniBrowserFrm.Timer1Timer(Sender: TObject); begin Timer1.Enabled := False; diff --git a/source/uCEFApplicationCore.pas b/source/uCEFApplicationCore.pas index f342be14..47d2122c 100644 --- a/source/uCEFApplicationCore.pas +++ b/source/uCEFApplicationCore.pas @@ -404,7 +404,7 @@ type property SitePerProcess : boolean read FSitePerProcess write FSitePerProcess; // --site-per-process property DisableWebSecurity : boolean read FDisableWebSecurity write FDisableWebSecurity; // --disable-web-security property DisablePDFExtension : boolean read FDisablePDFExtension write FDisablePDFExtension; // --disable-pdf-extension - property DisableSiteIsolationTrials : boolean read FDisableSiteIsolationTrials write FDisableSiteIsolationTrials; //--disable-site-isolation-trials + property DisableSiteIsolationTrials : boolean read FDisableSiteIsolationTrials write FDisableSiteIsolationTrials; // --disable-site-isolation-trials property DisableExtensions : boolean read FDisableExtensions write FDisableExtensions; // --disable-extensions property AutoplayPolicy : TCefAutoplayPolicy read FAutoplayPolicy write FAutoplayPolicy; // --autoplay-policy property DisableBackgroundNetworking : boolean read FDisableBackgroundNetworking write FDisableBackgroundNetworking; // --disable-background-networking diff --git a/source/uCEFChromiumCore.pas b/source/uCEFChromiumCore.pas index 6a91a188..301c1fa3 100644 --- a/source/uCEFChromiumCore.pas +++ b/source/uCEFChromiumCore.pas @@ -50,7 +50,7 @@ interface uses {$IFDEF DELPHI16_UP} - {$IFDEF MSWINDOWS}WinApi.Windows, WinApi.Messages, WinApi.ActiveX, WinApi.CommCtrl,{$ENDIF} System.Classes, + {$IFDEF MSWINDOWS}WinApi.Windows, WinApi.Messages, WinApi.ActiveX, WinApi.CommCtrl,{$ENDIF} System.Classes, System.SyncObjs, {$ELSE} {$IFDEF MSWINDOWS}Windows, ActiveX, CommCtrl,{$ENDIF} Classes, {$IFDEF FPC} @@ -58,6 +58,7 @@ uses {$ELSE} Messages, {$ENDIF} + SyncObjs, {$ENDIF} uCEFTypes, uCEFInterfaces, uCEFLibFunctions, uCEFMiscFunctions, uCEFClient, uCEFConstants, uCEFTask, uCEFDomVisitor, uCEFChromiumEvents, @@ -103,6 +104,7 @@ type FSpellChecking : boolean; FSpellCheckerDicts : ustring; FZoomStep : byte; + FZoomStepCS : TCriticalSection; FPrefsFileName : string; FIsOSR : boolean; FInitialized : boolean; @@ -262,6 +264,7 @@ type FOnCookiesVisited : TOnCookiesVisited; FOnCookieVisitorDestroyed : TOnCookieVisitorDestroyed; FOnCookieSet : TOnCookieSet; + FOnZoomPctAvailable : TOnZoomPctAvailable; {$IFDEF MSWINDOWS} FOnBrowserCompMsg : TOnCompMsgEvent; FOnWidgetCompMsg : TOnCompMsgEvent; @@ -280,6 +283,7 @@ type function GetDocumentURL : ustring; function GetZoomLevel : double; function GetZoomPct : double; + function GetZoomStep : byte; function GetIsPopUp : boolean; function GetWindowHandle : TCefWindowHandle; function GetWindowlessFrameRate : integer; @@ -359,21 +363,28 @@ type procedure HandleList(const aValue : ICefValue; var aResultSL : TStringList; const aRoot, aKey : string); procedure HandleInvalid(const aValue : ICefValue; var aResultSL : TStringList; const aRoot, aKey : string); + function ExecuteUpdateZoomStepTask(aInc : boolean) : boolean; + function ExecuteUpdateZoomPctTask(aInc : boolean) : boolean; + function ExecuteReadZoomTask : boolean; + function ExecuteSetZoomPctTask(const aValue : double) : boolean; + function ExecuteSetZoomLevelTask(const aValue : double) : boolean; + function ExecuteSetZoomStepTask(aValue : byte) : boolean; + + procedure UpdateHostZoomLevel(const aValue : double); + procedure UpdateHostZoomPct(const aValue : double); + + procedure DelayedDragging; + procedure InitializeWindowInfo(aParentHandle : TCefWindowHandle; aParentRect : TRect; const aWindowName : ustring); virtual; + procedure DefaultInitializeDevToolsWindowInfo(aDevToolsWnd: TCefWindowHandle; const aClientRect: TRect; const aWindowName: ustring); + {$IFDEF MSWINDOWS} procedure PrefsAvailableMsg(var aMessage : TMessage); function SendCompMessage(aMsg : cardinal; wParam : cardinal = 0; lParam : integer = 0) : boolean; procedure ToMouseEvent(grfKeyState : Longint; pt : TPoint; var aMouseEvent : TCefMouseEvent); - {$ENDIF} - procedure ApplyZoomStep; - procedure DelayedDragging; - - procedure InitializeWindowInfo(aParentHandle : TCefWindowHandle; aParentRect : TRect; const aWindowName : ustring); virtual; - procedure DefaultInitializeDevToolsWindowInfo(aDevToolsWnd: TCefWindowHandle; const aClientRect: TRect; const aWindowName: ustring); - {$IFDEF MSWINDOWS} procedure WndProc(var aMessage: TMessage); procedure CreateStub(const aMethod : TWndMethod; var aStub : Pointer); procedure FreeAndNilStub(var aStub : pointer); - function InstallCompWndProc(aWnd: THandle; aStub: Pointer): TFNWndProc; + function InstallCompWndProc(aWnd: THandle; aStub: Pointer): TFNWndProc; procedure RestoreCompWndProc(var aOldWnd: THandle; aNewWnd: THandle; var aProc: TFNWndProc); procedure CallOldCompWndProc(aProc: TFNWndProc; aWnd: THandle; var aMessage: TMessage); procedure BrowserCompWndProc(var aMessage: TMessage); @@ -516,6 +527,12 @@ type procedure doOnCookiesVisited(const name_, value, domain, path: ustring; secure, httponly, hasExpires: Boolean; const creation, lastAccess, expires: TDateTime; count, total, aID : Integer; var aDeleteCookie, aResult : Boolean); virtual; procedure doOnCookieVisitorDestroyed(aID : integer); virtual; procedure doOnCookieSet(aSuccess : boolean; aID : integer); virtual; + procedure doUpdateZoomStep(aInc : boolean); virtual; + procedure doUpdateZoomPct(aInc : boolean); virtual; + procedure doReadZoom; virtual; + procedure doSetZoomLevel(const aValue : double); virtual; + procedure doSetZoomPct(const aValue : double); virtual; + procedure doSetZoomStep(aValue : byte); virtual; function MustCreateLoadHandler : boolean; virtual; function MustCreateFocusHandler : boolean; virtual; function MustCreateContextMenuHandler : boolean; virtual; @@ -616,7 +633,12 @@ type procedure IncZoomStep; procedure DecZoomStep; + procedure IncZoomPct; + procedure DecZoomPct; procedure ResetZoomStep; + procedure ResetZoomLevel; + procedure ResetZoomPct; + procedure ReadZoom; procedure WasResized; procedure WasHidden(hidden: Boolean); @@ -689,7 +711,7 @@ type property DocumentURL : ustring read GetDocumentURL; property ZoomLevel : double read GetZoomLevel write SetZoomLevel; property ZoomPct : double read GetZoomPct write SetZoomPct; - property ZoomStep : byte read FZoomStep write SetZoomStep; + property ZoomStep : byte read GetZoomStep write SetZoomStep; property WindowlessFrameRate : integer read GetWindowlessFrameRate write SetWindowlessFrameRate; property CustomHeaderName : ustring read FCustomHeaderName write SetCustomHeaderName; property CustomHeaderValue : ustring read FCustomHeaderValue write SetCustomHeaderValue; @@ -740,6 +762,7 @@ type property OnCookiesVisited : TOnCookiesVisited read FOnCookiesVisited write FOnCookiesVisited; property OnCookieVisitorDestroyed : TOnCookieVisitorDestroyed read FOnCookieVisitorDestroyed write FOnCookieVisitorDestroyed; property OnCookieSet : TOnCookieSet read FOnCookieSet write FOnCookieSet; + property OnZoomPctAvailable : TOnZoomPctAvailable read FOnZoomPctAvailable write FOnZoomPctAvailable; {$IFDEF MSWINDOWS} property OnBrowserCompMsg : TOnCompMsgEvent read FOnBrowserCompMsg write FOnBrowserCompMsg; property OnWidgetCompMsg : TOnCompMsgEvent read FOnWidgetCompMsg write FOnWidgetCompMsg; @@ -930,6 +953,7 @@ begin FSpellChecking := True; FSpellCheckerDicts := ''; FZoomStep := ZOOM_STEP_DEF; + FZoomStepCS := nil; FSafeSearch := False; FYouTubeRestrict := YOUTUBE_RESTRICT_OFF; FPrintingEnabled := True; @@ -998,6 +1022,7 @@ begin if (FFontOptions <> nil) then FreeAndNil(FFontOptions); if (FOptions <> nil) then FreeAndNil(FOptions); if (FPDFPrintOptions <> nil) then FreeAndNil(FPDFPrintOptions); + if (FZoomStepCS <> nil) then FreeAndNil(FZoomStepCS); except on e : exception do if CustomExceptionHandler('TChromiumCore.Destroy', e) then raise; @@ -1224,6 +1249,7 @@ begin FOptions := TChromiumOptions.Create; FFontOptions := TChromiumFontOptions.Create; FPDFPrintOptions := TPDFPrintOptions.Create; + FZoomStepCS := TCriticalSection.Create; end; except on e : exception do @@ -1388,6 +1414,7 @@ begin FOnCookiesVisited := nil; FOnCookieVisitorDestroyed := nil; FOnCookieSet := nil; + FOnZoomPctAvailable := nil; {$IFDEF MSWINDOWS} FOnBrowserCompMsg := nil; @@ -2198,75 +2225,213 @@ begin if Initialized then Result := FBrowser.Host.ZoomLevel; end; -procedure TChromiumCore.SetZoomLevel(const aValue : double); -begin - if Initialized then FBrowser.Host.ZoomLevel := aValue; -end; - function TChromiumCore.GetZoomPct : double; begin Result := power(1.2, ZoomLevel) * 100; end; -procedure TChromiumCore.SetZoomPct(const aValue : double); +function TChromiumCore.GetZoomStep : byte; begin - if Initialized and (aValue > 0) then ZoomLevel := LogN(1.2, aValue / 100); + Result := ZOOM_STEP_DEF; + + if (FZoomStepCS <> nil) then + try + FZoomStepCS.Acquire; + Result := FZoomStep; + finally + FZoomStepCS.Release; + end; end; -procedure TChromiumCore.ApplyZoomStep; +procedure TChromiumCore.SetZoomLevel(const aValue : double); begin - case FZoomStep of - ZOOM_STEP_25 : ZoomPct := 25; - ZOOM_STEP_33 : ZoomPct := 33; - ZOOM_STEP_50 : ZoomPct := 50; - ZOOM_STEP_67 : ZoomPct := 67; - ZOOM_STEP_75 : ZoomPct := 75; - ZOOM_STEP_90 : ZoomPct := 90; - ZOOM_STEP_100 : ZoomPct := 100; - ZOOM_STEP_110 : ZoomPct := 110; - ZOOM_STEP_125 : ZoomPct := 125; - ZOOM_STEP_150 : ZoomPct := 150; - ZOOM_STEP_175 : ZoomPct := 175; - ZOOM_STEP_200 : ZoomPct := 200; - ZOOM_STEP_250 : ZoomPct := 250; - ZOOM_STEP_300 : ZoomPct := 300; - ZOOM_STEP_400 : ZoomPct := 400; - ZOOM_STEP_500 : ZoomPct := 500; - end; + if CefCurrentlyOn(TID_UI) then + doSetZoomLevel(aValue) + else + ExecuteSetZoomLevelTask(aValue); +end; + +procedure TChromiumCore.SetZoomPct(const aValue : double); +begin + if CefCurrentlyOn(TID_UI) then + doSetZoomPct(aValue) + else + ExecuteSetZoomPctTask(aValue); end; procedure TChromiumCore.SetZoomStep(aValue : byte); begin - if Initialized and (aValue in [ZOOM_STEP_MIN..ZOOM_STEP_MAX]) then - begin - FZoomStep := aValue; - ApplyZoomStep; - end; + if CefCurrentlyOn(TID_UI) then + doSetZoomStep(aValue) + else + ExecuteSetZoomStepTask(aValue); end; +// Increments the Zoom Step value and triggers the TChromium.OnZoomPctAvailable event with the new value procedure TChromiumCore.IncZoomStep; begin - if Initialized and (FZoomStep < ZOOM_STEP_MAX) then - begin - inc(FZoomStep); - ApplyZoomStep; - end; + if CefCurrentlyOn(TID_UI) then + doUpdateZoomStep(True) + else + ExecuteUpdateZoomStepTask(True); end; +// Decrements the Zoom Step value and triggers the TChromium.OnZoomPctAvailable event with the new value procedure TChromiumCore.DecZoomStep; begin - if Initialized and (FZoomStep > ZOOM_STEP_MIN) then - begin - dec(FZoomStep); - ApplyZoomStep; - end; + if CefCurrentlyOn(TID_UI) then + doUpdateZoomStep(False) + else + ExecuteUpdateZoomStepTask(False); end; +// Increments the Zoom Percent value and triggers the TChromium.OnZoomPctAvailable event with the new value +procedure TChromiumCore.IncZoomPct; +begin + if CefCurrentlyOn(TID_UI) then + doUpdateZoomPct(True) + else + ExecuteUpdateZoomPctTask(True); +end; + +// Decrements the Zoom Percent value and triggers the TChromium.OnZoomPctAvailable event with the new value +procedure TChromiumCore.DecZoomPct; +begin + if CefCurrentlyOn(TID_UI) then + doUpdateZoomPct(False) + else + ExecuteUpdateZoomPctTask(False); +end; + +// Sets the Zoom Step to the default value and triggers the TChromium.OnZoomPctAvailable event procedure TChromiumCore.ResetZoomStep; begin ZoomStep := ZOOM_STEP_DEF; end; +// Sets the Zoom Level to the default value and triggers the TChromium.OnZoomPctAvailable event +procedure TChromiumCore.ResetZoomLevel; +begin + ZoomLevel := 0; +end; + +// Sets the Zoom Percent to the default value and triggers the TChromium.OnZoomPctAvailable event +procedure TChromiumCore.ResetZoomPct; +begin + ZoomPct := ZoomStepValues[ZOOM_STEP_DEF]; +end; + +// Triggers the TChromium.OnZoomPctAvailable event with the current Zoom Percent value +procedure TChromiumCore.ReadZoom; +begin + if CefCurrentlyOn(TID_UI) then + doReadZoom + else + ExecuteReadZoomTask; +end; + +function TChromiumCore.ExecuteUpdateZoomStepTask(aInc : boolean) : boolean; +var + TempTask : ICefTask; +begin + Result := False; + + try + if Initialized then + begin + TempTask := TCefUpdateZoomStepTask.Create(self, aInc); + Result := CefPostTask(TID_UI, TempTask); + end; + finally + TempTask := nil; + end; +end; + +function TChromiumCore.ExecuteUpdateZoomPctTask(aInc : boolean) : boolean; +var + TempTask : ICefTask; +begin + Result := False; + + try + if Initialized then + begin + TempTask := TCefUpdateZoomPctTask.Create(self, aInc); + Result := CefPostTask(TID_UI, TempTask); + end; + finally + TempTask := nil; + end; +end; + +function TChromiumCore.ExecuteReadZoomTask : boolean; +var + TempTask : ICefTask; +begin + Result := False; + + try + if Initialized then + begin + TempTask := TCefReadZoomTask.Create(self); + Result := CefPostTask(TID_UI, TempTask); + end; + finally + TempTask := nil; + end; +end; + +function TChromiumCore.ExecuteSetZoomPctTask(const aValue : double) : boolean; +var + TempTask : ICefTask; +begin + Result := False; + + try + if Initialized then + begin + TempTask := TCefSetZoomPctTask.Create(self, aValue); + Result := CefPostTask(TID_UI, TempTask); + end; + finally + TempTask := nil; + end; +end; + +function TChromiumCore.ExecuteSetZoomLevelTask(const aValue : double) : boolean; +var + TempTask : ICefTask; +begin + Result := False; + + try + if Initialized then + begin + TempTask := TCefSetZoomLevelTask.Create(self, aValue); + Result := CefPostTask(TID_UI, TempTask); + end; + finally + TempTask := nil; + end; +end; + +function TChromiumCore.ExecuteSetZoomStepTask(aValue : byte) : boolean; +var + TempTask : ICefTask; +begin + Result := False; + + try + if Initialized then + begin + TempTask := TCefSetZoomStepTask.Create(self, aValue); + Result := CefPostTask(TID_UI, TempTask); + end; + finally + TempTask := nil; + end; +end; + procedure TChromiumCore.SetDoNotTrack(aValue : boolean); begin if (FDoNotTrack <> aValue) then @@ -2389,6 +2554,16 @@ begin CreateReqContextHandler; end; +procedure TChromiumCore.UpdateHostZoomLevel(const aValue : double); +begin + if Initialized then FBrowser.Host.ZoomLevel := aValue; +end; + +procedure TChromiumCore.UpdateHostZoomPct(const aValue : double); +begin + if (aValue > 0) then UpdateHostZoomLevel(LogN(1.2, aValue / 100)); +end; + procedure TChromiumCore.SetWebRTCIPHandlingPolicy(aValue : TCefWebRTCHandlingPolicy); begin if (FWebRTCIPHandlingPolicy <> aValue) then @@ -3606,6 +3781,185 @@ begin if assigned(FOnCookieSet) then FOnCookieSet(self, aSuccess, aID); end; +procedure TChromiumCore.doUpdateZoomStep(aInc : boolean); +var + TempPct, TempPrev, TempNext : double; + i : integer; +begin + if not(Initialized) or (FZoomStepCS = nil) then exit; + + try + FZoomStepCS.Acquire; + + if (FZoomStep in [ZOOM_STEP_MIN..ZOOM_STEP_MAX]) then + begin + if aInc then + begin + if (FZoomStep < ZOOM_STEP_MAX) then + begin + inc(FZoomStep); + UpdateHostZoomPct(ZoomStepValues[FZoomStep]); + end; + end + else + if (FZoomStep > ZOOM_STEP_MIN) then + begin + dec(FZoomStep); + UpdateHostZoomPct(ZoomStepValues[FZoomStep]); + end; + end + else + begin + TempPct := ZoomPct; + TempPrev := 0; + i := ZOOM_STEP_MIN; + + repeat + if (i <= ZOOM_STEP_MAX) then + TempNext := ZoomStepValues[i] + else + TempNext := ZoomStepValues[ZOOM_STEP_MAX] * 2; + + if (TempPct > TempPrev) and (TempPct < TempNext) then + begin + if aInc then + begin + if (i <= ZOOM_STEP_MAX) then + begin + FZoomStep := i; + UpdateHostZoomPct(ZoomStepValues[FZoomStep]); + end; + end + else + if (i > ZOOM_STEP_MIN) then + begin + FZoomStep := pred(i); + UpdateHostZoomPct(ZoomStepValues[FZoomStep]); + end; + + i := ZOOM_STEP_MAX + 2; + end + else + begin + TempPrev := TempNext; + inc(i); + end; + + until (i > succ(ZOOM_STEP_MAX)); + end; + finally + FZoomStepCS.Release; + + if assigned(FOnZoomPctAvailable) then FOnZoomPctAvailable(self, ZoomPct); + end; +end; + +procedure TChromiumCore.doUpdateZoomPct(aInc : boolean); +var + TempNewZoom : double; + i : integer; +begin + if not(Initialized) or (FZoomStepCS = nil) then exit; + + TempNewZoom := ZoomPct; + + try + FZoomStepCS.Acquire; + + if aInc then + TempNewZoom := min(TempNewZoom + ZOOM_PCT_DELTA, ZoomStepValues[ZOOM_STEP_MAX]) + else + TempNewZoom := max(TempNewZoom - ZOOM_PCT_DELTA, ZoomStepValues[ZOOM_STEP_MIN]); + + for i := ZOOM_STEP_MIN to ZOOM_STEP_MAX do + if (TempNewZoom = ZoomStepValues[i]) then break; + + FZoomStep := i; + UpdateHostZoomPct(TempNewZoom); + finally + FZoomStepCS.Release; + + if assigned(FOnZoomPctAvailable) then FOnZoomPctAvailable(self, TempNewZoom); + end; +end; + +procedure TChromiumCore.doReadZoom; +begin + if Initialized and assigned(FOnZoomPctAvailable) then + FOnZoomPctAvailable(self, ZoomPct); +end; + +procedure TChromiumCore.doSetZoomLevel(const aValue : double); +var + TempZoom : double; + i : integer; +begin + if not(Initialized) or (FZoomStepCS = nil) then exit; + + try + FZoomStepCS.Acquire; + + UpdateHostZoomLevel(aValue); + TempZoom := ZoomPct; + + for i := ZOOM_STEP_MIN to ZOOM_STEP_MAX do + if (TempZoom = ZoomStepValues[i]) then break; + + FZoomStep := i; + finally + FZoomStepCS.Release; + + if assigned(FOnZoomPctAvailable) then FOnZoomPctAvailable(self, ZoomPct); + end; +end; + +procedure TChromiumCore.doSetZoomPct(const aValue : double); +var + TempZoom : double; + i : integer; +begin + if not(Initialized) or (FZoomStepCS = nil) then exit; + + try + FZoomStepCS.Acquire; + + if (aValue >= ZoomStepValues[ZOOM_STEP_MIN]) and + (aValue <= ZoomStepValues[ZOOM_STEP_MAX]) then + begin + UpdateHostZoomPct(aValue); + TempZoom := ZoomPct; + + for i := ZOOM_STEP_MIN to ZOOM_STEP_MAX do + if (TempZoom = ZoomStepValues[i]) then break; + + FZoomStep := i; + end; + finally + FZoomStepCS.Release; + + if assigned(FOnZoomPctAvailable) then FOnZoomPctAvailable(self, ZoomPct); + end; +end; + +procedure TChromiumCore.doSetZoomStep(aValue : byte); +begin + if not(Initialized) or (FZoomStepCS = nil) then exit; + + try + FZoomStepCS.Acquire; + + if (aValue in [ZOOM_STEP_MIN..ZOOM_STEP_MAX]) then + begin + FZoomStep := aValue; + UpdateHostZoomPct(ZoomStepValues[aValue]); + end; + finally + FZoomStepCS.Release; + + if assigned(FOnZoomPctAvailable) then FOnZoomPctAvailable(self, ZoomPct); + end; +end; + function TChromiumCore.MustCreateLoadHandler : boolean; begin Result := assigned(FOnLoadStart) or diff --git a/source/uCEFChromiumEvents.pas b/source/uCEFChromiumEvents.pas index 6b725817..6b45727b 100644 --- a/source/uCEFChromiumEvents.pas +++ b/source/uCEFChromiumEvents.pas @@ -178,6 +178,7 @@ type TOnCookiesVisited = procedure(Sender: TObject; const name_, value, domain, path: ustring; secure, httponly, hasExpires: Boolean; const creation, lastAccess, expires: TDateTime; count, total, aID : Integer; var aDeleteCookie, aResult : Boolean) of object; TOnCookieVisitorDestroyed = procedure(Sender: TObject; aID : integer) of object; TOnCookieSet = procedure(Sender: TObject; aSuccess : boolean; aID : integer) of object; + TOnZoomPctAvailable = procedure(Sender: TObject; const aZoomPct : double) of object; {$IFDEF MSWINDOWS} TOnCompMsgEvent = procedure(var aMessage: TMessage; var aHandled: Boolean) of object; {$ENDIF} diff --git a/source/uCEFConstants.pas b/source/uCEFConstants.pas index d861df5b..94514041 100644 --- a/source/uCEFConstants.pas +++ b/source/uCEFConstants.pas @@ -567,10 +567,15 @@ const ZOOM_STEP_300 = 13; ZOOM_STEP_400 = 14; ZOOM_STEP_500 = 15; + ZOOM_STEP_UNK = 16; ZOOM_STEP_MIN = ZOOM_STEP_25; ZOOM_STEP_MAX = ZOOM_STEP_500; ZOOM_STEP_DEF = ZOOM_STEP_100; + ZOOM_PCT_DELTA = 5; + + ZoomStepValues : array[ZOOM_STEP_MIN..ZOOM_STEP_MAX] of integer = (25, 33, 50, 67, 75, 90, 100, 110, 125, 150, 175, 200, 250, 300, 400, 500); + {$IFDEF MSWINDOWS} CEF_PREFERENCES_SAVED = WM_APP + $A00; CEF_DOONCLOSE = WM_APP + $A01; diff --git a/source/uCEFInterfaces.pas b/source/uCEFInterfaces.pas index 8623582d..2748c71d 100644 --- a/source/uCEFInterfaces.pas +++ b/source/uCEFInterfaces.pas @@ -397,6 +397,12 @@ type procedure doOnCookiesVisited(const name_, value, domain, path: ustring; secure, httponly, hasExpires: Boolean; const creation, lastAccess, expires: TDateTime; count, total, aID : Integer; var aDeleteCookie, aResult : Boolean); procedure doOnCookieVisitorDestroyed(aID : integer); procedure doOnCookieSet(aSuccess : boolean; aID : integer); + procedure doUpdateZoomStep(aInc : boolean); + procedure doUpdateZoomPct(aInc : boolean); + procedure doSetZoomLevel(const aValue : double); + procedure doSetZoomPct(const aValue : double); + procedure doSetZoomStep(aValue : byte); + procedure doReadZoom; function MustCreateLoadHandler : boolean; function MustCreateFocusHandler : boolean; function MustCreateContextMenuHandler : boolean; diff --git a/source/uCEFTask.pas b/source/uCEFTask.pas index a14580f9..1f4d534f 100644 --- a/source/uCEFTask.pas +++ b/source/uCEFTask.pas @@ -125,6 +125,77 @@ type destructor Destroy; override; end; + TCefUpdateZoomStepTask = class(TCefTaskOwn) + protected + FEvents : Pointer; + FInc : boolean; + + procedure Execute; override; + + public + constructor Create(const aEvents : IChromiumEvents; aInc : boolean); reintroduce; + destructor Destroy; override; + end; + + TCefUpdateZoomPctTask = class(TCefTaskOwn) + protected + FEvents : Pointer; + FInc : boolean; + + procedure Execute; override; + + public + constructor Create(const aEvents : IChromiumEvents; aInc : boolean); reintroduce; + destructor Destroy; override; + end; + + TCefReadZoomTask = class(TCefTaskOwn) + protected + FEvents : Pointer; + + procedure Execute; override; + + public + constructor Create(const aEvents : IChromiumEvents); reintroduce; + destructor Destroy; override; + end; + + TCefSetZoomLevelTask = class(TCefTaskOwn) + protected + FEvents : Pointer; + FValue : double; + + procedure Execute; override; + + public + constructor Create(const aEvents : IChromiumEvents; const aValue : double); reintroduce; + destructor Destroy; override; + end; + + TCefSetZoomPctTask = class(TCefTaskOwn) + protected + FEvents : Pointer; + FValue : double; + + procedure Execute; override; + + public + constructor Create(const aEvents : IChromiumEvents; const aValue : double); reintroduce; + destructor Destroy; override; + end; + + TCefSetZoomStepTask = class(TCefTaskOwn) + protected + FEvents : Pointer; + FValue : byte; + + procedure Execute; override; + + public + constructor Create(const aEvents : IChromiumEvents; aValue : byte); reintroduce; + destructor Destroy; override; + end; + implementation uses @@ -327,4 +398,201 @@ begin inherited Destroy; end; + + +// TCefUpdateZoomStepTask + +procedure TCefUpdateZoomStepTask.Execute; +begin + try + try + if (FEvents <> nil) then IChromiumEvents(FEvents).doUpdateZoomStep(FInc); + except + on e : exception do + if CustomExceptionHandler('TCefUpdateZoomStepTask.Execute', e) then raise; + end; + finally + FEvents := nil; + end; +end; + +constructor TCefUpdateZoomStepTask.Create(const aEvents : IChromiumEvents; aInc : boolean); +begin + inherited Create; + + FEvents := Pointer(aEvents); + FInc := aInc; +end; + +destructor TCefUpdateZoomStepTask.Destroy; +begin + FEvents := nil; + + inherited Destroy; +end; + + + +// TCefUpdateZoomPctTask + +procedure TCefUpdateZoomPctTask.Execute; +begin + try + try + if (FEvents <> nil) then IChromiumEvents(FEvents).doUpdateZoomPct(FInc); + except + on e : exception do + if CustomExceptionHandler('TCefUpdateZoomPctTask.Execute', e) then raise; + end; + finally + FEvents := nil; + end; +end; + +constructor TCefUpdateZoomPctTask.Create(const aEvents : IChromiumEvents; aInc : boolean); +begin + inherited Create; + + FEvents := Pointer(aEvents); + FInc := aInc; +end; + +destructor TCefUpdateZoomPctTask.Destroy; +begin + FEvents := nil; + + inherited Destroy; +end; + + + +// TCefReadZoomTask + +procedure TCefReadZoomTask.Execute; +begin + try + try + if (FEvents <> nil) then IChromiumEvents(FEvents).doReadZoom; + except + on e : exception do + if CustomExceptionHandler('TCefReadZoomTask.Execute', e) then raise; + end; + finally + FEvents := nil; + end; +end; + +constructor TCefReadZoomTask.Create(const aEvents : IChromiumEvents); +begin + inherited Create; + + FEvents := Pointer(aEvents); +end; + +destructor TCefReadZoomTask.Destroy; +begin + FEvents := nil; + + inherited Destroy; +end; + + + +// TCefSetZoomLevelTask + +procedure TCefSetZoomLevelTask.Execute; +begin + try + try + if (FEvents <> nil) then IChromiumEvents(FEvents).doSetZoomLevel(FValue); + except + on e : exception do + if CustomExceptionHandler('TCefSetZoomLevelTask.Execute', e) then raise; + end; + finally + FEvents := nil; + end; +end; + +constructor TCefSetZoomLevelTask.Create(const aEvents : IChromiumEvents; const aValue : double); +begin + inherited Create; + + FEvents := Pointer(aEvents); + FValue := aValue; +end; + +destructor TCefSetZoomLevelTask.Destroy; +begin + FEvents := nil; + + inherited Destroy; +end; + + + +// TCefSetZoomPctTask + +procedure TCefSetZoomPctTask.Execute; +begin + try + try + if (FEvents <> nil) then IChromiumEvents(FEvents).doSetZoomPct(FValue); + except + on e : exception do + if CustomExceptionHandler('TCefSetZoomPctTask.Execute', e) then raise; + end; + finally + FEvents := nil; + end; +end; + +constructor TCefSetZoomPctTask.Create(const aEvents : IChromiumEvents; const aValue : double); +begin + inherited Create; + + FEvents := Pointer(aEvents); + FValue := aValue; +end; + +destructor TCefSetZoomPctTask.Destroy; +begin + FEvents := nil; + + inherited Destroy; +end; + + + +// TCefSetZoomStepTask + +procedure TCefSetZoomStepTask.Execute; +begin + try + try + if (FEvents <> nil) then IChromiumEvents(FEvents).doSetZoomStep(FValue); + except + on e : exception do + if CustomExceptionHandler('TCefSetZoomStepTask.Execute', e) then raise; + end; + finally + FEvents := nil; + end; +end; + +constructor TCefSetZoomStepTask.Create(const aEvents : IChromiumEvents; aValue : byte); +begin + inherited Create; + + FEvents := Pointer(aEvents); + FValue := aValue; +end; + +destructor TCefSetZoomStepTask.Destroy; +begin + FEvents := nil; + + inherited Destroy; +end; + end. diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index 6e99f42e..39b6aed3 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,7 +2,7 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 73, + "InternalVersion" : 74, "Name" : "cef4delphi_lazarus.lpk", "Version" : "78.3.9.0" }