mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2024-11-16 08:15:55 +01:00
5766453f91
- Bug fix #33 : Drag and drop is now supported in OSR mode. - Improved keyboard handling in OSR mode. - MiniBrowser demo : The DOM visitor and the Javascript extensions now send customized results to the main form - Fixed some CEF3 variable definitions.
478 lines
17 KiB
ObjectPascal
478 lines
17 KiB
ObjectPascal
// ************************************************************************
|
|
// ***************************** CEF4Delphi *******************************
|
|
// ************************************************************************
|
|
//
|
|
// CEF4Delphi is based on DCEF3 which uses CEF3 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 © 2017 Salvador Díaz 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 uSimpleOSRBrowser;
|
|
|
|
{$I cef.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF DELPHI16_UP}
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
|
|
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.AppEvnts,
|
|
{$ELSE}
|
|
Windows, Messages, SysUtils, Variants, Classes,
|
|
Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, AppEvnts,
|
|
{$ENDIF}
|
|
GR32_Image, // You need the Graphics32 components for this demo available at http://graphics32.org
|
|
uCEFChromium, uCEFTypes, uCEFInterfaces;
|
|
|
|
const
|
|
MINIBROWSER_CREATED = WM_APP + $100;
|
|
|
|
type
|
|
TForm1 = class(TForm)
|
|
NavControlPnl: TPanel;
|
|
GoBtn: TButton;
|
|
chrmosr: TChromium;
|
|
AppEvents: TApplicationEvents;
|
|
Panel1: TPanel; // This is just a quick and dirty hack to receive some events that the PaintBox can't receive.
|
|
PaintBox: TPaintBox32;
|
|
ComboBox1: TComboBox;
|
|
procedure FormShow(Sender: TObject);
|
|
procedure PaintBoxResize(Sender: TObject);
|
|
procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
|
|
procedure PaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
|
procedure chrmosrPaint(Sender: TObject; const browser: ICefBrowser; kind: TCefPaintElementType; dirtyRectsCount: NativeUInt; const dirtyRects: PCefRectArray; const buffer: Pointer; width, height: Integer);
|
|
procedure chrmosrGetRootScreenRect(Sender: TObject; const browser: ICefBrowser; rect: PCefRect; out Result: Boolean);
|
|
procedure chrmosrCursorChange(Sender: TObject; const browser: ICefBrowser; cursor: HICON; cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo);
|
|
procedure PaintBoxMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
|
|
procedure GoBtnClick(Sender: TObject);
|
|
procedure chrmosrGetViewRect(Sender: TObject; const browser: ICefBrowser; rect: PCefRect; out Result: Boolean);
|
|
procedure chrmosrGetScreenPoint(Sender: TObject; const browser: ICefBrowser; viewX, viewY: Integer; screenX, screenY: PInteger; out Result: Boolean);
|
|
procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer);
|
|
procedure chrmosrPopupShow(Sender: TObject; const browser: ICefBrowser; show: Boolean);
|
|
procedure chrmosrPopupSize(Sender: TObject; const browser: ICefBrowser; const rect: PCefRect);
|
|
procedure chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser);
|
|
procedure Panel1Enter(Sender: TObject);
|
|
procedure Panel1Exit(Sender: TObject);
|
|
procedure FormHide(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure PaintBoxClick(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
|
|
private
|
|
function getModifiers(Shift: TShiftState): TCefEventFlags;
|
|
function GetButton(Button: TMouseButton): TCefMouseButtonType;
|
|
|
|
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
|
|
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
|
|
procedure BrowserCreatedMsg(var aMessage : TMessage); message MINIBROWSER_CREATED;
|
|
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
uses
|
|
uCEFMiscFunctions, uCEFConstants;
|
|
|
|
procedure TForm1.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
|
|
var
|
|
TempEvent : TCefKeyEvent;
|
|
begin
|
|
case Msg.message of
|
|
WM_SYSCHAR :
|
|
if (Panel1.Focused or chrmosr.FrameIsFocused) and
|
|
(Msg.wParam in [VK_BACK..VK_HELP]) then
|
|
begin
|
|
TempEvent.kind := KEYEVENT_CHAR;
|
|
TempEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam);
|
|
TempEvent.windows_key_code := Msg.wParam;
|
|
TempEvent.native_key_code := Msg.lParam;
|
|
TempEvent.is_system_key := ord(True);
|
|
TempEvent.character := #0;
|
|
TempEvent.unmodified_character := #0;
|
|
TempEvent.focus_on_editable_field := ord(False);
|
|
|
|
chrmosr.SendKeyEvent(@TempEvent);
|
|
Handled := True;
|
|
end;
|
|
|
|
WM_SYSKEYDOWN :
|
|
if (Panel1.Focused or chrmosr.FrameIsFocused) and
|
|
(Msg.wParam in [VK_BACK..VK_HELP]) then
|
|
begin
|
|
TempEvent.kind := KEYEVENT_RAWKEYDOWN;
|
|
TempEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam);
|
|
TempEvent.windows_key_code := Msg.wParam;
|
|
TempEvent.native_key_code := Msg.lParam;
|
|
TempEvent.is_system_key := ord(True);
|
|
TempEvent.character := #0;
|
|
TempEvent.unmodified_character := #0;
|
|
TempEvent.focus_on_editable_field := ord(False);
|
|
|
|
chrmosr.SendKeyEvent(@TempEvent);
|
|
Handled := True;
|
|
end;
|
|
|
|
WM_SYSKEYUP :
|
|
if (Panel1.Focused or chrmosr.FrameIsFocused) and
|
|
(Msg.wParam in [VK_BACK..VK_HELP]) then
|
|
begin
|
|
TempEvent.kind := KEYEVENT_KEYUP;
|
|
TempEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam);
|
|
TempEvent.windows_key_code := Msg.wParam;
|
|
TempEvent.native_key_code := Msg.lParam;
|
|
TempEvent.is_system_key := ord(True);
|
|
TempEvent.character := #0;
|
|
TempEvent.unmodified_character := #0;
|
|
TempEvent.focus_on_editable_field := ord(False);
|
|
|
|
chrmosr.SendKeyEvent(@TempEvent);
|
|
Handled := True;
|
|
end;
|
|
|
|
WM_KEYDOWN :
|
|
if (Panel1.Focused or chrmosr.FrameIsFocused) and
|
|
(Msg.wParam in [VK_BACK..VK_HELP]) then
|
|
begin
|
|
TempEvent.kind := KEYEVENT_RAWKEYDOWN;
|
|
TempEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam);
|
|
TempEvent.windows_key_code := Msg.wParam;
|
|
TempEvent.native_key_code := Msg.lParam;
|
|
TempEvent.is_system_key := ord(False);
|
|
TempEvent.character := #0;
|
|
TempEvent.unmodified_character := #0;
|
|
TempEvent.focus_on_editable_field := ord(False);
|
|
|
|
chrmosr.SendKeyEvent(@TempEvent);
|
|
Handled := True;
|
|
end;
|
|
|
|
WM_KEYUP :
|
|
if (Panel1.Focused or chrmosr.FrameIsFocused) and
|
|
(Msg.wParam in [VK_BACK..VK_HELP]) then
|
|
begin
|
|
TempEvent.kind := KEYEVENT_KEYUP;
|
|
TempEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam);
|
|
TempEvent.windows_key_code := Msg.wParam;
|
|
TempEvent.native_key_code := Msg.lParam;
|
|
TempEvent.is_system_key := ord(False);
|
|
TempEvent.character := #0;
|
|
TempEvent.unmodified_character := #0;
|
|
TempEvent.focus_on_editable_field := ord(False);
|
|
|
|
chrmosr.SendKeyEvent(@TempEvent);
|
|
Handled := True;
|
|
end;
|
|
|
|
WM_CHAR :
|
|
if Panel1.Focused or chrmosr.FrameIsFocused then
|
|
begin
|
|
TempEvent.kind := KEYEVENT_CHAR;
|
|
TempEvent.modifiers := GetCefKeyboardModifiers(Msg.wParam, Msg.lParam);
|
|
TempEvent.windows_key_code := Msg.wParam;
|
|
TempEvent.native_key_code := Msg.lParam;
|
|
TempEvent.is_system_key := ord(False);
|
|
TempEvent.character := #0;
|
|
TempEvent.unmodified_character := #0;
|
|
TempEvent.focus_on_editable_field := ord(False);
|
|
|
|
chrmosr.SendKeyEvent(@TempEvent);
|
|
Handled := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.GoBtnClick(Sender: TObject);
|
|
begin
|
|
chrmosr.LoadURL(ComboBox1.Text);
|
|
end;
|
|
|
|
procedure TForm1.chrmosrAfterCreated(Sender: TObject; const browser: ICefBrowser);
|
|
begin
|
|
PostMessage(Handle, MINIBROWSER_CREATED, 0, 0);
|
|
end;
|
|
|
|
procedure TForm1.chrmosrCursorChange(Sender : TObject;
|
|
const browser : ICefBrowser;
|
|
cursor : HICON;
|
|
cursorType : TCefCursorType;
|
|
const customCursorInfo : PCefCursorInfo);
|
|
begin
|
|
PaintBox.Cursor := GefCursorToWindowsCursor(cursorType);
|
|
end;
|
|
|
|
procedure TForm1.chrmosrGetRootScreenRect(Sender : TObject;
|
|
const browser : ICefBrowser;
|
|
rect : PCefRect;
|
|
out Result : Boolean);
|
|
begin
|
|
rect.x := 0;
|
|
rect.y := 0;
|
|
rect.width := PaintBox.Width;
|
|
rect.height := PaintBox.Height;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TForm1.chrmosrGetScreenPoint(Sender : TObject;
|
|
const browser : ICefBrowser;
|
|
viewX : Integer;
|
|
viewY : Integer;
|
|
screenX : PInteger;
|
|
screenY : PInteger;
|
|
out Result : Boolean);
|
|
var
|
|
TempScreenPt, TempViewPt : TPoint;
|
|
begin
|
|
TempViewPt.x := viewX;
|
|
TempViewPt.y := viewY;
|
|
TempScreenPt := PaintBox.ClientToScreen(TempViewPt);
|
|
screenX^ := TempScreenPt.x;
|
|
screenY^ := TempScreenPt.y;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TForm1.chrmosrGetViewRect(Sender : TObject;
|
|
const browser : ICefBrowser;
|
|
rect : PCefRect;
|
|
out Result : Boolean);
|
|
begin
|
|
rect.x := 0;
|
|
rect.y := 0;
|
|
rect.width := PaintBox.Width;
|
|
rect.height := PaintBox.Height;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TForm1.chrmosrPaint(Sender : TObject;
|
|
const browser : ICefBrowser;
|
|
kind : TCefPaintElementType;
|
|
dirtyRectsCount : NativeUInt;
|
|
const dirtyRects : PCefRectArray;
|
|
const buffer : Pointer;
|
|
width : Integer;
|
|
height : Integer);
|
|
var
|
|
src, dst: PByte;
|
|
offset, i, j, w: Integer;
|
|
begin
|
|
if (width <> PaintBox.Width) or (height <> PaintBox.Height) then Exit;
|
|
|
|
with PaintBox.Buffer do
|
|
begin
|
|
PaintBox.Canvas.Lock;
|
|
Lock;
|
|
try
|
|
for j := 0 to dirtyRectsCount - 1 do
|
|
begin
|
|
w := Width * 4;
|
|
offset := ((dirtyRects[j].y * Width) + dirtyRects[j].x) * 4;
|
|
src := @PByte(buffer)[offset];
|
|
dst := @PByte(Bits)[offset];
|
|
offset := dirtyRects[j].width * 4;
|
|
for i := 0 to dirtyRects[j].height - 1 do
|
|
begin
|
|
Move(src^, dst^, offset);
|
|
Inc(dst, w);
|
|
Inc(src, w);
|
|
end;
|
|
PaintBox.Flush(Rect(dirtyRects[j].x, dirtyRects[j].y,
|
|
dirtyRects[j].x + dirtyRects[j].width, dirtyRects[j].y + dirtyRects[j].height));
|
|
end;
|
|
finally
|
|
Unlock;
|
|
PaintBox.Canvas.Unlock;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.chrmosrPopupShow(Sender : TObject;
|
|
const browser : ICefBrowser;
|
|
show : Boolean);
|
|
begin
|
|
// TO DO : Needed to draw the "select" items
|
|
end;
|
|
|
|
procedure TForm1.chrmosrPopupSize(Sender : TObject;
|
|
const browser : ICefBrowser;
|
|
const rect : PCefRect);
|
|
begin
|
|
// TO DO : Needed to draw the "select" items
|
|
end;
|
|
|
|
function TForm1.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 (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 TForm1.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 TForm1.WMMove(var aMessage : TWMMove);
|
|
begin
|
|
inherited;
|
|
|
|
if (chrmosr <> nil) then chrmosr.NotifyMoveOrResizeStarted;
|
|
end;
|
|
|
|
procedure TForm1.WMMoving(var aMessage : TMessage);
|
|
begin
|
|
inherited;
|
|
|
|
if (chrmosr <> nil) then chrmosr.NotifyMoveOrResizeStarted;
|
|
end;
|
|
|
|
procedure TForm1.BrowserCreatedMsg(var aMessage : TMessage);
|
|
begin
|
|
NavControlPnl.Enabled := True;
|
|
GoBtn.Click;
|
|
end;
|
|
|
|
procedure TForm1.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer);
|
|
begin
|
|
if (chrmosr <> nil) then
|
|
begin
|
|
chrmosr.NotifyScreenInfoChanged;
|
|
chrmosr.WasResized;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
chrmosr.Options.BackgroundColor := CefColorSetARGB($FF, $FF, $FF, $FF); // opaque white background color
|
|
chrmosr.CreateBrowser(nil, '');
|
|
chrmosr.InitializeDragAndDrop(PaintBox);
|
|
end;
|
|
|
|
procedure TForm1.FormDestroy(Sender: TObject);
|
|
begin
|
|
chrmosr.ShutdownDragAndDrop;
|
|
end;
|
|
|
|
procedure TForm1.FormHide(Sender: TObject);
|
|
begin
|
|
chrmosr.SendFocusEvent(False);
|
|
chrmosr.WasHidden(True);
|
|
end;
|
|
|
|
procedure TForm1.FormShow(Sender: TObject);
|
|
begin
|
|
chrmosr.WasHidden(False);
|
|
chrmosr.SendFocusEvent(True);
|
|
end;
|
|
|
|
procedure TForm1.PaintBoxClick(Sender: TObject);
|
|
begin
|
|
Panel1.SetFocus;
|
|
end;
|
|
|
|
procedure TForm1.PaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
TempEvent : TCefMouseEvent;
|
|
begin
|
|
TempEvent.x := X;
|
|
TempEvent.y := Y;
|
|
TempEvent.modifiers := getModifiers(Shift);
|
|
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), False, 1);
|
|
end;
|
|
|
|
procedure TForm1.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
TempEvent : TCefMouseEvent;
|
|
begin
|
|
TempEvent.x := X;
|
|
TempEvent.y := Y;
|
|
TempEvent.modifiers := getModifiers(Shift);
|
|
chrmosr.SendMouseMoveEvent(@TempEvent, not PaintBox.MouseInControl);
|
|
end;
|
|
|
|
procedure TForm1.PaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
TempEvent : TCefMouseEvent;
|
|
begin
|
|
TempEvent.x := X;
|
|
TempEvent.y := Y;
|
|
TempEvent.modifiers := getModifiers(Shift);
|
|
chrmosr.SendMouseClickEvent(@TempEvent, GetButton(Button), True, 1);
|
|
end;
|
|
|
|
procedure TForm1.PaintBoxMouseWheel(Sender : TObject;
|
|
Shift : TShiftState;
|
|
WheelDelta : Integer;
|
|
MousePos : TPoint;
|
|
var Handled : Boolean);
|
|
var
|
|
TempEvent : TCefMouseEvent;
|
|
begin
|
|
TempEvent.x := MousePos.X;
|
|
TempEvent.y := MousePos.Y;
|
|
TempEvent.modifiers := getModifiers(Shift);
|
|
chrmosr.SendMouseWheelEvent(@TempEvent, 0, WheelDelta);
|
|
end;
|
|
|
|
procedure TForm1.PaintBoxResize(Sender: TObject);
|
|
begin
|
|
PaintBox.Buffer.SetSize(PaintBox.Width, PaintBox.Height);
|
|
chrmosr.WasResized;
|
|
end;
|
|
|
|
procedure TForm1.Panel1Enter(Sender: TObject);
|
|
begin
|
|
chrmosr.SendFocusEvent(True);
|
|
end;
|
|
|
|
procedure TForm1.Panel1Exit(Sender: TObject);
|
|
begin
|
|
chrmosr.SendFocusEvent(False);
|
|
end;
|
|
|
|
end.
|