// ************************************************************************ // ***************************** 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 * 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; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, uCEFChromium, GR32_Image, Vcl.AppEvnts, uCEFTypes, uCEFInterfaces; type TForm1 = class(TForm) Panel1: TPanel; Edit1: TEdit; Button1: TButton; PaintBox: TPaintBox32; chrmosr: TChromium; AppEvents: TApplicationEvents; 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 Button1Click(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); private function getModifiers(Shift: TShiftState): TCefEventFlags; function GetButton(Button: TMouseButton): TCefMouseButtonType; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean); var event: TCefKeyEvent; begin case Msg.message of WM_CHAR: begin FillChar(event, SizeOf(TCefKeyEvent), 0); event.kind := KEYEVENT_CHAR; event.windows_key_code := Msg.wParam; event.native_key_code := Msg.lParam; chrmosr.SendKeyEvent(@event); end; end; end; procedure TForm1.Button1Click(Sender: TObject); begin chrmosr.LoadURL(Edit1.Text); end; procedure TForm1.chrmosrCursorChange(Sender: TObject; const browser: ICefBrowser; cursor: HICON; cursorType: TCefCursorType; const customCursorInfo: PCefCursorInfo); begin case cursorType of CT_POINTER: PaintBox.Cursor := crArrow; CT_CROSS: PaintBox.Cursor:= crCross; CT_HAND: PaintBox.Cursor := crHandPoint; CT_IBEAM: PaintBox.Cursor := crIBeam; CT_WAIT: PaintBox.Cursor := crHourGlass; CT_HELP: PaintBox.Cursor := crHelp; CT_EASTRESIZE: PaintBox.Cursor := crSizeWE; CT_NORTHRESIZE: PaintBox.Cursor := crSizeNS; CT_NORTHEASTRESIZE: PaintBox.Cursor:= crSizeNESW; CT_NORTHWESTRESIZE: PaintBox.Cursor:= crSizeNWSE; CT_SOUTHRESIZE: PaintBox.Cursor:= crSizeNS; CT_SOUTHEASTRESIZE: PaintBox.Cursor:= crSizeNWSE; CT_SOUTHWESTRESIZE: PaintBox.Cursor:= crSizeNESW; CT_WESTRESIZE: PaintBox.Cursor := crSizeWE; CT_NORTHSOUTHRESIZE: PaintBox.Cursor:= crSizeNS; CT_EASTWESTRESIZE: PaintBox.Cursor := crSizeWE; CT_NORTHEASTSOUTHWESTRESIZE: PaintBox.Cursor:= crSizeNESW; CT_NORTHWESTSOUTHEASTRESIZE: PaintBox.Cursor:= crSizeNWSE; CT_COLUMNRESIZE: PaintBox.Cursor:= crHSplit; CT_ROWRESIZE: PaintBox.Cursor:= crVSplit; CT_MOVE: PaintBox.Cursor := crSizeAll; CT_PROGRESS: PaintBox.Cursor := crAppStart; CT_NODROP: PaintBox.Cursor:= crNo; CT_NONE: PaintBox.Cursor:= crNone; CT_NOTALLOWED: PaintBox.Cursor:= crNo; else PaintBox.Cursor := crArrow; end; 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, viewY: Integer; screenX, 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, 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; function TForm1.getModifiers(Shift: TShiftState): TCefEventFlags; begin Result := []; if ssShift in Shift then Include(Result, EVENTFLAG_SHIFT_DOWN); if ssAlt in Shift then Include(Result, EVENTFLAG_ALT_DOWN); if ssCtrl in Shift then Include(Result, EVENTFLAG_CONTROL_DOWN); if ssLeft in Shift then Include(Result, EVENTFLAG_LEFT_MOUSE_BUTTON); if ssRight in Shift then Include(Result, EVENTFLAG_RIGHT_MOUSE_BUTTON); if ssMiddle in Shift then Include(Result, 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.FormShow(Sender: TObject); begin chrmosr.CreateBrowser(nil, ''); end; procedure TForm1.PaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var event: TCefMouseEvent; begin event.x := X; event.y := Y; event.modifiers := getModifiers(Shift); chrmosr.SendMouseClickEvent(@event, GetButton(Button), False, 1); end; procedure TForm1.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var event: TCefMouseEvent; begin event.x := X; event.y := Y; event.modifiers := getModifiers(Shift); chrmosr.SendMouseMoveEvent(@event, not PaintBox.MouseInControl); end; procedure TForm1.PaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var event: TCefMouseEvent; begin event.x := X; event.y := Y; event.modifiers := getModifiers(Shift); chrmosr.SendMouseClickEvent(@event, GetButton(Button), True, 1); end; procedure TForm1.PaintBoxMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var event: TCefMouseEvent; begin event.x := MousePos.X; event.y := MousePos.Y; event.modifiers := getModifiers(Shift); chrmosr.SendMouseWheelEvent(@event, 0, WheelDelta); end; procedure TForm1.PaintBoxResize(Sender: TObject); begin PaintBox.Buffer.SetSize(PaintBox.Width, PaintBox.Height); chrmosr.WasResized; chrmosr.SendFocusEvent(True); end; end.