mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2024-11-24 08:02:15 +02:00
996 lines
32 KiB
ObjectPascal
996 lines
32 KiB
ObjectPascal
unit uCEFOsrBrowserWindow;
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE OBJFPC}{$H+}
|
|
{$ENDIF}
|
|
|
|
{$i cef.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF DARWIN} // $IFDEF MACOSX
|
|
uCEFLazarusCocoa,
|
|
{$ENDIF}
|
|
{$IFDEF FPC}
|
|
LResources, PropEdits,
|
|
{$ENDIF}
|
|
uCEFApplication, uCEFChromiumWindow, uCEFTypes, uCEFInterfaces, uCEFChromium,
|
|
uCEFLinkedWinControlBase, uCEFBufferPanel,
|
|
uCEFBrowserWindow, uCEFBitmapBitBuffer, uCEFMiscFunctions,
|
|
uCEFConstants, uCEFChromiumEvents, Forms, ExtCtrls, LCLType, Graphics,
|
|
Controls, syncobjs, Classes, sysutils, math;
|
|
|
|
type
|
|
|
|
TBrowserMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer;
|
|
var AHandled: Boolean) of Object;
|
|
TBrowserMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState;
|
|
X, Y: Integer;
|
|
var AHandled: Boolean) of Object;
|
|
TBrowserMouseWheelEvent = procedure(Sender: TObject; Shift: TShiftState;
|
|
WheelDelta: Integer; MousePos: TPoint;
|
|
var AHandled: Boolean) of Object;
|
|
TBrowserKeyEvent = procedure(Sender: TObject; var Key: Word; Shift: TShiftState; var AHandled: Boolean) of Object;
|
|
//TBrowserKeyPressEvent = procedure(Sender: TObject; var Key: char; var AHandled: Boolean) of Object;
|
|
TBrowserUTF8KeyPressEvent = procedure(Sender: TObject; var UTF8Key: TUTF8Char; var AHandled: Boolean) of Object;
|
|
|
|
(* TEmbeddedOsrChromium
|
|
|
|
Hides (THiddenPropertyEditor) any published event that is used by TOsrBrowserWindow
|
|
* Hidden events must also not be used by user code *
|
|
*)
|
|
|
|
TEmbeddedOsrChromium = class(TEmbeddedChromium)
|
|
end;
|
|
|
|
(*
|
|
|
|
=== State of Implementation ===
|
|
|
|
On MacOS the keyboard support is currently incomplete
|
|
|
|
|
|
*)
|
|
|
|
{ TOsrBrowserWindow - Off-Screen-Rendering
|
|
|
|
A simple "drop on the Form" component for an full embedded browser.
|
|
|
|
See notes an TBrowserWindow for requirements in user code.
|
|
Further:
|
|
- Some keystrokes may not be sent to KeyDown/KeyPress by the LCL.
|
|
They may be available as WM_SYSKEYDOWN/UP message on the containing Form.
|
|
|
|
|
|
This component is still experimental.
|
|
- On MacOS Keyboard support is not complete
|
|
|
|
}
|
|
|
|
TOsrBrowserWindow = class(TBufferPanel)
|
|
private
|
|
FPopUpBitmap : TBitmap;
|
|
FPopUpRect : TRect;
|
|
FShowPopUp : boolean;
|
|
FResizing : boolean;
|
|
FPendingResize : boolean;
|
|
FResizeCS : syncobjs.TCriticalSection;
|
|
|
|
//FIMECS : TCriticalSection;
|
|
FDeviceBounds : TCefRectDynArray;
|
|
FSelectedRange : TCefRange;
|
|
|
|
FLastKeyDown: Word;
|
|
|
|
procedure AsyncInvalidate(Data: PtrInt);
|
|
procedure AsyncResize(Data: PtrInt);
|
|
procedure SyncIMERangeChanged;
|
|
|
|
procedure DoGetChromiumBeforePopup(Sender: TObject;
|
|
const browser: ICefBrowser; const frame: ICefFrame; const targetUrl,
|
|
targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition;
|
|
userGesture: Boolean; const popupFeatures: TCefPopupFeatures;
|
|
var windowInfo: TCefWindowInfo; var client: ICefClient;
|
|
var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue;
|
|
var noJavascriptAccess: Boolean; var Result: Boolean);
|
|
procedure DoGetChromiumPopupShow(Sender: TObject;
|
|
const browser: ICefBrowser; AShow: Boolean);
|
|
procedure DoGetChromiumPopupSize(Sender: TObject;
|
|
const browser: ICefBrowser; const rect: PCefRect);
|
|
procedure DoGetChromiumTooltip(Sender: TObject;
|
|
const browser: ICefBrowser; var AText: ustring; out Result: Boolean);
|
|
procedure DoGetChromiumIMECompositionRangeChanged(Sender: TObject;
|
|
const browser: ICefBrowser; const selected_range: PCefRange;
|
|
character_boundsCount: NativeUInt; const character_bounds: PCefRect);
|
|
procedure DoGetChromiumCursorChange(Sender: TObject;
|
|
const browser: ICefBrowser; cursor_: TCefCursorHandle;
|
|
cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo;
|
|
var aResult: boolean);
|
|
procedure DoGetChromiumGetScreenInfo(Sender: TObject;
|
|
const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out
|
|
Result: Boolean);
|
|
procedure DoGetChromiumGetScreenPoint(Sender: TObject;
|
|
const browser: ICefBrowser; viewX, viewY: Integer; var screenX,
|
|
screenY: Integer; out Result: Boolean);
|
|
procedure DoGetChromiumViewRect(Sender: TObject;
|
|
const browser: ICefBrowser; var rect: TCefRect);
|
|
procedure DoChromiumPaint(Sender: TObject; const browser: ICefBrowser;
|
|
kind: TCefPaintElementType; dirtyRectsCount: NativeUInt;
|
|
const dirtyRects: PCefRectArray; const ABuffer: Pointer; AWidth,
|
|
AHeight: Integer);
|
|
|
|
private
|
|
FChromium : TEmbeddedOsrChromium;
|
|
|
|
FOnBrowserClosed : TNotifyEvent;
|
|
FOnBrowserCreated : TNotifyEvent;
|
|
FOnKeyDown: TBrowserKeyEvent;
|
|
FOnKeyUp: TBrowserKeyEvent;
|
|
FOnMouseDown: TBrowserMouseEvent;
|
|
FOnMouseMove: TBrowserMouseMoveEvent;
|
|
FOnMouseUp: TBrowserMouseEvent;
|
|
FOnMouseWheel: TBrowserMouseWheelEvent;
|
|
FOnUtf8KeyPress: TBrowserUTF8KeyPressEvent;
|
|
|
|
procedure DoCreateBrowserAfterContext(Sender: TObject);
|
|
|
|
protected
|
|
function GetChromium: TEmbeddedOsrChromium;
|
|
function getModifiers(Shift: TShiftState): TCefEventFlags;
|
|
function getKeyModifiers(Shift: TShiftState): TCefEventFlags;
|
|
function GetButton(Button: TMouseButton): TCefMouseButtonType;
|
|
procedure DestroyHandle; override;
|
|
procedure RealizeBounds; override;
|
|
|
|
procedure DoEnter; override;
|
|
procedure DoExit; override;
|
|
procedure Click; override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseEnter; override;
|
|
procedure MouseLeave; override;
|
|
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
|
|
|
|
(* Key input works only for windows.
|
|
*)
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
|
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
|
{$IFDEF MSWINDOWS}
|
|
procedure DoOnIMECancelComposition; override;
|
|
procedure DoOnIMECommitText(const aText : ustring; const replacement_range : PCefRange; relative_cursor_pos : integer); override;
|
|
procedure DoOnIMESetComposition(const aText : ustring; const underlines : TCefCompositionUnderlineDynArray; const replacement_range, selection_range : TCefRange); override;
|
|
{$ENDIF}
|
|
procedure CaptureChanged; override;
|
|
|
|
procedure DoOnCreated(Sender: TObject);
|
|
procedure DoOnClosed(Sender: TObject);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure CreateHandle; override;
|
|
|
|
procedure CloseBrowser(aForceClose: boolean);
|
|
procedure WaitForBrowserClosed;
|
|
function IsClosed: boolean;
|
|
procedure LoadURL(aURL: ustring);
|
|
//
|
|
published
|
|
property Chromium : TEmbeddedOsrChromium read GetChromium;
|
|
|
|
property OnBrowserCreated : TNotifyEvent read FOnBrowserCreated write FOnBrowserCreated;
|
|
property OnBrowserClosed : TNotifyEvent read FOnBrowserClosed write FOnBrowserClosed;
|
|
|
|
(* Mouse/Key events
|
|
The below events can be used to see mouse/key input before it is sent to CEF.
|
|
All events have a "AHandled" parameter, which can be used to prevent the event
|
|
from being sent to CEF.
|
|
*)
|
|
property OnMouseDown: TBrowserMouseEvent read FOnMouseDown write FOnMouseDown;
|
|
property OnMouseUp: TBrowserMouseEvent read FOnMouseUp write FOnMouseUp;
|
|
property OnMouseMove: TBrowserMouseMoveEvent read FOnMouseMove write FOnMouseMove;
|
|
property OnMouseWheel: TBrowserMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
|
|
property OnKeyDown: TBrowserKeyEvent read FOnKeyDown write FOnKeyDown;
|
|
property OnKeyUp: TBrowserKeyEvent read FOnKeyUp write FOnKeyUp;
|
|
property OnUtf8KeyPress: TBrowserUTF8KeyPressEvent read FOnUtf8KeyPress write FOnUtf8KeyPress;
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
procedure Register;
|
|
{$ENDIF}
|
|
|
|
|
|
implementation
|
|
|
|
{ TOsrBrowserWindow }
|
|
|
|
procedure TOsrBrowserWindow.AsyncInvalidate(Data: PtrInt);
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.AsyncResize(Data: PtrInt);
|
|
begin
|
|
try
|
|
FResizeCS.Acquire;
|
|
|
|
if FResizing then
|
|
FPendingResize := True
|
|
else
|
|
if BufferIsResized then
|
|
Chromium.Invalidate(PET_VIEW)
|
|
else
|
|
begin
|
|
FResizing := True;
|
|
Chromium.WasResized;
|
|
end;
|
|
finally
|
|
FResizeCS.Release;
|
|
end;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.SyncIMERangeChanged;
|
|
begin
|
|
ChangeCompositionRange(FSelectedRange, FDeviceBounds);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoGetChromiumBeforePopup(Sender: TObject;
|
|
const browser: ICefBrowser; const frame: ICefFrame; const targetUrl,
|
|
targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition;
|
|
userGesture: Boolean; const popupFeatures: TCefPopupFeatures;
|
|
var windowInfo: TCefWindowInfo; var client: ICefClient;
|
|
var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue;
|
|
var noJavascriptAccess: Boolean; var Result: Boolean);
|
|
begin
|
|
// For simplicity, this demo blocks all popup windows and new tabs
|
|
Result := (targetDisposition in [CEF_WOD_NEW_FOREGROUND_TAB, CEF_WOD_NEW_BACKGROUND_TAB, CEF_WOD_NEW_POPUP, CEF_WOD_NEW_WINDOW]);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoGetChromiumPopupShow(Sender: TObject;
|
|
const browser: ICefBrowser; AShow: Boolean);
|
|
begin
|
|
if aShow then
|
|
FShowPopUp := True
|
|
else
|
|
begin
|
|
FShowPopUp := False;
|
|
FPopUpRect := rect(0, 0, 0, 0);
|
|
|
|
if (Chromium <> nil) then Chromium.Invalidate(PET_VIEW);
|
|
end;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoGetChromiumPopupSize(Sender: TObject;
|
|
const browser: ICefBrowser; const rect: PCefRect);
|
|
begin
|
|
LogicalToDevice(rect^, ScreenScale);
|
|
|
|
FPopUpRect.Left := rect^.x;
|
|
FPopUpRect.Top := rect^.y;
|
|
FPopUpRect.Right := rect^.x + rect^.width - 1;
|
|
FPopUpRect.Bottom := rect^.y + rect^.height - 1;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoGetChromiumTooltip(Sender: TObject;
|
|
const browser: ICefBrowser; var AText: ustring; out Result: Boolean);
|
|
begin
|
|
hint := aText;
|
|
ShowHint := (length(aText) > 0);
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoGetChromiumIMECompositionRangeChanged(
|
|
Sender: TObject; const browser: ICefBrowser; const selected_range: PCefRange;
|
|
character_boundsCount: NativeUInt; const character_bounds: PCefRect);
|
|
var
|
|
TempPRect : PCefRect;
|
|
i : NativeUInt;
|
|
TempScale : single;
|
|
begin
|
|
// TChromium.OnIMECompositionRangeChanged is triggered in a different thread
|
|
// and all functions using a IMM context need to be executed in the same
|
|
// thread, in this case the main thread. We need to save the parameters and
|
|
// send a message to the form to execute Panel1.ChangeCompositionRange in
|
|
// the main thread.
|
|
|
|
if (FDeviceBounds <> nil) then
|
|
begin
|
|
Finalize(FDeviceBounds);
|
|
FDeviceBounds := nil;
|
|
end;
|
|
|
|
FSelectedRange := selected_range^;
|
|
|
|
if (character_boundsCount > 0) then
|
|
begin
|
|
SetLength(FDeviceBounds, character_boundsCount);
|
|
|
|
i := 0;
|
|
TempPRect := character_bounds;
|
|
TempScale := ScreenScale;
|
|
|
|
while (i < character_boundsCount) do
|
|
begin
|
|
FDeviceBounds[i] := TempPRect^;
|
|
LogicalToDevice(FDeviceBounds[i], TempScale);
|
|
|
|
inc(TempPRect);
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
TThread.Synchronize(nil, @SyncIMERangeChanged);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoGetChromiumCursorChange(Sender: TObject;
|
|
const browser: ICefBrowser; cursor_: TCefCursorHandle;
|
|
cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo;
|
|
var aResult: boolean);
|
|
begin
|
|
Cursor := CefCursorToWindowsCursor(cursorType);
|
|
aResult := True;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoGetChromiumGetScreenInfo(Sender: TObject;
|
|
const browser: ICefBrowser; var screenInfo: TCefScreenInfo; out
|
|
Result: Boolean);
|
|
var
|
|
TempRect : TCEFRect;
|
|
TempScale : single;
|
|
begin
|
|
TempScale := ScreenScale;
|
|
TempRect.x := 0;
|
|
TempRect.y := 0;
|
|
TempRect.width := DeviceToLogical(Width, TempScale);
|
|
TempRect.height := DeviceToLogical(Height, TempScale);
|
|
|
|
screenInfo.device_scale_factor := TempScale;
|
|
screenInfo.depth := 0;
|
|
screenInfo.depth_per_component := 0;
|
|
screenInfo.is_monochrome := Ord(False);
|
|
screenInfo.rect := TempRect;
|
|
screenInfo.available_rect := TempRect;
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoGetChromiumGetScreenPoint(Sender: TObject;
|
|
const browser: ICefBrowser; viewX, viewY: Integer; var screenX,
|
|
screenY: Integer; out Result: Boolean);
|
|
var
|
|
TempScreenPt, TempViewPt : TPoint;
|
|
TempScale : single;
|
|
begin
|
|
TempScale := ScreenScale;
|
|
TempViewPt.x := LogicalToDevice(viewX, TempScale);
|
|
TempViewPt.y := LogicalToDevice(viewY, TempScale);
|
|
TempScreenPt := ClientToScreen(TempViewPt);
|
|
screenX := TempScreenPt.x;
|
|
screenY := TempScreenPt.y;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoGetChromiumViewRect(Sender: TObject;
|
|
const browser: ICefBrowser; var rect: TCefRect);
|
|
var
|
|
TempScale : single;
|
|
begin
|
|
TempScale := ScreenScale;
|
|
rect.x := 0;
|
|
rect.y := 0;
|
|
rect.width := DeviceToLogical(Width, TempScale);
|
|
rect.height := DeviceToLogical(Height, TempScale);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoChromiumPaint(Sender: TObject;
|
|
const browser: ICefBrowser; kind: TCefPaintElementType;
|
|
dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray;
|
|
const ABuffer: Pointer; AWidth, AHeight: Integer);
|
|
var
|
|
src, dst: PByte;
|
|
i, j, TempLineSize, TempSrcOffset, TempDstOffset, SrcStride : Integer;
|
|
n : NativeUInt;
|
|
TempWidth, TempHeight: integer;
|
|
TempBufferBits : Pointer;
|
|
TempForcedResize : boolean;
|
|
TempBitmap : TBitmap;
|
|
TempSrcRect : TRect;
|
|
{$IFDEF DARWIN}
|
|
s: PByte;
|
|
ls: integer;
|
|
{$ENDIF}
|
|
begin
|
|
try
|
|
FResizeCS.Acquire;
|
|
TempForcedResize := False;
|
|
|
|
if BeginBufferDraw then
|
|
begin
|
|
if (kind = PET_POPUP) then
|
|
begin
|
|
if (FPopUpBitmap = nil) or
|
|
(aWidth <> FPopUpBitmap.Width) or
|
|
(aHeight <> FPopUpBitmap.Height) then
|
|
begin
|
|
if (FPopUpBitmap <> nil) then FPopUpBitmap.Free;
|
|
|
|
FPopUpBitmap := TBitmap.Create;
|
|
FPopUpBitmap.PixelFormat := pf32bit;
|
|
FPopUpBitmap.HandleType := bmDIB;
|
|
FPopUpBitmap.Width := aWidth;
|
|
FPopUpBitmap.Height := aHeight;
|
|
end;
|
|
|
|
TempBitmap := FPopUpBitmap;
|
|
TempBitmap.BeginUpdate;
|
|
|
|
TempWidth := FPopUpBitmap.Width;
|
|
TempHeight := FPopUpBitmap.Height;
|
|
end
|
|
else
|
|
begin
|
|
TempForcedResize := UpdateBufferDimensions(aWidth, aHeight) or not(BufferIsResized(False));
|
|
|
|
TempBitmap := Buffer;
|
|
TempBitmap.BeginUpdate;
|
|
|
|
TempWidth := BufferWidth;
|
|
TempHeight := BufferHeight;
|
|
end;
|
|
|
|
SrcStride := aWidth * SizeOf(TRGBQuad);
|
|
n := 0;
|
|
|
|
while (n < dirtyRectsCount) do
|
|
begin
|
|
if (dirtyRects^[n].x >= 0) and (dirtyRects^[n].y >= 0) then
|
|
begin
|
|
TempLineSize := min(dirtyRects^[n].width, TempWidth - dirtyRects^[n].x) {$IFnDEF DARWIN}* SizeOf(TRGBQuad){$ENDIF};
|
|
|
|
if (TempLineSize > 0) then
|
|
begin
|
|
TempSrcOffset := ((dirtyRects^[n].y * aWidth) + dirtyRects^[n].x) * SizeOf(TRGBQuad);
|
|
TempDstOffset := (dirtyRects^[n].x * SizeOf(TRGBQuad));
|
|
|
|
src := @PByte(ABuffer)[TempSrcOffset];
|
|
|
|
i := 0;
|
|
j := min(dirtyRects^[n].height, TempHeight - dirtyRects^[n].y);
|
|
|
|
while (i < j) do
|
|
begin
|
|
TempBufferBits := TempBitmap.Scanline[dirtyRects^[n].y + i];
|
|
dst := @PByte(TempBufferBits)[TempDstOffset];
|
|
|
|
{$IFDEF DARWIN}
|
|
ls := TempLineSize;
|
|
s := src;
|
|
while ls > 0 do begin
|
|
PCardinal(dst)^ := (s[0] shl 24) or (s[1] shl 16) or (s[2] shl 8) or s[3];
|
|
inc(dst, 4);
|
|
inc(s, 4);
|
|
dec(ls);
|
|
end;
|
|
{$ELSE}
|
|
Move(src^, dst^, TempLineSize);
|
|
{$ENDIF}
|
|
|
|
|
|
Inc(src, SrcStride);
|
|
inc(i);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
inc(n);
|
|
end;
|
|
|
|
TempBitmap.EndUpdate;
|
|
|
|
if FShowPopup and (FPopUpBitmap <> nil) then
|
|
begin
|
|
TempSrcRect := Rect(0, 0,
|
|
min(FPopUpRect.Right - FPopUpRect.Left, FPopUpBitmap.Width),
|
|
min(FPopUpRect.Bottom - FPopUpRect.Top, FPopUpBitmap.Height));
|
|
|
|
BufferDraw(FPopUpBitmap, TempSrcRect, FPopUpRect);
|
|
end;
|
|
|
|
EndBufferDraw;
|
|
|
|
if HandleAllocated then
|
|
//PostMessage(Handle, CEF_PENDINGINVALIDATE, 0, 0);
|
|
Application.QueueAsyncCall(@AsyncInvalidate, 0);
|
|
|
|
if (kind = PET_VIEW) then
|
|
begin
|
|
if (TempForcedResize or FPendingResize) and
|
|
HandleAllocated then
|
|
Application.QueueAsyncCall(@AsyncResize, 0);
|
|
//PostMessage(Handle, CEF_PENDINGRESIZE, 0, 0);
|
|
|
|
FResizing := False;
|
|
FPendingResize := False;
|
|
end;
|
|
end;
|
|
finally
|
|
FResizeCS.Release;
|
|
end;
|
|
end;
|
|
|
|
function TOsrBrowserWindow.GetChromium: TEmbeddedOsrChromium;
|
|
begin
|
|
Result := FChromium;
|
|
end;
|
|
|
|
function TOsrBrowserWindow.getModifiers(Shift: TShiftState
|
|
): TCefEventFlags;
|
|
begin
|
|
Result := EVENTFLAG_NONE;
|
|
|
|
if (ssShift in Shift) then Result := Result or EVENTFLAG_SHIFT_DOWN;
|
|
if (ssAlt in Shift) then Result := Result or EVENTFLAG_ALT_DOWN;
|
|
if (ssCtrl in Shift) then Result := Result or EVENTFLAG_CONTROL_DOWN;
|
|
if (ssMeta in Shift) then Result := Result or EVENTFLAG_COMMAND_DOWN;
|
|
if (ssLeft in Shift) then Result := Result or EVENTFLAG_LEFT_MOUSE_BUTTON;
|
|
if (ssRight in Shift) then Result := Result or EVENTFLAG_RIGHT_MOUSE_BUTTON;
|
|
if (ssMiddle in Shift) then Result := Result or EVENTFLAG_MIDDLE_MOUSE_BUTTON;
|
|
end;
|
|
|
|
function TOsrBrowserWindow.getKeyModifiers(Shift: TShiftState): TCefEventFlags;
|
|
begin
|
|
Result := EVENTFLAG_NONE;
|
|
|
|
if (ssShift in Shift) then Result := Result or EVENTFLAG_SHIFT_DOWN;
|
|
if (ssAlt in Shift) then Result := Result or EVENTFLAG_ALT_DOWN;
|
|
if (ssCtrl in Shift) then Result := Result or EVENTFLAG_CONTROL_DOWN;
|
|
if (ssMeta in Shift) then Result := Result or EVENTFLAG_COMMAND_DOWN;
|
|
if (ssNum in Shift) then Result := Result or EVENTFLAG_NUM_LOCK_ON;
|
|
if (ssCaps in Shift) then Result := Result or EVENTFLAG_CAPS_LOCK_ON;
|
|
end;
|
|
|
|
function TOsrBrowserWindow.GetButton(Button: TMouseButton
|
|
): TCefMouseButtonType;
|
|
begin
|
|
case Button of
|
|
TMouseButton.mbRight : Result := MBT_RIGHT;
|
|
TMouseButton.mbMiddle : Result := MBT_MIDDLE;
|
|
else Result := MBT_LEFT;
|
|
end;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoCreateBrowserAfterContext(Sender: TObject);
|
|
begin
|
|
FChromium.CreateBrowser(nil);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.CreateHandle;
|
|
begin
|
|
inherited CreateHandle;
|
|
if not (csDesigning in ComponentState) then begin
|
|
GlobalCEFApp.AddContextInitializedHandler(@DoCreateBrowserAfterContext);
|
|
end;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DestroyHandle;
|
|
begin
|
|
if (GlobalCEFApp = nil) or
|
|
(not FChromium.HasBrowser) or
|
|
(csDesigning in ComponentState)
|
|
then begin
|
|
inherited DestroyHandle;
|
|
exit;
|
|
end;
|
|
|
|
FChromium.CloseBrowser(True);
|
|
inherited DestroyHandle;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.RealizeBounds;
|
|
begin
|
|
inherited RealizeBounds;
|
|
Chromium.NotifyMoveOrResizeStarted;
|
|
AsyncResize(0);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoEnter;
|
|
begin
|
|
inherited DoEnter;
|
|
Chromium.SetFocus(True);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoExit;
|
|
begin
|
|
inherited DoExit;
|
|
Chromium.SetFocus(False);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.Click;
|
|
begin
|
|
inherited Click;
|
|
SetFocus;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
TempEvent : TCefMouseEvent;
|
|
LastClickCount: integer;
|
|
IsHandled: Boolean;
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
IsHandled := False;
|
|
if FOnMouseDown <> nil then
|
|
FOnMouseDown(Self, Button, Shift, X, Y, IsHandled);
|
|
if IsHandled then
|
|
exit;
|
|
|
|
SetFocus;
|
|
|
|
LastClickCount := 1;
|
|
if ssDouble in Shift then LastClickCount := 2
|
|
else if ssTriple in Shift then LastClickCount := 3
|
|
else if ssQuad in Shift then LastClickCount := 4;
|
|
|
|
TempEvent.x := X;
|
|
TempEvent.y := Y;
|
|
TempEvent.modifiers := getModifiers(Shift);
|
|
DeviceToLogical(TempEvent, ScreenScale);
|
|
Chromium.SendMouseClickEvent(@TempEvent, GetButton(Button), False, LastClickCount);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.MouseUp(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
TempEvent : TCefMouseEvent;
|
|
LastClickCount: integer;
|
|
IsHandled: Boolean;
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
IsHandled := False;
|
|
if FOnMouseDown <> nil then
|
|
FOnMouseDown(Self, Button, Shift, X, Y, IsHandled);
|
|
if IsHandled then
|
|
exit;
|
|
|
|
LastClickCount := 1;
|
|
if ssDouble in Shift then LastClickCount := 2
|
|
else if ssTriple in Shift then LastClickCount := 3
|
|
else if ssQuad in Shift then LastClickCount := 4;
|
|
|
|
TempEvent.x := X;
|
|
TempEvent.y := Y;
|
|
TempEvent.modifiers := getModifiers(Shift);
|
|
DeviceToLogical(TempEvent, ScreenScale);
|
|
Chromium.SendMouseClickEvent(@TempEvent, GetButton(Button), True, LastClickCount);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
TempEvent : TCefMouseEvent;
|
|
IsHandled: Boolean;
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
IsHandled := False;
|
|
if FOnMouseMove <> nil then
|
|
FOnMouseMove(Self, Shift, X, Y, IsHandled);
|
|
if IsHandled then
|
|
exit;
|
|
|
|
TempEvent.x := x;
|
|
TempEvent.y := y;
|
|
TempEvent.modifiers := getModifiers(Shift);
|
|
DeviceToLogical(TempEvent, ScreenScale);
|
|
Chromium.SendMouseMoveEvent(@TempEvent, False);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.MouseEnter;
|
|
var
|
|
TempEvent : TCefMouseEvent;
|
|
TempPoint : TPoint;
|
|
begin
|
|
inherited MouseEnter;
|
|
|
|
TempPoint := ScreenToClient(mouse.CursorPos);
|
|
TempEvent.x := TempPoint.x;
|
|
TempEvent.y := TempPoint.y;
|
|
TempEvent.modifiers := EVENTFLAG_NONE;
|
|
DeviceToLogical(TempEvent, ScreenScale);
|
|
Chromium.SendMouseMoveEvent(@TempEvent, False);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.MouseLeave;
|
|
var
|
|
TempEvent : TCefMouseEvent;
|
|
TempPoint : TPoint;
|
|
TempTime : integer;
|
|
begin
|
|
inherited MouseLeave;
|
|
|
|
TempPoint := ScreenToClient(mouse.CursorPos);
|
|
TempPoint := ScreenToclient(TempPoint);
|
|
TempEvent.x := TempPoint.x;
|
|
TempEvent.y := TempPoint.y;
|
|
{$IFDEF MSWINDOWS}
|
|
TempEvent.modifiers := GetCefMouseModifiers;
|
|
{$ELSE}
|
|
TempEvent.modifiers := EVENTFLAG_NONE;
|
|
{$ENDIF}
|
|
DeviceToLogical(TempEvent, ScreenScale);
|
|
Chromium.SendMouseMoveEvent(@TempEvent, True);
|
|
end;
|
|
|
|
function TOsrBrowserWindow.DoMouseWheel(Shift: TShiftState;
|
|
WheelDelta: Integer; MousePos: TPoint): Boolean;
|
|
var
|
|
TempEvent : TCefMouseEvent;
|
|
IsHandled: Boolean;
|
|
begin
|
|
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
|
|
IsHandled := False;
|
|
if FOnMouseWheel <> nil then
|
|
FOnMouseWheel(Self, Shift, WheelDelta, MousePos, IsHandled);
|
|
if IsHandled then
|
|
exit;
|
|
|
|
TempEvent.x := MousePos.x;
|
|
TempEvent.y := MousePos.y;
|
|
TempEvent.modifiers := getModifiers(Shift);
|
|
DeviceToLogical(TempEvent, ScreenScale);
|
|
{$IFDEF MSWINDOWS}
|
|
if CefIsKeyDown(VK_SHIFT) then
|
|
Chromium.SendMouseWheelEvent(@TempEvent, WheelDelta, 0)
|
|
else
|
|
{$ENDIF}
|
|
Chromium.SendMouseWheelEvent(@TempEvent, 0, WheelDelta);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.KeyDown(var Key: Word; Shift: TShiftState);
|
|
var
|
|
TempKeyEvent : TCefKeyEvent;
|
|
IsHandled: Boolean;
|
|
begin
|
|
IsHandled := False;
|
|
if FOnKeyDown <> nil then
|
|
FOnKeyDown(Self, Key, Shift, IsHandled);
|
|
if IsHandled then begin
|
|
inherited KeyDown(Key, Shift);
|
|
exit;
|
|
end;
|
|
|
|
FLastKeyDown := Key;
|
|
if (Key <> 0) and (Chromium <> nil) then
|
|
begin
|
|
TempKeyEvent.kind := KEYEVENT_RAWKEYDOWN;
|
|
TempKeyEvent.modifiers := getModifiers(Shift);
|
|
TempKeyEvent.windows_key_code := Key;
|
|
{$IFDEF DARWIN} // $IFDEF MACOSX
|
|
TempKeyEvent.native_key_code := LastMacOsKeyDownCode;
|
|
{$ELSE}
|
|
TempKeyEvent.native_key_code := 0;
|
|
{$ENDIF}
|
|
TempKeyEvent.is_system_key := ord(False);
|
|
TempKeyEvent.character := #0;
|
|
TempKeyEvent.unmodified_character := #0;
|
|
TempKeyEvent.focus_on_editable_field := ord(False);
|
|
|
|
Chromium.SendKeyEvent(@TempKeyEvent);
|
|
|
|
if (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_TAB]) then Key := 0;
|
|
end;
|
|
|
|
inherited KeyDown(Key, Shift);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.UTF8KeyPress(var UTF8Key: TUTF8Char);
|
|
var
|
|
TempKeyEvent : TCefKeyEvent;
|
|
TempString : UnicodeString;
|
|
IsHandled: Boolean;
|
|
begin
|
|
IsHandled := False;
|
|
if FOnUtf8KeyPress <> nil then
|
|
FOnUtf8KeyPress(Self, UTF8Key, IsHandled);
|
|
if IsHandled then begin
|
|
inherited UTF8KeyPress(UTF8Key);
|
|
exit;
|
|
end;
|
|
|
|
if Focused then
|
|
begin
|
|
TempString := UTF8Decode(UTF8Key);
|
|
|
|
if (length(TempString) > 0) then
|
|
begin
|
|
TempKeyEvent.kind := KEYEVENT_CHAR;
|
|
{$IFDEF MSWINDOWS}
|
|
TempKeyEvent.modifiers := GetCefKeyboardModifiers(WParam(TempString[1]), 0);
|
|
TempKeyEvent.windows_key_code := ord(TempString[1]);
|
|
{$ELSE}
|
|
TempKeyEvent.modifiers := getKeyModifiers(GetKeyShiftState);
|
|
TempKeyEvent.windows_key_code := FLastKeyDown;
|
|
{$ENDIF}
|
|
TempKeyEvent.native_key_code := 0;
|
|
TempKeyEvent.is_system_key := ord(False);
|
|
TempKeyEvent.character := TempString[1];
|
|
TempKeyEvent.unmodified_character := TempString[1];
|
|
TempKeyEvent.focus_on_editable_field := ord(False);
|
|
|
|
Chromium.SendKeyEvent(@TempKeyEvent);
|
|
end;
|
|
end;
|
|
|
|
inherited UTF8KeyPress(UTF8Key);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.KeyUp(var Key: Word; Shift: TShiftState);
|
|
var
|
|
TempKeyEvent : TCefKeyEvent;
|
|
IsHandled: Boolean;
|
|
begin
|
|
IsHandled := False;
|
|
if FOnKeyUp <> nil then
|
|
FOnKeyUp(Self, Key, Shift, IsHandled);
|
|
if IsHandled then begin
|
|
inherited KeyUp(Key, Shift);
|
|
exit;
|
|
end;
|
|
|
|
if (Key <> 0) and (Chromium <> nil) then
|
|
begin
|
|
TempKeyEvent.kind := KEYEVENT_KEYUP;
|
|
TempKeyEvent.modifiers := getModifiers(Shift);
|
|
TempKeyEvent.windows_key_code := Key;
|
|
TempKeyEvent.native_key_code := 0;
|
|
TempKeyEvent.is_system_key := ord(False);
|
|
TempKeyEvent.character := #0;
|
|
TempKeyEvent.unmodified_character := #0;
|
|
TempKeyEvent.focus_on_editable_field := ord(False);
|
|
|
|
Chromium.SendKeyEvent(@TempKeyEvent);
|
|
end;
|
|
|
|
inherited KeyUp(Key, Shift);
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
procedure TOsrBrowserWindow.DoOnIMECancelComposition;
|
|
begin
|
|
inherited DoOnIMECancelComposition;
|
|
Chromium.IMECancelComposition;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoOnIMECommitText(const aText: ustring;
|
|
const replacement_range: PCefRange; relative_cursor_pos: integer);
|
|
begin
|
|
inherited DoOnIMECommitText(aText, replacement_range, relative_cursor_pos);
|
|
Chromium.IMECommitText(aText, replacement_range, relative_cursor_pos);;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoOnIMESetComposition(const aText: ustring;
|
|
const underlines: TCefCompositionUnderlineDynArray; const replacement_range,
|
|
selection_range: TCefRange);
|
|
begin
|
|
inherited DoOnIMESetComposition(aText, underlines, replacement_range, selection_range);
|
|
Chromium.IMESetComposition(aText, underlines, @replacement_range, @selection_range);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TOsrBrowserWindow.CaptureChanged;
|
|
begin
|
|
inherited CaptureChanged;
|
|
|
|
if (Chromium <> nil) then Chromium.SendCaptureLostEvent;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoOnCreated(Sender: TObject);
|
|
begin
|
|
if Assigned(FOnBrowserCreated) then
|
|
FOnBrowserCreated(Self);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.DoOnClosed(Sender: TObject);
|
|
begin
|
|
if (not(csDestroying in ComponentState)) and
|
|
Assigned(FOnBrowserClosed)
|
|
then
|
|
FOnBrowserClosed(Self);
|
|
end;
|
|
|
|
constructor TOsrBrowserWindow.Create(AOwner: TComponent);
|
|
begin
|
|
FResizeCS := TCriticalSection.Create;
|
|
|
|
FDeviceBounds := nil;
|
|
FSelectedRange.from := 0;
|
|
FSelectedRange.to_ := 0;
|
|
|
|
FChromium := TEmbeddedOsrChromium.Create(Self);
|
|
FChromium.InternalOnBrowserClosed := {$IFDEF FPC}@{$ENDIF}DoOnClosed;
|
|
FChromium.InternalOnBrowserCreated := {$IFDEF FPC}@{$ENDIF}DoOnCreated;
|
|
|
|
FChromium.OnPaint := {$IFDEF FPC}@{$ENDIF}DoChromiumPaint;
|
|
FChromium.OnGetViewRect := {$IFDEF FPC}@{$ENDIF}DoGetChromiumViewRect;
|
|
FChromium.OnCursorChange := {$IFDEF FPC}@{$ENDIF}DoGetChromiumCursorChange;
|
|
FChromium.OnGetScreenPoint := {$IFDEF FPC}@{$ENDIF}DoGetChromiumGetScreenPoint;
|
|
FChromium.OnGetScreenInfo := {$IFDEF FPC}@{$ENDIF}DoGetChromiumGetScreenInfo;
|
|
FChromium.OnPopupShow := {$IFDEF FPC}@{$ENDIF}DoGetChromiumPopupShow;
|
|
FChromium.OnPopupSize := {$IFDEF FPC}@{$ENDIF}DoGetChromiumPopupSize;
|
|
FChromium.OnTooltip := {$IFDEF FPC}@{$ENDIF}DoGetChromiumTooltip;
|
|
FChromium.OnBeforePopup := {$IFDEF FPC}@{$ENDIF}DoGetChromiumBeforePopup;
|
|
FChromium.OnIMECompositionRangeChanged := @DoGetChromiumIMECompositionRangeChanged;
|
|
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csOwnedChildrenNotSelectable];
|
|
CopyOriginalBuffer := true;
|
|
end;
|
|
|
|
destructor TOsrBrowserWindow.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
FreeAndNil(FResizeCS);
|
|
if (FDeviceBounds <> nil) then
|
|
begin
|
|
Finalize(FDeviceBounds);
|
|
FDeviceBounds := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.CloseBrowser(aForceClose: boolean);
|
|
begin
|
|
FChromium.CloseBrowser(aForceClose);
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.WaitForBrowserClosed;
|
|
begin
|
|
if not FChromium.HasBrowser then
|
|
exit;
|
|
FChromium.CloseBrowser(True);
|
|
|
|
while FChromium.HasBrowser do begin
|
|
Application.ProcessMessages;
|
|
if GlobalCEFApp.ExternalMessagePump then
|
|
GlobalCEFApp.DoMessageLoopWork;
|
|
sleep(5);
|
|
end;
|
|
|
|
// TODO : sent closed?
|
|
end;
|
|
|
|
function TOsrBrowserWindow.IsClosed: boolean;
|
|
begin
|
|
Result := not FChromium.HasBrowser;
|
|
end;
|
|
|
|
procedure TOsrBrowserWindow.LoadURL(aURL: ustring);
|
|
begin
|
|
FChromium.LoadURL(aURL);
|
|
end;
|
|
|
|
|
|
{$IFDEF FPC}
|
|
procedure Register;
|
|
begin
|
|
{$I res/TOsrBrowserWindow.lrs}
|
|
RegisterComponents('Chromium', [TOsrBrowserWindow]);
|
|
RegisterClass(TEmbeddedOsrChromium);
|
|
RegisterPropertyEditor(TypeInfo(TOnClose), TEmbeddedOsrChromium,'OnClose',THiddenPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TOnPaint), TEmbeddedOsrChromium,'OnPaint',THiddenPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TOnGetViewRect), TEmbeddedOsrChromium,'OnGetViewRect',THiddenPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TOnCursorChange), TEmbeddedOsrChromium,'OnCursorChange',THiddenPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TOnGetScreenPoint), TEmbeddedOsrChromium,'OnGetScreenPoint',THiddenPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TOnGetScreenInfo), TEmbeddedOsrChromium,'OnGetScreenInfo',THiddenPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TOnPopupShow), TEmbeddedOsrChromium,'OnPopupShow',THiddenPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TOnPopupSize), TEmbeddedOsrChromium,'OnPopupSize',THiddenPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TOnTooltip), TEmbeddedOsrChromium,'OnTooltip',THiddenPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TOnBeforePopup), TEmbeddedOsrChromium,'OnBeforePopup',THiddenPropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(TOnIMECompositionRangeChanged), TEmbeddedOsrChromium,'OnIMECompositionRangeChanged',THiddenPropertyEditor);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
end.
|
|
|