diff --git a/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx b/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx index 5b87152b..76cee7d3 100644 --- a/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx +++ b/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx @@ -8,8 +8,10 @@ object SimpleFMXBrowserFrm: TSimpleFMXBrowserFrm FormFactor.Width = 320 FormFactor.Height = 480 FormFactor.Devices = [Desktop] + OnActivate = FormActivate OnCreate = FormCreate OnCloseQuery = FormCloseQuery + OnDeactivate = FormDeactivate OnResize = FormResize OnShow = FormShow DesignerMasterStyle = 0 @@ -27,22 +29,44 @@ object SimpleFMXBrowserFrm: TSimpleFMXBrowserFrm object AddressEdt: TEdit Touch.InteractiveGestures = [LongTap, DoubleTap] Align = Client - TabOrder = 1 + TabOrder = 0 Text = 'https://www.google.com' - Size.Width = 871.000000000000000000 + Size.Width = 825.000000000000000000 Size.Height = 25.000000000000000000 Size.PlatformDefault = False end - object GoBtn: TButton + object Panel1: TPanel Align = Right - Position.X = 876.000000000000000000 + Padding.Left = 5.000000000000000000 + Position.X = 830.000000000000000000 Position.Y = 5.000000000000000000 - Size.Width = 36.000000000000000000 + Size.Width = 82.000000000000000000 Size.Height = 25.000000000000000000 Size.PlatformDefault = False - TabOrder = 0 - Text = 'Go' - OnClick = GoBtnClick + TabOrder = 2 + object GoBtn: TButton + Align = Left + Position.X = 5.000000000000000000 + Size.Width = 36.000000000000000000 + Size.Height = 25.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + Text = 'Go' + OnClick = GoBtnClick + end + object Button1: TButton + Align = Right + StyledSettings = [Style, FontColor] + Position.X = 46.000000000000000000 + Size.Width = 36.000000000000000000 + Size.Height = 25.000000000000000000 + Size.PlatformDefault = False + TabOrder = 2 + Text = #181 + TextSettings.Font.Family = 'Webdings' + TextSettings.Font.Size = 24.000000000000000000 + OnClick = Button1Click + end end end object Timer1: TTimer @@ -52,6 +76,10 @@ object SimpleFMXBrowserFrm: TSimpleFMXBrowserFrm Left = 40 Top = 129 end + object SaveDialog1: TSaveDialog + Left = 40 + Top = 192 + end object FMXChromium1: TFMXChromium OnBeforeContextMenu = FMXChromium1BeforeContextMenu OnContextMenuCommand = FMXChromium1ContextMenuCommand diff --git a/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas b/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas index e85591ad..e13f6973 100644 --- a/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas +++ b/demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas @@ -57,9 +57,12 @@ interface TSimpleFMXBrowserFrm = class(TForm) AddressPnl: TPanel; AddressEdt: TEdit; - GoBtn: TButton; FMXChromium1: TFMXChromium; Timer1: TTimer; + Panel1: TPanel; + GoBtn: TButton; + Button1: TButton; + SaveDialog1: TSaveDialog; procedure GoBtnClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormCreate(Sender: TObject); @@ -88,19 +91,32 @@ TSimpleFMXBrowserFrm = class(TForm) const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer; eventFlags: Cardinal; out Result: Boolean); + procedure Button1Click(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormDeactivate(Sender: TObject); protected // Variables to control when can we destroy the form safely FCanClose : boolean; // Set to True in TFMXChromium.OnBeforeClose FClosing : boolean; // Set to True in the CloseQuery event. + // This is a workaround for the issue #253 + // https://github.com/salvadordf/CEF4Delphi/issues/253 + FOldWindowState : TWindowState; + FMXWindowParent : TFMXWindowParent; + function GetCurrentWindowState : TWindowState; + procedure LoadURL; procedure ResizeChild; procedure CreateFMXWindowParent; + procedure ShowFMXWindowParent; + function GetFMXWindowParentRect : System.Types.TRect; function PostCustomMessage(aMessage : cardinal; wParam : cardinal = 0; lParam : integer = 0) : boolean; + property CurrentWindowState : TWindowState read GetCurrentWindowState; + public procedure DoBrowserCreated; procedure DoDestroyParent; @@ -240,6 +256,52 @@ function TSimpleFMXBrowserFrm.PostCustomMessage(aMessage, wParam : cardinal; lPa {$ENDIF} end; +function TSimpleFMXBrowserFrm.GetCurrentWindowState : TWindowState; +var + TempPlacement : TWindowPlacement; + TempHWND : HWND; +begin + // TForm.WindowState is not updated correctly in FMX forms and + // it's not possible to receive WM_SIZE with SIZE_RESTORED so have to + // call the GetWindowPlacement function and handle the form state changes manually. + + Result := TWindowState.wsNormal; + TempHWND := FmxHandleToHWND(Handle); + + ZeroMemory(@TempPlacement, SizeOf(TWindowPlacement)); + TempPlacement.Length := SizeOf(TWindowPlacement); + + if GetWindowPlacement(TempHWND, @TempPlacement) then + case TempPlacement.showCmd of + SW_SHOWMAXIMIZED : Result := TWindowState.wsMaximized; + SW_SHOWMINIMIZED : Result := TWindowState.wsMinimized; + end; +end; + +procedure TSimpleFMXBrowserFrm.FormActivate(Sender: TObject); +var + TempState : TWindowState; +begin + // This is a workaround for the issue #253 + // https://github.com/salvadordf/CEF4Delphi/issues/253 + TempState := CurrentWindowState; + + if (FOldWindowState <> TempState) then + begin + if (FOldWindowState = TWindowState.wsMinimized) then + ShowFMXWindowParent; + + FOldWindowState := TempState; + end; +end; + +procedure TSimpleFMXBrowserFrm.FormDeactivate(Sender: TObject); +begin + // This is a workaround for the issue #253 + // https://github.com/salvadordf/CEF4Delphi/issues/253 + FOldWindowState := CurrentWindowState; +end; + procedure TSimpleFMXBrowserFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := FCanClose; @@ -260,6 +322,7 @@ procedure TSimpleFMXBrowserFrm.FormCreate(Sender: TObject); FCanClose := False; FClosing := False; FMXWindowParent := nil; + FOldWindowState := TWindowState.wsNormal; end; procedure TSimpleFMXBrowserFrm.FormResize(Sender: TObject); @@ -268,10 +331,40 @@ procedure TSimpleFMXBrowserFrm.FormResize(Sender: TObject); ResizeChild; end; +function TSimpleFMXBrowserFrm.GetFMXWindowParentRect : System.Types.TRect; +begin + Result.Left := 0; + Result.Top := round(AddressPnl.Height); + Result.Right := ClientWidth - 1; + Result.Bottom := ClientHeight - 1; +end; + procedure TSimpleFMXBrowserFrm.ResizeChild; begin if (FMXWindowParent <> nil) then - FMXWindowParent.SetBounds(0, round(AddressPnl.Height), ClientWidth - 1, ClientHeight - 1); + FMXWindowParent.SetBounds(GetFMXWindowParentRect); +end; + +procedure TSimpleFMXBrowserFrm.Button1Click(Sender: TObject); +var + TempBitmap : TBitmap; +begin + TempBitmap := nil; + + try + SaveDialog1.DefaultExt := 'bmp'; + SaveDialog1.Filter := 'Bitmap files (*.bmp)|*.BMP'; + + if SaveDialog1.Execute and (length(SaveDialog1.FileName) > 0) then + begin + TempBitmap := TBitmap.Create; + + if FMXChromium1.TakeSnapshot(TempBitmap, GetFMXWindowParentRect) then + TempBitmap.SaveToFile(SaveDialog1.FileName); + end; + finally + if (TempBitmap <> nil) then FreeAndNil(TempBitmap); + end; end; procedure TSimpleFMXBrowserFrm.CreateFMXWindowParent; @@ -364,6 +457,13 @@ procedure TSimpleFMXBrowserFrm.DoDestroyParent; if (FMXWindowParent <> nil) then FreeAndNil(FMXWindowParent); end; +procedure TSimpleFMXBrowserFrm.ShowFMXWindowParent; +begin + // This is a workaround for the issue #253 + // https://github.com/salvadordf/CEF4Delphi/issues/253 + if (FMXWindowParent <> nil) then FMXWindowParent.Show; +end; + procedure TSimpleFMXBrowserFrm.LoadURL; begin FMXChromium1.LoadURL(AddressEdt.Text); diff --git a/source/uCEFChromium.pas b/source/uCEFChromium.pas index a5410262..145b1670 100644 --- a/source/uCEFChromium.pas +++ b/source/uCEFChromium.pas @@ -83,6 +83,7 @@ TChromium = class(TChromiumCore) procedure SetFormTopTo(const y : Integer); function CreateBrowser(const aBrowserParent : TWinControl = nil; const aWindowName : ustring = ''; const aContext : ICefRequestContext = nil; const aExtraInfo : ICefDictionaryValue = nil) : boolean; overload; virtual; + function SaveAsBitmapStream(var aStream : TStream) : boolean; function TakeSnapshot(var aBitmap : TBitmap) : boolean; end; @@ -289,10 +290,34 @@ function TChromium.CreateBrowser(const aBrowserParent : TWinControl; Result := inherited CreateBrowser(TempHandle, TempRect, aWindowName, aContext, aExtraInfo); end; +function TChromium.SaveAsBitmapStream(var aStream : TStream) : boolean; +{$IFDEF MSWINDOWS} +var + TempDC : HDC; + TempRect : TRect; +{$ENDIF} +begin + Result := False; + + {$IFDEF MSWINDOWS} + if not(FIsOSR) and (FRenderCompHWND <> 0) and (aStream <> nil) then + begin + TempDC := GetDC(FRenderCompHWND); + + if (TempDC <> 0) then + try + GetClientRect(FRenderCompHWND, TempRect); + Result := CopyDCToBitmapStream(TempDC, TempRect, aStream); + finally + ReleaseDC(FRenderCompHWND, TempDC); + end; + end; + {$ENDIF} +end; + function TChromium.TakeSnapshot(var aBitmap : TBitmap) : boolean; {$IFDEF MSWINDOWS} var - TempHWND : HWND; TempDC : HDC; TempRect : TRect; TempWidth : Integer; @@ -302,30 +327,29 @@ function TChromium.TakeSnapshot(var aBitmap : TBitmap) : boolean; Result := False; {$IFDEF MSWINDOWS} - if not(FIsOSR) then + if not(FIsOSR) and (FRenderCompHWND <> 0) then begin - TempHWND := GetWindowHandle; + GetClientRect(FRenderCompHWND, TempRect); + + TempWidth := TempRect.Right - TempRect.Left; + TempHeight := TempRect.Bottom - TempRect.Top; - if (TempHWND <> 0) then - begin - GetClientRect(TempHWND, TempRect); + if (TempWidth <= 0) or (TempHeight <= 0) then exit; - TempWidth := TempRect.Right - TempRect.Left; - TempHeight := TempRect.Bottom - TempRect.Top; + if (aBitmap <> nil) then FreeAndNil(aBitmap); - if (aBitmap <> nil) then FreeAndNil(aBitmap); + aBitmap := TBitmap.Create; + aBitmap.Height := TempHeight; + aBitmap.Width := TempWidth; - aBitmap := TBitmap.Create; - aBitmap.Height := TempHeight; - aBitmap.Width := TempWidth; + TempDC := GetDC(FRenderCompHWND); - TempDC := GetDC(TempHWND); - try - Result := BitBlt(aBitmap.Canvas.Handle, 0, 0, TempWidth, TempHeight, - TempDC, 0, 0, SRCCOPY); - finally - ReleaseDC(TempHWND, TempDC); - end; + if (TempDC <> 0) then + try + Result := BitBlt(aBitmap.Canvas.Handle, 0, 0, TempWidth, TempHeight, + TempDC, 0, 0, SRCCOPY); + finally + ReleaseDC(FRenderCompHWND, TempDC); end; end; {$ENDIF} diff --git a/source/uCEFChromiumCore.pas b/source/uCEFChromiumCore.pas index b039298b..5b9cd6fa 100644 --- a/source/uCEFChromiumCore.pas +++ b/source/uCEFChromiumCore.pas @@ -390,6 +390,7 @@ TChromiumCore = class(TComponent, IChromiumEvents) procedure BrowserCompWndProc(var aMessage: TMessage); procedure WidgetCompWndProc(var aMessage: TMessage); procedure RenderCompWndProc(var aMessage: TMessage); + function CopyDCToBitmapStream(aSrcDC : HDC; const aSrcRect : TRect; var aStream : TStream) : boolean; {$ENDIF} procedure DragDropManager_OnDragEnter(Sender: TObject; const aDragData : ICefDragData; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint); @@ -4928,26 +4929,28 @@ procedure TChromiumCore.doOnRenderViewReady(const browser: ICefBrowser); begin {$IFDEF MSWINDOWS} OldBrowserCompHWND := FBrowserCompHWND; - OldWidgetCompHWND := FWidgetCompHWND; - OldRenderCompHWND := FRenderCompHWND; + OldWidgetCompHWND := FWidgetCompHWND; + OldRenderCompHWND := FRenderCompHWND; {$ENDIF} FBrowserCompHWND := browser.Host.WindowHandle; {$IFDEF MSWINDOWS} if (FBrowserCompHWND <> 0) then - begin - FWidgetCompHWND := FindWindowEx(FBrowserCompHWND, 0, 'Chrome_WidgetWin_0', ''); - if (FWidgetCompHWND = 0) and FIsOSR and CefCurrentlyOn(TID_UI) then begin - // The WidgetCompHWND window doesn't have a HwndParent (Owner). If we are in OSR mode this - // causes popup menus that are opened by CEF to stay open if the user clicks somewhere else. - // With this code we search for the Widget window in the UI Thread's window list and set - // the Browser window as its HwndParent. This works around the bug. - EnumThreadWindows(GetCurrentThreadId, @EnumProcOSRChromeWidgetWin0, NativeInt(@FWidgetCompHWND)); - if FWidgetCompHWND <> 0 then - SetWindowLongPtr(FWidgetCompHWND, GWLP_HWNDPARENT, NativeInt(FBrowserCompHWND)); + FWidgetCompHWND := FindWindowEx(FBrowserCompHWND, 0, 'Chrome_WidgetWin_0', ''); + + if (FWidgetCompHWND = 0) and FIsOSR and CefCurrentlyOn(TID_UI) then + begin + // The WidgetCompHWND window doesn't have a HwndParent (Owner). If we are in OSR mode this + // causes popup menus that are opened by CEF to stay open if the user clicks somewhere else. + // With this code we search for the Widget window in the UI Thread's window list and set + // the Browser window as its HwndParent. This works around the bug. + EnumThreadWindows(GetCurrentThreadId, @EnumProcOSRChromeWidgetWin0, NativeInt(@FWidgetCompHWND)); + + if (FWidgetCompHWND <> 0) then + SetWindowLongPtr(FWidgetCompHWND, GWLP_HWNDPARENT, NativeInt(FBrowserCompHWND)); + end; end; - end; if (FWidgetCompHWND <> 0) then FRenderCompHWND := FindWindowEx(FWidgetCompHWND, 0, 'Chrome_RenderWidgetHostHWND', 'Chrome Legacy Window'); @@ -5389,4 +5392,71 @@ procedure TChromiumCore.IMECancelComposition; if Initialized then FBrowser.Host.IMECancelComposition; end; +{$IFDEF MSWINDOWS} +function TChromiumCore.CopyDCToBitmapStream(aSrcDC : HDC; const aSrcRect : TRect; var aStream : TStream) : boolean; +var + TempDstDC : HDC; + TempWidth : Integer; + TempHeight : Integer; + TempInfo : TBitmapInfo; + TempBits : Pointer; + TempNewBitmap : HBITMAP; + TempOldBitmap : HBITMAP; + TempHeader : TBitmapFileHeader; +begin + Result := False; + if (aSrcDC = 0) or (aStream = nil) then exit; + + TempDstDC := CreateCompatibleDC(aSrcDC); + if (TempDstDC = 0) then exit; + + TempWidth := aSrcRect.Right - aSrcRect.Left; + TempHeight := aSrcRect.Bottom - aSrcRect.Top; + TempBits := nil; + + if (TempWidth > 0) and (TempHeight > 0) then + begin + ZeroMemory(@TempInfo, SizeOf(TBitmapInfo)); + ZeroMemory(@TempHeader, SizeOf(TBitmapFileHeader)); + + TempInfo.bmiHeader.biSize := SizeOf(TBitmapInfoHeader); + TempInfo.bmiHeader.biWidth := TempWidth; + TempInfo.bmiHeader.biHeight := TempHeight; + TempInfo.bmiHeader.biPlanes := 1; + TempInfo.bmiHeader.biBitCount := 32; + TempInfo.bmiHeader.biCompression := BI_RGB; + TempInfo.bmiHeader.biSizeImage := TempWidth * TempHeight * SizeOf(TRGBQuad); + + TempNewBitmap := CreateDIBSection(TempDstDC, TempInfo, DIB_RGB_COLORS, TempBits, 0, 0); + + if (TempNewBitmap <> 0) then + try + TempOldBitmap := SelectObject(TempDstDC, TempNewBitmap); + + if BitBlt(TempDstDC, 0, 0, TempWidth, TempHeight, aSrcDC, aSrcRect.Left, aSrcRect.Top, SRCCOPY) then + begin + TempHeader.bfType := $4D42; // "BM" bitmap header + TempHeader.bfOffBits := sizeof(BITMAPFILEHEADER) + TempInfo.bmiHeader.biSize + TempInfo.bmiHeader.biClrUsed * SizeOf(TRGBQuad); + TempHeader.bfSize := TempHeader.bfOffBits + TempInfo.bmiHeader.biSizeImage; + + aStream.position := 0; + + aStream.Write(TempHeader, SizeOf(TBitmapFileHeader)); + aStream.Write(TempInfo.bmiHeader, SizeOf(TBitmapInfoHeader)); + aStream.Write(TempBits^, TempInfo.bmiHeader.biSizeImage); + + aStream.position := 0; + Result := True; + end; + + SelectObject(TempDstDC, TempOldBitmap); + finally + DeleteObject(TempNewBitmap); + end; + end; + + ReleaseDC(0, TempDstDC); +end; +{$ENDIF} + end. diff --git a/source/uCEFFMXChromium.pas b/source/uCEFFMXChromium.pas index d5e89a45..313b1f00 100644 --- a/source/uCEFFMXChromium.pas +++ b/source/uCEFFMXChromium.pas @@ -49,7 +49,7 @@ interface {$IFDEF MSWINDOWS} WinApi.Windows, WinApi.Messages, FMX.Platform.Win, {$ENDIF} - FMX.Types, FMX.Platform, FMX.Forms, FMX.Controls, + FMX.Types, FMX.Platform, FMX.Forms, FMX.Controls, FMX.Graphics, uCEFTypes, uCEFInterfaces, uCEFChromiumCore; type @@ -70,6 +70,8 @@ TFMXChromium = class(TChromiumCore, IChromiumEvents) procedure SetFormTopTo(const y : Integer); function CreateBrowser(const aWindowName : ustring = ''; const aContext : ICefRequestContext = nil; const aExtraInfo : ICefDictionaryValue = nil) : boolean; overload; virtual; + function SaveAsBitmapStream(var aStream : TStream; const aRect : System.Types.TRect) : boolean; + function TakeSnapshot(var aBitmap : TBitmap; const aRect : System.Types.TRect) : boolean; end; // ********************************************************* @@ -251,4 +253,52 @@ procedure TFMXChromium.SetFormTopTo(const y : Integer); {$ENDIF} end; +function TFMXChromium.SaveAsBitmapStream(var aStream : TStream; const aRect : System.Types.TRect) : boolean; +{$IFDEF MSWINDOWS} +var + TempDC : HDC; + TempRect : System.Types.TRect; +{$ENDIF} +begin + Result := False; + + {$IFDEF MSWINDOWS} + if not(FIsOSR) and (FRenderCompHWND <> 0) and (aStream <> nil) then + begin + TempDC := GetDC(FRenderCompHWND); + + if (TempDC <> 0) then + try + TempRect := aRect; + Result := OffsetRect(TempRect, - TempRect.Left, - TempRect.Top) and + CopyDCToBitmapStream(TempDC, TempRect, aStream); + finally + ReleaseDC(FRenderCompHWND, TempDC); + end; + end; + {$ENDIF} +end; + +function TFMXChromium.TakeSnapshot(var aBitmap : TBitmap; const aRect : System.Types.TRect) : boolean; +var + TempStream : TMemoryStream; +begin + Result := False; + TempStream := nil; + + if FIsOSR or (aBitmap = nil) then exit; + + try + TempStream := TMemoryStream.Create; + + if SaveAsBitmapStream(TStream(TempStream), aRect) then + begin + aBitmap.LoadFromStream(TempStream); + Result := True; + end; + finally + FreeAndNil(TempStream); + end; +end; + end. diff --git a/source/uCEFMiscFunctions.pas b/source/uCEFMiscFunctions.pas index 227d1a69..a1398e98 100644 --- a/source/uCEFMiscFunctions.pas +++ b/source/uCEFMiscFunctions.pas @@ -250,6 +250,8 @@ function MoveFileList(const aFileList : TStringList; const aSrcDirectory, aDstDi function CefGetDataURI(const aString, aMimeType : ustring) : ustring; overload; function CefGetDataURI(aData : pointer; aSize : integer; const aMimeType : ustring; const aCharset : ustring = '') : ustring; overload; + + implementation uses @@ -1993,7 +1995,7 @@ procedure DragOperationToDropEffect(const aDragOperations : TCefDragOperations; if ((aDragOperations and DRAG_OPERATION_COPY) <> 0) then aEffect := aEffect or DROPEFFECT_COPY; if ((aDragOperations and DRAG_OPERATION_LINK) <> 0) then aEffect := aEffect or DROPEFFECT_LINK; if ((aDragOperations and DRAG_OPERATION_MOVE) <> 0) then aEffect := aEffect or DROPEFFECT_MOVE; -end; +end; {$ENDIF} function DeviceToLogical(aValue : integer; const aDeviceScaleFactor : double) : integer; @@ -2174,5 +2176,5 @@ function CefGetDataURI(aData : pointer; aSize : integer; const aMimeType, aChars Result := Result + ';base64,' + CefURIEncode(CefBase64Encode(aData, aSize), false); end; - -end. + +end. diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index 77e62d49..bfb7c6a7 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,7 +2,7 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 77, + "InternalVersion" : 78, "Name" : "cef4delphi_lazarus.lpk", "Version" : "79.0.10.0" }