Skip to content

Commit

Permalink
Added TFMXChromium.TakeSnapshot
Browse files Browse the repository at this point in the history 
- Added TFMXChromium.SaveAsBitmapStream
- Added TChromium.SaveAsBitmapStream
- Fixed bug #253
  • Loading branch information
@salvadordf
salvadordf committed Jan 2, 2020
1 parent fd1e936 commit e53cc7e
Show file tree
Hide file tree
Showing 7 changed files with 321 additions and 47 deletions.
44 changes: 36 additions & 8 deletions demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.fmx
View file
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
104 changes: 102 additions & 2 deletions demos/Delphi_FMX/SimpleFMXBrowser/uSimpleFMXBrowser.pas
View file
Expand Up @@ -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);
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Expand All @@ -260,6 +322,7 @@ procedure TSimpleFMXBrowserFrm.FormCreate(Sender: TObject);
FCanClose := False;
FClosing := False;
FMXWindowParent := nil;
FOldWindowState := TWindowState.wsNormal;
end;

procedure TSimpleFMXBrowserFrm.FormResize(Sender: TObject);
Expand All @@ -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;
Expand Down Expand Up @@ -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);
Expand Down
62 changes: 43 additions & 19 deletions source/uCEFChromium.pas
View file
Expand Up @@ -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;

Expand Down Expand Up @@ -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;
Expand All @@ -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}
Expand Down

0 comments on commit e53cc7e

Please sign in to comment.