CEF4Delphi/source/uCEFWinControl.pas
2022-10-14 16:35:50 +02:00

229 lines
5.9 KiB
ObjectPascal

// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2022 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uCEFWinControl;
{$I cef.inc}
{$IFDEF FPC}
{$MODE OBJFPC}{$H+}
{$IFDEF MACOSX}
{$ModeSwitch objectivec1}
{$ENDIF}
{$ENDIF}
{$IFNDEF TARGET_64BITS}{$ALIGN ON}{$ENDIF}
{$MINENUMSIZE 4}
interface
uses
{$IFDEF DELPHI16_UP}
{$IFDEF MSWINDOWS}WinApi.Windows, {$ENDIF} System.Classes, Vcl.Controls, Vcl.Graphics,
{$ELSE}
{$IFDEF MSWINDOWS}Windows,{$ENDIF} Classes, Forms, Controls, Graphics,
{$IFDEF FPC}
LCLProc, LCLType, LCLIntf, LResources, InterfaceBase,
{$ENDIF}
{$ENDIF}
{$IFDEF FPC}{$IFDEF MACOSX}
CocoaAll,
{$ENDIF}{$ENDIF}
uCEFTypes, uCEFInterfaces;
type
TCEFWinControl = class(TWinControl)
protected
function GetChildWindowHandle : {$IFNDEF MSWINDOWS}{$IFDEF FPC}LclType.{$ENDIF}{$ENDIF}THandle; virtual;
procedure Resize; override;
public
function TakeSnapshot(var aBitmap : TBitmap) : boolean;
function DestroyChildWindow : boolean;
procedure CreateHandle; override;
procedure InvalidateChildren;
procedure UpdateSize; virtual;
property ChildWindowHandle : THandle read GetChildWindowHandle;
published
property Align;
property Anchors;
property Color;
property Constraints;
property TabStop;
property TabOrder;
property Visible;
property Enabled;
property ShowHint;
property Hint;
property DragKind;
property DragCursor;
property DragMode;
property OnResize;
property OnEnter;
property OnExit;
property OnDragDrop;
property OnDragOver;
property OnStartDrag;
property OnEndDrag;
{$IFNDEF FPC}
property OnCanResize;
{$ENDIF}
{$IFDEF DELPHI14_UP}
property Touch;
property OnGesture;
{$ENDIF}
property DoubleBuffered;
{$IFDEF DELPHI12_UP}
property ParentDoubleBuffered;
{$ENDIF}
end;
implementation
uses
uCEFMiscFunctions, uCEFClient, uCEFConstants;
function TCEFWinControl.GetChildWindowHandle : {$IFNDEF MSWINDOWS}{$IFDEF FPC}LclType.{$ENDIF}{$ENDIF}THandle;
begin
{$IFDEF MSWINDOWS}
if not(csDesigning in ComponentState) and HandleAllocated then
Result := GetWindow(Handle, GW_CHILD)
else
{$ENDIF}
Result := 0;
end;
procedure TCEFWinControl.CreateHandle;
begin
inherited CreateHandle;
end;
procedure TCEFWinControl.InvalidateChildren;
begin
if HandleAllocated then
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ALLCHILDREN);
end;
procedure TCEFWinControl.UpdateSize;
{$IFDEF MSWINDOWS}
var
TempRect : TRect;
TempHWND : THandle;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
TempHWND := ChildWindowHandle;
if (TempHWND = 0) then exit;
TempRect := GetClientRect;
SetWindowPos(TempHWND, 0,
0, 0, TempRect.right, TempRect.bottom,
SWP_NOZORDER);
{$ENDIF}
end;
function TCEFWinControl.TakeSnapshot(var aBitmap : TBitmap) : boolean;
{$IFDEF MSWINDOWS}
var
TempHWND : HWND;
TempDC : HDC;
TempRect : TRect;
TempWidth : Integer;
TempHeight : Integer;
{$ENDIF}
begin
Result := False;
{$IFDEF MSWINDOWS}
if (aBitmap = nil) then exit;
TempHWND := ChildWindowHandle;
if (TempHWND = 0) then exit;
{$IFDEF DELPHI16_UP}Winapi.{$ENDIF}Windows.GetClientRect(TempHWND, TempRect);
TempDC := GetDC(TempHWND);
TempWidth := TempRect.Right - TempRect.Left;
TempHeight := TempRect.Bottom - TempRect.Top;
aBitmap := TBitmap.Create;
aBitmap.Height := TempHeight;
aBitmap.Width := TempWidth;
Result := BitBlt(aBitmap.Canvas.Handle, 0, 0, TempWidth, TempHeight,
TempDC, 0, 0, SRCCOPY);
ReleaseDC(TempHWND, TempDC);
{$ENDIF}
end;
function TCEFWinControl.DestroyChildWindow : boolean;
{$IFDEF MSWINDOWS}
var
TempHWND : HWND;
{$ENDIF}
{$IFDEF FPC}{$IFDEF MACOSX}
var
ViewObj: NSObject;
{$ENDIF}{$ENDIF}
begin
{$IFDEF MSWINDOWS}
TempHWND := ChildWindowHandle;
Result := (TempHWND <> 0) and DestroyWindow(TempHWND);
{$ELSE}
Result := False;
{$IFDEF FPC}{$IFDEF MACOSX}
ViewObj := NSObject(ChildWindowHandle);
if ViewObj <> nil then begin
if ViewObj.isKindOfClass_(nsview) then begin
NSView(ViewObj).removeFromSuperview;
Result := True;
end;
end;
{$ENDIF}{$ENDIF}
{$ENDIF}
end;
procedure TCEFWinControl.Resize;
begin
inherited Resize;
UpdateSize;
end;
end.