You've already forked CEF4Delphi
mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2025-06-12 22:07:39 +02:00
demos
This commit is contained in:
Salvador Diaz Fau
299
demos/SimpleOSRBrowser/uSimpleOSRBrowser.pas
Normal file
299
demos/SimpleOSRBrowser/uSimpleOSRBrowser.pas
Normal file
@ -0,0 +1,299 @@
|
||||
// ************************************************************************
|
||||
// ***************************** 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;
|
||||
|
||||
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.
|
||||
Reference in New Issue
Block a user