├── Demo ├── FiremonkeyContainerDemo.res ├── FiremonkeyContainerDemo.dpr ├── FMX3DForm.pas ├── FMXForm.pas ├── FMX3DForm.fmx ├── VCLForm.dfm ├── VCLForm.pas ├── FMXForm.fmx └── FiremonkeyContainerDemo.dproj ├── README.md ├── .gitignore ├── LICENSE └── FMX.Container.pas /Demo/FiremonkeyContainerDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/landrix/Delphi-Firemonkey-Container/HEAD/Demo/FiremonkeyContainerDemo.res -------------------------------------------------------------------------------- /Demo/FiremonkeyContainerDemo.dpr: -------------------------------------------------------------------------------- 1 | program FiremonkeyContainerDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | VCLForm in 'VCLForm.pas' {Form1}, 6 | FMXForm in 'FMXForm.pas' {FireMonkeyForm}, 7 | FMX3DForm in 'FMX3DForm.pas' {FormExample3D}; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.MainFormOnTaskbar := True; 14 | Application.CreateForm(TForm1, Form1); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Delphi-Firemonkey-Container 2 | 3 | TFireMonkeyContainer is a Delphi VCL component to host a FMX HD or 3D form. It means you can embed a FireMonkey (FMX) form as a control in a VCL form, so you can design a FMX form and use it in your VCL app. 4 | 5 | - Original project: https://github.com/vintagedave/firemonkey-container 6 | - Original project home page: http://parnassus.co/open-source/tfiremonkeycontainer 7 | - This project used to be hosted on Google Code (code.google.com/p/firemonkey-container) and was migrated on 2015-03-12. 8 | 9 | Relaunched 2024 06 21 by Sven Harazim 10 | 11 | - https://github.com/landrix/Delphi-Firemonkey-Container -------------------------------------------------------------------------------- /Demo/FMX3DForm.pas: -------------------------------------------------------------------------------- 1 | unit FMX3DForm; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.Variants, System.UITypes, 7 | System.Classes, FMX.Types, FMX.Dialogs, FMX.Types3D, FMX.Forms, 8 | FMX.Forms3D, FMX.Controls3D, FMX.Objects3D, FMX.StdCtrls, FMX.Controls, FMX.Ani, 9 | FMX.MaterialSources, System.Math.Vectors; 10 | 11 | type 12 | TFormExample3D = class(TForm3D) 13 | Camera1: TCamera; 14 | RoundCube1: TRoundCube; 15 | LightMaterialSource1: TLightMaterialSource; 16 | animRotateX: TFloatAnimation; 17 | animRotateY: TFloatAnimation; 18 | Light1: TLight; 19 | Light2: TLight; 20 | private 21 | { Private declarations } 22 | public 23 | { Public declarations } 24 | end; 25 | 26 | var 27 | FormExample3D: TFormExample3D; 28 | 29 | implementation 30 | 31 | {$R *.fmx} 32 | 33 | end. 34 | -------------------------------------------------------------------------------- /Demo/FMXForm.pas: -------------------------------------------------------------------------------- 1 | unit FMXForm; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes, 7 | System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, 8 | FMX.StdCtrls, FMX.Effects, FMX.Colors, FMX.TabControl, FMX.Menus, 9 | FMX.Filter.Effects, FMX.Edit, FMX.Controls.Presentation, 10 | FMX.DialogService; 11 | 12 | type 13 | TFireMonkeyForm = class(TForm) 14 | Button1: TButton; 15 | GroupBox1: TGroupBox; 16 | ShadowEffect1: TShadowEffect; 17 | Button2: TButton; 18 | ReflectionEffect1: TReflectionEffect; 19 | Edit1: TEdit; 20 | GlowEffect1: TGlowEffect; 21 | TabControl1: TTabControl; 22 | TabItem1: TTabItem; 23 | AlphaTrackBar1: TAlphaTrackBar; 24 | TabItem2: TTabItem; 25 | Switch1: TSwitch; 26 | AniIndicator1: TAniIndicator; 27 | procedure ButtonClick(Sender: TObject); 28 | private 29 | { Private declarations } 30 | public 31 | { Public declarations } 32 | end; 33 | 34 | var 35 | FireMonkeyForm: TFireMonkeyForm; 36 | 37 | implementation 38 | 39 | {$R *.fmx} 40 | 41 | procedure TFireMonkeyForm.ButtonClick(Sender: TObject); 42 | begin 43 | FMX.DialogService.TDialogService.MessageDialog( 44 | 'Hello from ' + (Sender as TComponent).Name, 45 | TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK,0,nil); 46 | end; 47 | 48 | end. 49 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | Demo\Win32 30 | Demo\Win64 31 | Packages 32 | 33 | # Delphi compiler-generated binaries (safe to delete) 34 | *.exe 35 | *.dll 36 | *.bpl 37 | *.bpi 38 | *.dcp 39 | *.so 40 | *.apk 41 | *.drc 42 | *.map 43 | *.dres 44 | *.rsm 45 | *.tds 46 | *.dcu 47 | *.lib 48 | *.a 49 | *.o 50 | *.ocx 51 | 52 | # Delphi autogenerated files (duplicated info) 53 | *.cfg 54 | *.hpp 55 | *Resource.rc 56 | 57 | # Delphi local files (user-specific info) 58 | *.local 59 | *.identcache 60 | *.projdata 61 | *.tvsconfig 62 | *.dsk 63 | 64 | # Delphi history and backups 65 | __history/ 66 | __recovery/ 67 | *.~* 68 | 69 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 70 | *.stat -------------------------------------------------------------------------------- /Demo/FMX3DForm.fmx: -------------------------------------------------------------------------------- 1 | object FormExample3D: TFormExample3D 2 | Left = 0 3 | Top = 0 4 | Camera = Camera1 5 | Caption = 'Example 3D' 6 | ClientHeight = 272 7 | ClientWidth = 431 8 | FormFactor.Width = 320 9 | FormFactor.Height = 480 10 | FormFactor.Devices = [Desktop, iPhone, iPad] 11 | DesignerMasterStyle = 0 12 | object Camera1: TCamera 13 | AngleOfView = 45.000000000000000000 14 | Position.Z = -5.000000000000000000 15 | Width = 1.000000000000000000 16 | Height = 1.000000000000000000 17 | Depth = 1.000000000000000000 18 | end 19 | object RoundCube1: TRoundCube 20 | Width = 7.000000000000000000 21 | Height = 7.000000000000000000 22 | Depth = 7.000000000000000000 23 | MaterialSource = LightMaterialSource1 24 | object animRotateX: TFloatAnimation 25 | Enabled = True 26 | Duration = 3.000000000000000000 27 | Loop = True 28 | PropertyName = 'RotationAngle.X' 29 | StartValue = 0.000000000000000000 30 | StartFromCurrent = True 31 | StopValue = 360.000000000000000000 32 | end 33 | object animRotateY: TFloatAnimation 34 | Enabled = True 35 | Duration = 5.000000000000000000 36 | Loop = True 37 | PropertyName = 'RotationAngle.Y' 38 | StartValue = 0.000000000000000000 39 | StartFromCurrent = True 40 | StopValue = 360.000000000000000000 41 | end 42 | end 43 | object LightMaterialSource1: TLightMaterialSource 44 | Diffuse = claGray 45 | Ambient = xFF202020 46 | Emissive = claNull 47 | Specular = xFF606060 48 | Shininess = 30 49 | Left = 200 50 | Top = 120 51 | end 52 | object Light1: TLight 53 | Color = claSkyblue 54 | LightType = Directional 55 | SpotCutOff = 180.000000000000000000 56 | Position.X = 10.000000000000000000 57 | Position.Y = -7.000000000000000000 58 | Position.Z = 3.000000000000000000 59 | Width = 1.000000000000000000 60 | Height = 1.000000000000000000 61 | Depth = 1.000000000000000000 62 | end 63 | object Light2: TLight 64 | Color = claGray 65 | LightType = Directional 66 | SpotCutOff = 180.000000000000000000 67 | Position.X = -8.000000000000000000 68 | Position.Y = -3.000000000000000000 69 | Position.Z = -4.000000000000000000 70 | Width = 1.000000000000000000 71 | Height = 1.000000000000000000 72 | Depth = 1.000000000000000000 73 | end 74 | end 75 | -------------------------------------------------------------------------------- /Demo/VCLForm.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'TFireMonkeyContainer demo' 5 | ClientHeight = 340 6 | ClientWidth = 680 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OnCreate = FormCreate 14 | DesignSize = ( 15 | 680 16 | 340) 17 | TextHeight = 13 18 | object Label1: TLabel 19 | Left = 465 20 | Top = 18 21 | Width = 203 22 | Height = 19 23 | Anchors = [akTop, akRight] 24 | Caption = 'TFireMonkeyContainer demo' 25 | Font.Charset = DEFAULT_CHARSET 26 | Font.Color = clWindowText 27 | Font.Height = -16 28 | Font.Name = 'Tahoma' 29 | Font.Style = [] 30 | ParentFont = False 31 | end 32 | object Label2: TLabel 33 | Left = 465 34 | Top = 48 35 | Width = 203 36 | Height = 73 37 | Anchors = [akTop, akRight, akBottom] 38 | AutoSize = False 39 | Caption = 40 | 'This is a VCL form holding VCL controls. On the left is a TFireM' + 41 | 'onkeyContainer inside a TPanel (to show a border.) It is holdin' + 42 | 'g a FireMonkey form.' 43 | WordWrap = True 44 | end 45 | object Label3: TLabel 46 | Left = 465 47 | Top = 129 48 | Width = 213 49 | Height = 39 50 | Caption = 51 | 'FireMonkeyContainers get drag/drop events (pass these on to your' + 52 | ' embedded form however you want.)' 53 | WordWrap = True 54 | end 55 | object btnOpenAnotherForm: TButton 56 | Left = 465 57 | Top = 302 58 | Width = 203 59 | Height = 25 60 | Anchors = [akRight, akBottom] 61 | Caption = 'Open another form' 62 | TabOrder = 0 63 | OnClick = btnOpenAnotherFormClick 64 | end 65 | object PageControl1: TPageControl 66 | Left = 16 67 | Top = 18 68 | Width = 443 69 | Height = 309 70 | ActivePage = TabSheet1 71 | Anchors = [akLeft, akTop, akRight, akBottom] 72 | TabOrder = 1 73 | object TabSheet1: TTabSheet 74 | Caption = 'TabSheet1' 75 | object Panel1: TPanel 76 | AlignWithMargins = True 77 | Left = 1 78 | Top = 3 79 | Width = 431 80 | Height = 275 81 | Margins.Left = 1 82 | Align = alClient 83 | BevelInner = bvLowered 84 | Caption = 'Panel1' 85 | TabOrder = 0 86 | end 87 | end 88 | object TabSheet2: TTabSheet 89 | Caption = 'TabSheet2' 90 | ImageIndex = 1 91 | object Panel2: TPanel 92 | AlignWithMargins = True 93 | Left = 1 94 | Top = 3 95 | Width = 431 96 | Height = 275 97 | Margins.Left = 1 98 | Align = alClient 99 | BevelInner = bvLowered 100 | Caption = 'Panel1' 101 | TabOrder = 0 102 | end 103 | end 104 | end 105 | object btnDrag: TButton 106 | Left = 465 107 | Top = 171 108 | Width = 203 109 | Height = 30 110 | Anchors = [akTop, akRight] 111 | Caption = 'Drag me over a FMX form' 112 | DragMode = dmAutomatic 113 | TabOrder = 2 114 | end 115 | end 116 | -------------------------------------------------------------------------------- /Demo/VCLForm.pas: -------------------------------------------------------------------------------- 1 | unit VCLForm; 2 | 3 | interface 4 | 5 | uses 6 | FMX.Forms { must be included before Vcl.Forms so that 'TForm' below refers to a VCL form, not FMX}, 7 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 8 | System.Classes, Vcl.Graphics, System.UITypes, 9 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, FMXForm, FMX3DForm, Vcl.ExtCtrls, 10 | Vcl.StdCtrls, Vcl.ComCtrls, 11 | FMX.Container; 12 | 13 | type 14 | TForm1 = class(TForm) 15 | Label1: TLabel; 16 | Label2: TLabel; 17 | btnOpenAnotherForm: TButton; 18 | PageControl1: TPageControl; 19 | TabSheet1: TTabSheet; 20 | TabSheet2: TTabSheet; 21 | Panel1: TPanel; 22 | Panel2: TPanel; 23 | btnDrag: TButton; 24 | Label3: TLabel; 25 | procedure btnOpenAnotherFormClick(Sender: TObject); 26 | procedure FormCreate(Sender: TObject); 27 | private 28 | FireMonkeyContainer1: TFireMonkeyContainer; 29 | FireMonkeyContainer2: TFireMonkeyContainer; 30 | procedure FireMonkeyContainer1CreateFMXForm(var Form: TCommonCustomForm); 31 | procedure FireMonkeyContainer1DestroyFMXForm(var Form: TCommonCustomForm; 32 | var Action: TCloseHostedFMXFormAction); 33 | procedure FireMonkeyContainer2CreateFMXForm(var Form: TCommonCustomForm); 34 | procedure FireMonkeyContainer2DestroyFMXForm(var Form: TCommonCustomForm; 35 | var Action: TCloseHostedFMXFormAction); 36 | procedure FireMonkeyContainerDragOver(Sender, Source: TObject; X, Y: Integer; 37 | State: TDragState; var Accept: Boolean); 38 | procedure FireMonkeyContainerDragDrop(Sender, Source: TObject; X, Y: Integer); 39 | end; 40 | 41 | var 42 | Form1: TForm1; 43 | 44 | implementation 45 | 46 | {$R *.dfm} 47 | 48 | procedure TForm1.btnOpenAnotherFormClick(Sender: TObject); 49 | begin 50 | TForm1.Create(Application).Show; 51 | end; 52 | 53 | procedure TForm1.FireMonkeyContainer1CreateFMXForm(var Form: TCommonCustomForm); 54 | begin 55 | if not Assigned(Form) then Form := TFireMonkeyForm.Create(nil); 56 | end; 57 | 58 | procedure TForm1.FireMonkeyContainer1DestroyFMXForm(var Form: TCommonCustomForm; 59 | var Action: TCloseHostedFMXFormAction); 60 | begin 61 | Action := fcaFree; 62 | end; 63 | 64 | procedure TForm1.FireMonkeyContainer2CreateFMXForm(var Form: TCommonCustomForm); 65 | begin 66 | Form := TFormExample3D.Create(Application); 67 | end; 68 | 69 | procedure TForm1.FireMonkeyContainer2DestroyFMXForm(var Form: TCommonCustomForm; 70 | var Action: TCloseHostedFMXFormAction); 71 | begin 72 | Action := fcaNone; 73 | end; 74 | 75 | procedure TForm1.FireMonkeyContainerDragOver(Sender, Source: TObject; X, Y: Integer; 76 | State: TDragState; var Accept: Boolean); 77 | begin 78 | Accept := true; 79 | end; 80 | 81 | procedure TForm1.FormCreate(Sender: TObject); 82 | begin 83 | FireMonkeyContainer1:= TFireMonkeyContainer.Create(self); 84 | FireMonkeyContainer1.Parent := Panel1; 85 | FireMonkeyContainer1.Align := alClient; 86 | FireMonkeyContainer1.OnCreateFMXForm := FireMonkeyContainer1CreateFMXForm; 87 | FireMonkeyContainer1.OnDestroyFMXForm := FireMonkeyContainer1DestroyFMXForm; 88 | FireMonkeyContainer1.OnDragDrop := FireMonkeyContainerDragDrop; 89 | FireMonkeyContainer1.OnDragOver := FireMonkeyContainerDragOver; 90 | 91 | FireMonkeyContainer2:= TFireMonkeyContainer.Create(self); 92 | FireMonkeyContainer2.Parent := Panel2; 93 | FireMonkeyContainer2.Align := alClient; 94 | FireMonkeyContainer2.OnCreateFMXForm := FireMonkeyContainer2CreateFMXForm; 95 | FireMonkeyContainer2.OnDestroyFMXForm := FireMonkeyContainer2DestroyFMXForm; 96 | FireMonkeyContainer2.OnDragDrop := FireMonkeyContainerDragDrop; 97 | FireMonkeyContainer2.OnDragOver := FireMonkeyContainerDragOver; 98 | end; 99 | 100 | procedure TForm1.FireMonkeyContainerDragDrop(Sender, Source: TObject; X, Y: Integer); 101 | function GetObjectInfo(const Obj : TObject) : string; 102 | begin 103 | if not Assigned(Obj) then Exit('nil'); 104 | Result := Obj.ClassName; 105 | if Obj is TComponent then 106 | Result := (Obj as TComponent).Name; 107 | if Obj is TFireMonkeyContainer then 108 | Result := Result + ' which contains ' + GetObjectInfo((Obj as TFireMonkeyContainer).FireMonkeyForm); 109 | end; 110 | var 111 | DragInfo : string; 112 | begin 113 | DragInfo := 'You dragged ' + GetObjectInfo(Source) + ' onto ' + GetObjectInfo(Sender) + '.' 114 | + #13 + 'Mouse coords: ' + IntToStr(X) + ', ' + IntToStr(Y); 115 | MessageDlg(DragInfo, TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], 0); 116 | end; 117 | 118 | 119 | 120 | end. 121 | -------------------------------------------------------------------------------- /Demo/FMXForm.fmx: -------------------------------------------------------------------------------- 1 | object FireMonkeyForm: TFireMonkeyForm 2 | Left = 0 3 | Top = 0 4 | BorderIcons = [] 5 | Caption = 'Example 2D' 6 | ClientHeight = 272 7 | ClientWidth = 431 8 | Visible = True 9 | FormFactor.Width = 320 10 | FormFactor.Height = 480 11 | FormFactor.Devices = [Desktop, iPhone, iPad] 12 | DesignerMasterStyle = 0 13 | object GroupBox1: TGroupBox 14 | Margins.Left = 8.000000000000000000 15 | Margins.Top = 8.000000000000000000 16 | Margins.Right = 8.000000000000000000 17 | Margins.Bottom = 8.000000000000000000 18 | Position.X = 8.000000000000000000 19 | Position.Y = 8.000000000000000000 20 | Size.Width = 415.000000000000000000 21 | Size.Height = 257.000000000000000000 22 | Size.PlatformDefault = False 23 | Text = 'FireMonkey' 24 | TabOrder = 0 25 | object Button1: TButton 26 | Position.X = 24.000000000000000000 27 | Position.Y = 30.000000000000000000 28 | Size.Width = 80.000000000000000000 29 | Size.Height = 22.000000000000000000 30 | Size.PlatformDefault = False 31 | TabOrder = 0 32 | Text = 'Button1' 33 | TextSettings.Trimming = None 34 | OnClick = ButtonClick 35 | object ShadowEffect1: TShadowEffect 36 | Distance = 3.000000000000000000 37 | Direction = 45.000000000000000000 38 | Softness = 0.300000011920929000 39 | Opacity = 0.600000023841857900 40 | ShadowColor = claBlack 41 | end 42 | end 43 | object Button2: TButton 44 | Position.X = 24.000000000000000000 45 | Position.Y = 70.000000000000000000 46 | Size.Width = 80.000000000000000000 47 | Size.Height = 22.000000000000000000 48 | Size.PlatformDefault = False 49 | TabOrder = 1 50 | Text = 'Button2' 51 | TextSettings.Trimming = None 52 | OnClick = ButtonClick 53 | object ReflectionEffect1: TReflectionEffect 54 | Opacity = 0.500000000000000000 55 | Offset = 0 56 | Length = 0.500000000000000000 57 | end 58 | end 59 | object Edit1: TEdit 60 | Touch.InteractiveGestures = [LongTap, DoubleTap] 61 | TabOrder = 2 62 | Position.X = 144.000000000000000000 63 | Position.Y = 32.000000000000000000 64 | Size.Width = 257.000000000000000000 65 | Size.Height = 22.000000000000000000 66 | Size.PlatformDefault = False 67 | object GlowEffect1: TGlowEffect 68 | Softness = 0.400000005960464500 69 | GlowColor = claGold 70 | Opacity = 0.899999976158142100 71 | end 72 | end 73 | object TabControl1: TTabControl 74 | Position.X = 144.000000000000000000 75 | Position.Y = 80.000000000000000000 76 | Size.Width = 257.000000000000000000 77 | Size.Height = 164.000000000000000000 78 | Size.PlatformDefault = False 79 | TabIndex = 0 80 | TabOrder = 3 81 | TabPosition = Top 82 | Sizes = ( 83 | 257s 84 | 138s 85 | 257s 86 | 138s) 87 | object TabItem1: TTabItem 88 | CustomIcon = < 89 | item 90 | end> 91 | TextSettings.Trimming = None 92 | IsSelected = True 93 | Size.Width = 69.000000000000000000 94 | Size.Height = 26.000000000000000000 95 | Size.PlatformDefault = False 96 | StyleLookup = '' 97 | TabOrder = 0 98 | Text = 'TabItem1' 99 | ExplicitSize.cx = 50.000000000000000000 100 | ExplicitSize.cy = 50.000000000000000000 101 | object AlphaTrackBar1: TAlphaTrackBar 102 | CanParentFocus = True 103 | Orientation = Horizontal 104 | Position.X = 16.000000000000000000 105 | Position.Y = 18.000000000000000000 106 | Size.Width = 100.000000000000000000 107 | Size.Height = 19.000000000000000000 108 | Size.PlatformDefault = False 109 | TabOrder = 0 110 | end 111 | end 112 | object TabItem2: TTabItem 113 | CustomIcon = < 114 | item 115 | end> 116 | TextSettings.Trimming = None 117 | IsSelected = False 118 | Size.Width = 69.000000000000000000 119 | Size.Height = 26.000000000000000000 120 | Size.PlatformDefault = False 121 | StyleLookup = '' 122 | TabOrder = 0 123 | Text = 'TabItem2' 124 | ExplicitSize.cx = 50.000000000000000000 125 | ExplicitSize.cy = 50.000000000000000000 126 | end 127 | end 128 | object Switch1: TSwitch 129 | IsChecked = False 130 | Position.X = 24.000000000000000000 131 | Position.Y = 120.000000000000000000 132 | Size.Width = 78.000000000000000000 133 | Size.Height = 27.000000000000000000 134 | Size.PlatformDefault = False 135 | TabOrder = 4 136 | end 137 | object AniIndicator1: TAniIndicator 138 | Enabled = True 139 | Position.X = 24.000000000000000000 140 | Position.Y = 152.000000000000000000 141 | Size.Width = 105.000000000000000000 142 | Size.Height = 105.000000000000000000 143 | Size.PlatformDefault = False 144 | end 145 | end 146 | end 147 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MOZILLA PUBLIC LICENSE 2 | Version 1.1 3 | 4 | --------------- 5 | 6 | 1. Definitions. 7 | 8 | 1.0.1. "Commercial Use" means distribution or otherwise making the 9 | Covered Code available to a third party. 10 | 11 | 1.1. "Contributor" means each entity that creates or contributes to 12 | the creation of Modifications. 13 | 14 | 1.2. "Contributor Version" means the combination of the Original 15 | Code, prior Modifications used by a Contributor, and the Modifications 16 | made by that particular Contributor. 17 | 18 | 1.3. "Covered Code" means the Original Code or Modifications or the 19 | combination of the Original Code and Modifications, in each case 20 | including portions thereof. 21 | 22 | 1.4. "Electronic Distribution Mechanism" means a mechanism generally 23 | accepted in the software development community for the electronic 24 | transfer of data. 25 | 26 | 1.5. "Executable" means Covered Code in any form other than Source 27 | Code. 28 | 29 | 1.6. "Initial Developer" means the individual or entity identified 30 | as the Initial Developer in the Source Code notice required by Exhibit 31 | A. 32 | 33 | 1.7. "Larger Work" means a work which combines Covered Code or 34 | portions thereof with code not governed by the terms of this License. 35 | 36 | 1.8. "License" means this document. 37 | 38 | 1.8.1. "Licensable" means having the right to grant, to the maximum 39 | extent possible, whether at the time of the initial grant or 40 | subsequently acquired, any and all of the rights conveyed herein. 41 | 42 | 1.9. "Modifications" means any addition to or deletion from the 43 | substance or structure of either the Original Code or any previous 44 | Modifications. When Covered Code is released as a series of files, a 45 | Modification is: 46 | A. Any addition to or deletion from the contents of a file 47 | containing Original Code or previous Modifications. 48 | 49 | B. Any new file that contains any part of the Original Code or 50 | previous Modifications. 51 | 52 | 1.10. "Original Code" means Source Code of computer software code 53 | which is described in the Source Code notice required by Exhibit A as 54 | Original Code, and which, at the time of its release under this 55 | License is not already Covered Code governed by this License. 56 | 57 | 1.10.1. "Patent Claims" means any patent claim(s), now owned or 58 | hereafter acquired, including without limitation, method, process, 59 | and apparatus claims, in any patent Licensable by grantor. 60 | 61 | 1.11. "Source Code" means the preferred form of the Covered Code for 62 | making modifications to it, including all modules it contains, plus 63 | any associated interface definition files, scripts used to control 64 | compilation and installation of an Executable, or source code 65 | differential comparisons against either the Original Code or another 66 | well known, available Covered Code of the Contributor's choice. The 67 | Source Code can be in a compressed or archival form, provided the 68 | appropriate decompression or de-archiving software is widely available 69 | for no charge. 70 | 71 | 1.12. "You" (or "Your") means an individual or a legal entity 72 | exercising rights under, and complying with all of the terms of, this 73 | License or a future version of this License issued under Section 6.1. 74 | For legal entities, "You" includes any entity which controls, is 75 | controlled by, or is under common control with You. For purposes of 76 | this definition, "control" means (a) the power, direct or indirect, 77 | to cause the direction or management of such entity, whether by 78 | contract or otherwise, or (b) ownership of more than fifty percent 79 | (50%) of the outstanding shares or beneficial ownership of such 80 | entity. 81 | 82 | 2. Source Code License. 83 | 84 | 2.1. The Initial Developer Grant. 85 | The Initial Developer hereby grants You a world-wide, royalty-free, 86 | non-exclusive license, subject to third party intellectual property 87 | claims: 88 | (a) under intellectual property rights (other than patent or 89 | trademark) Licensable by Initial Developer to use, reproduce, 90 | modify, display, perform, sublicense and distribute the Original 91 | Code (or portions thereof) with or without Modifications, and/or 92 | as part of a Larger Work; and 93 | 94 | (b) under Patents Claims infringed by the making, using or 95 | selling of Original Code, to make, have made, use, practice, 96 | sell, and offer for sale, and/or otherwise dispose of the 97 | Original Code (or portions thereof). 98 | 99 | (c) the licenses granted in this Section 2.1(a) and (b) are 100 | effective on the date Initial Developer first distributes 101 | Original Code under the terms of this License. 102 | 103 | (d) Notwithstanding Section 2.1(b) above, no patent license is 104 | granted: 1) for code that You delete from the Original Code; 2) 105 | separate from the Original Code; or 3) for infringements caused 106 | by: i) the modification of the Original Code or ii) the 107 | combination of the Original Code with other software or devices. 108 | 109 | 2.2. Contributor Grant. 110 | Subject to third party intellectual property claims, each Contributor 111 | hereby grants You a world-wide, royalty-free, non-exclusive license 112 | 113 | (a) under intellectual property rights (other than patent or 114 | trademark) Licensable by Contributor, to use, reproduce, modify, 115 | display, perform, sublicense and distribute the Modifications 116 | created by such Contributor (or portions thereof) either on an 117 | unmodified basis, with other Modifications, as Covered Code 118 | and/or as part of a Larger Work; and 119 | 120 | (b) under Patent Claims infringed by the making, using, or 121 | selling of Modifications made by that Contributor either alone 122 | and/or in combination with its Contributor Version (or portions 123 | of such combination), to make, use, sell, offer for sale, have 124 | made, and/or otherwise dispose of: 1) Modifications made by that 125 | Contributor (or portions thereof); and 2) the combination of 126 | Modifications made by that Contributor with its Contributor 127 | Version (or portions of such combination). 128 | 129 | (c) the licenses granted in Sections 2.2(a) and 2.2(b) are 130 | effective on the date Contributor first makes Commercial Use of 131 | the Covered Code. 132 | 133 | (d) Notwithstanding Section 2.2(b) above, no patent license is 134 | granted: 1) for any code that Contributor has deleted from the 135 | Contributor Version; 2) separate from the Contributor Version; 136 | 3) for infringements caused by: i) third party modifications of 137 | Contributor Version or ii) the combination of Modifications made 138 | by that Contributor with other software (except as part of the 139 | Contributor Version) or other devices; or 4) under Patent Claims 140 | infringed by Covered Code in the absence of Modifications made by 141 | that Contributor. 142 | 143 | 3. Distribution Obligations. 144 | 145 | 3.1. Application of License. 146 | The Modifications which You create or to which You contribute are 147 | governed by the terms of this License, including without limitation 148 | Section 2.2. The Source Code version of Covered Code may be 149 | distributed only under the terms of this License or a future version 150 | of this License released under Section 6.1, and You must include a 151 | copy of this License with every copy of the Source Code You 152 | distribute. You may not offer or impose any terms on any Source Code 153 | version that alters or restricts the applicable version of this 154 | License or the recipients' rights hereunder. However, You may include 155 | an additional document offering the additional rights described in 156 | Section 3.5. 157 | 158 | 3.2. Availability of Source Code. 159 | Any Modification which You create or to which You contribute must be 160 | made available in Source Code form under the terms of this License 161 | either on the same media as an Executable version or via an accepted 162 | Electronic Distribution Mechanism to anyone to whom you made an 163 | Executable version available; and if made available via Electronic 164 | Distribution Mechanism, must remain available for at least twelve (12) 165 | months after the date it initially became available, or at least six 166 | (6) months after a subsequent version of that particular Modification 167 | has been made available to such recipients. You are responsible for 168 | ensuring that the Source Code version remains available even if the 169 | Electronic Distribution Mechanism is maintained by a third party. 170 | 171 | 3.3. Description of Modifications. 172 | You must cause all Covered Code to which You contribute to contain a 173 | file documenting the changes You made to create that Covered Code and 174 | the date of any change. You must include a prominent statement that 175 | the Modification is derived, directly or indirectly, from Original 176 | Code provided by the Initial Developer and including the name of the 177 | Initial Developer in (a) the Source Code, and (b) in any notice in an 178 | Executable version or related documentation in which You describe the 179 | origin or ownership of the Covered Code. 180 | 181 | 3.4. Intellectual Property Matters 182 | (a) Third Party Claims. 183 | If Contributor has knowledge that a license under a third party's 184 | intellectual property rights is required to exercise the rights 185 | granted by such Contributor under Sections 2.1 or 2.2, 186 | Contributor must include a text file with the Source Code 187 | distribution titled "LEGAL" which describes the claim and the 188 | party making the claim in sufficient detail that a recipient will 189 | know whom to contact. If Contributor obtains such knowledge after 190 | the Modification is made available as described in Section 3.2, 191 | Contributor shall promptly modify the LEGAL file in all copies 192 | Contributor makes available thereafter and shall take other steps 193 | (such as notifying appropriate mailing lists or newsgroups) 194 | reasonably calculated to inform those who received the Covered 195 | Code that new knowledge has been obtained. 196 | 197 | (b) Contributor APIs. 198 | If Contributor's Modifications include an application programming 199 | interface and Contributor has knowledge of patent licenses which 200 | are reasonably necessary to implement that API, Contributor must 201 | also include this information in the LEGAL file. 202 | 203 | (c) Representations. 204 | Contributor represents that, except as disclosed pursuant to 205 | Section 3.4(a) above, Contributor believes that Contributor's 206 | Modifications are Contributor's original creation(s) and/or 207 | Contributor has sufficient rights to grant the rights conveyed by 208 | this License. 209 | 210 | 3.5. Required Notices. 211 | You must duplicate the notice in Exhibit A in each file of the Source 212 | Code. If it is not possible to put such notice in a particular Source 213 | Code file due to its structure, then You must include such notice in a 214 | location (such as a relevant directory) where a user would be likely 215 | to look for such a notice. If You created one or more Modification(s) 216 | You may add your name as a Contributor to the notice described in 217 | Exhibit A. You must also duplicate this License in any documentation 218 | for the Source Code where You describe recipients' rights or ownership 219 | rights relating to Covered Code. You may choose to offer, and to 220 | charge a fee for, warranty, support, indemnity or liability 221 | obligations to one or more recipients of Covered Code. However, You 222 | may do so only on Your own behalf, and not on behalf of the Initial 223 | Developer or any Contributor. You must make it absolutely clear than 224 | any such warranty, support, indemnity or liability obligation is 225 | offered by You alone, and You hereby agree to indemnify the Initial 226 | Developer and every Contributor for any liability incurred by the 227 | Initial Developer or such Contributor as a result of warranty, 228 | support, indemnity or liability terms You offer. 229 | 230 | 3.6. Distribution of Executable Versions. 231 | You may distribute Covered Code in Executable form only if the 232 | requirements of Section 3.1-3.5 have been met for that Covered Code, 233 | and if You include a notice stating that the Source Code version of 234 | the Covered Code is available under the terms of this License, 235 | including a description of how and where You have fulfilled the 236 | obligations of Section 3.2. The notice must be conspicuously included 237 | in any notice in an Executable version, related documentation or 238 | collateral in which You describe recipients' rights relating to the 239 | Covered Code. You may distribute the Executable version of Covered 240 | Code or ownership rights under a license of Your choice, which may 241 | contain terms different from this License, provided that You are in 242 | compliance with the terms of this License and that the license for the 243 | Executable version does not attempt to limit or alter the recipient's 244 | rights in the Source Code version from the rights set forth in this 245 | License. If You distribute the Executable version under a different 246 | license You must make it absolutely clear that any terms which differ 247 | from this License are offered by You alone, not by the Initial 248 | Developer or any Contributor. You hereby agree to indemnify the 249 | Initial Developer and every Contributor for any liability incurred by 250 | the Initial Developer or such Contributor as a result of any such 251 | terms You offer. 252 | 253 | 3.7. Larger Works. 254 | You may create a Larger Work by combining Covered Code with other code 255 | not governed by the terms of this License and distribute the Larger 256 | Work as a single product. In such a case, You must make sure the 257 | requirements of this License are fulfilled for the Covered Code. 258 | 259 | 4. Inability to Comply Due to Statute or Regulation. 260 | 261 | If it is impossible for You to comply with any of the terms of this 262 | License with respect to some or all of the Covered Code due to 263 | statute, judicial order, or regulation then You must: (a) comply with 264 | the terms of this License to the maximum extent possible; and (b) 265 | describe the limitations and the code they affect. Such description 266 | must be included in the LEGAL file described in Section 3.4 and must 267 | be included with all distributions of the Source Code. Except to the 268 | extent prohibited by statute or regulation, such description must be 269 | sufficiently detailed for a recipient of ordinary skill to be able to 270 | understand it. 271 | 272 | 5. Application of this License. 273 | 274 | This License applies to code to which the Initial Developer has 275 | attached the notice in Exhibit A and to related Covered Code. 276 | 277 | 6. Versions of the License. 278 | 279 | 6.1. New Versions. 280 | Netscape Communications Corporation ("Netscape") may publish revised 281 | and/or new versions of the License from time to time. Each version 282 | will be given a distinguishing version number. 283 | 284 | 6.2. Effect of New Versions. 285 | Once Covered Code has been published under a particular version of the 286 | License, You may always continue to use it under the terms of that 287 | version. You may also choose to use such Covered Code under the terms 288 | of any subsequent version of the License published by Netscape. No one 289 | other than Netscape has the right to modify the terms applicable to 290 | Covered Code created under this License. 291 | 292 | 6.3. Derivative Works. 293 | If You create or use a modified version of this License (which you may 294 | only do in order to apply it to code which is not already Covered Code 295 | governed by this License), You must (a) rename Your license so that 296 | the phrases "Mozilla", "MOZILLAPL", "MOZPL", "Netscape", 297 | "MPL", "NPL" or any confusingly similar phrase do not appear in your 298 | license (except to note that your license differs from this License) 299 | and (b) otherwise make it clear that Your version of the license 300 | contains terms which differ from the Mozilla Public License and 301 | Netscape Public License. (Filling in the name of the Initial 302 | Developer, Original Code or Contributor in the notice described in 303 | Exhibit A shall not of themselves be deemed to be modifications of 304 | this License.) 305 | 306 | 7. DISCLAIMER OF WARRANTY. 307 | 308 | COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, 309 | WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, 310 | WITHOUT LIMITATION, WARRANTIES THAT THE COVERED CODE IS FREE OF 311 | DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE OR NON-INFRINGING. 312 | THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED CODE 313 | IS WITH YOU. SHOULD ANY COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, 314 | YOU (NOT THE INITIAL DEVELOPER OR ANY OTHER CONTRIBUTOR) ASSUME THE 315 | COST OF ANY NECESSARY SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER 316 | OF WARRANTY CONSTITUTES AN ESSENTIAL PART OF THIS LICENSE. NO USE OF 317 | ANY COVERED CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER THIS DISCLAIMER. 318 | 319 | 8. TERMINATION. 320 | 321 | 8.1. This License and the rights granted hereunder will terminate 322 | automatically if You fail to comply with terms herein and fail to cure 323 | such breach within 30 days of becoming aware of the breach. All 324 | sublicenses to the Covered Code which are properly granted shall 325 | survive any termination of this License. Provisions which, by their 326 | nature, must remain in effect beyond the termination of this License 327 | shall survive. 328 | 329 | 8.2. If You initiate litigation by asserting a patent infringement 330 | claim (excluding declatory judgment actions) against Initial Developer 331 | or a Contributor (the Initial Developer or Contributor against whom 332 | You file such action is referred to as "Participant") alleging that: 333 | 334 | (a) such Participant's Contributor Version directly or indirectly 335 | infringes any patent, then any and all rights granted by such 336 | Participant to You under Sections 2.1 and/or 2.2 of this License 337 | shall, upon 60 days notice from Participant terminate prospectively, 338 | unless if within 60 days after receipt of notice You either: (i) 339 | agree in writing to pay Participant a mutually agreeable reasonable 340 | royalty for Your past and future use of Modifications made by such 341 | Participant, or (ii) withdraw Your litigation claim with respect to 342 | the Contributor Version against such Participant. If within 60 days 343 | of notice, a reasonable royalty and payment arrangement are not 344 | mutually agreed upon in writing by the parties or the litigation claim 345 | is not withdrawn, the rights granted by Participant to You under 346 | Sections 2.1 and/or 2.2 automatically terminate at the expiration of 347 | the 60 day notice period specified above. 348 | 349 | (b) any software, hardware, or device, other than such Participant's 350 | Contributor Version, directly or indirectly infringes any patent, then 351 | any rights granted to You by such Participant under Sections 2.1(b) 352 | and 2.2(b) are revoked effective as of the date You first made, used, 353 | sold, distributed, or had made, Modifications made by that 354 | Participant. 355 | 356 | 8.3. If You assert a patent infringement claim against Participant 357 | alleging that such Participant's Contributor Version directly or 358 | indirectly infringes any patent where such claim is resolved (such as 359 | by license or settlement) prior to the initiation of patent 360 | infringement litigation, then the reasonable value of the licenses 361 | granted by such Participant under Sections 2.1 or 2.2 shall be taken 362 | into account in determining the amount or value of any payment or 363 | license. 364 | 365 | 8.4. In the event of termination under Sections 8.1 or 8.2 above, 366 | all end user license agreements (excluding distributors and resellers) 367 | which have been validly granted by You or any distributor hereunder 368 | prior to termination shall survive termination. 369 | 370 | 9. LIMITATION OF LIABILITY. 371 | 372 | UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, WHETHER TORT 373 | (INCLUDING NEGLIGENCE), CONTRACT, OR OTHERWISE, SHALL YOU, THE INITIAL 374 | DEVELOPER, ANY OTHER CONTRIBUTOR, OR ANY DISTRIBUTOR OF COVERED CODE, 375 | OR ANY SUPPLIER OF ANY OF SUCH PARTIES, BE LIABLE TO ANY PERSON FOR 376 | ANY INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES OF ANY 377 | CHARACTER INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF GOODWILL, 378 | WORK STOPPAGE, COMPUTER FAILURE OR MALFUNCTION, OR ANY AND ALL OTHER 379 | COMMERCIAL DAMAGES OR LOSSES, EVEN IF SUCH PARTY SHALL HAVE BEEN 380 | INFORMED OF THE POSSIBILITY OF SUCH DAMAGES. THIS LIMITATION OF 381 | LIABILITY SHALL NOT APPLY TO LIABILITY FOR DEATH OR PERSONAL INJURY 382 | RESULTING FROM SUCH PARTY'S NEGLIGENCE TO THE EXTENT APPLICABLE LAW 383 | PROHIBITS SUCH LIMITATION. SOME JURISDICTIONS DO NOT ALLOW THE 384 | EXCLUSION OR LIMITATION OF INCIDENTAL OR CONSEQUENTIAL DAMAGES, SO 385 | THIS EXCLUSION AND LIMITATION MAY NOT APPLY TO YOU. 386 | 387 | 10. U.S. GOVERNMENT END USERS. 388 | 389 | The Covered Code is a "commercial item," as that term is defined in 390 | 48 C.F.R. 2.101 (Oct. 1995), consisting of "commercial computer 391 | software" and "commercial computer software documentation," as such 392 | terms are used in 48 C.F.R. 12.212 (Sept. 1995). Consistent with 48 393 | C.F.R. 12.212 and 48 C.F.R. 227.7202-1 through 227.7202-4 (June 1995), 394 | all U.S. Government End Users acquire Covered Code with only those 395 | rights set forth herein. 396 | 397 | 11. MISCELLANEOUS. 398 | 399 | This License represents the complete agreement concerning subject 400 | matter hereof. If any provision of this License is held to be 401 | unenforceable, such provision shall be reformed only to the extent 402 | necessary to make it enforceable. This License shall be governed by 403 | California law provisions (except to the extent applicable law, if 404 | any, provides otherwise), excluding its conflict-of-law provisions. 405 | With respect to disputes in which at least one party is a citizen of, 406 | or an entity chartered or registered to do business in the United 407 | States of America, any litigation relating to this License shall be 408 | subject to the jurisdiction of the Federal Courts of the Northern 409 | District of California, with venue lying in Santa Clara County, 410 | California, with the losing party responsible for costs, including 411 | without limitation, court costs and reasonable attorneys' fees and 412 | expenses. The application of the United Nations Convention on 413 | Contracts for the International Sale of Goods is expressly excluded. 414 | Any law or regulation which provides that the language of a contract 415 | shall be construed against the drafter shall not apply to this 416 | License. 417 | 418 | 12. RESPONSIBILITY FOR CLAIMS. 419 | 420 | As between Initial Developer and the Contributors, each party is 421 | responsible for claims and damages arising, directly or indirectly, 422 | out of its utilization of rights under this License and You agree to 423 | work with Initial Developer and Contributors to distribute such 424 | responsibility on an equitable basis. Nothing herein is intended or 425 | shall be deemed to constitute any admission of liability. 426 | 427 | 13. MULTIPLE-LICENSED CODE. 428 | 429 | Initial Developer may designate portions of the Covered Code as 430 | "Multiple-Licensed". "Multiple-Licensed" means that the Initial 431 | Developer permits you to utilize portions of the Covered Code under 432 | Your choice of the MPL or the alternative licenses, if any, specified 433 | by the Initial Developer in the file described in Exhibit A. 434 | 435 | EXHIBIT A -Mozilla Public License. 436 | 437 | ``The contents of this file are subject to the Mozilla Public License 438 | Version 1.1 (the "License"); you may not use this file except in 439 | compliance with the License. You may obtain a copy of the License at 440 | https://www.mozilla.org/MPL/ 441 | 442 | Software distributed under the License is distributed on an "AS IS" 443 | basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the 444 | License for the specific language governing rights and limitations 445 | under the License. 446 | 447 | The Original Code is ______________________________________. 448 | 449 | The Initial Developer of the Original Code is ________________________. 450 | Portions created by ______________________ are Copyright (C) ______ 451 | _______________________. All Rights Reserved. 452 | 453 | Contributor(s): ______________________________________. 454 | 455 | Alternatively, the contents of this file may be used under the terms 456 | of the _____ license (the "[___] License"), in which case the 457 | provisions of [______] License are applicable instead of those 458 | above. If you wish to allow use of your version of this file only 459 | under the terms of the [____] License and not to allow others to use 460 | your version of this file under the MPL, indicate your decision by 461 | deleting the provisions above and replace them with the notice and 462 | other provisions required by the [___] License. If you do not delete 463 | the provisions above, a recipient may use your version of this file 464 | under either the MPL or the [___] License." 465 | 466 | [NOTE: The text of this Exhibit A may differ slightly from the text of 467 | the notices in the Source Code files of the Original Code. You should 468 | use the text of this Exhibit A rather than the text found in the 469 | Original Code Source Code for Your Modifications.] -------------------------------------------------------------------------------- /FMX.Container.pas: -------------------------------------------------------------------------------- 1 | unit FMX.Container; 2 | 3 | (* ***** BEGIN LICENSE BLOCK ***** 4 | * Version: MPL 1.1 5 | * 6 | * The contents of this file are subject to the Mozilla Public License Version 7 | * 1.1 (the "License"); you may not use this file except in compliance with 8 | * the License. You may obtain a copy of the License at 9 | * http://www.mozilla.org/MPL/ 10 | * 11 | * Software distributed under the License is distributed on an "AS IS" basis, 12 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License 13 | * for the specific language governing rights and limitations under the 14 | * License. 15 | * 16 | * The Original Code is TFireMonkeyContainer. 17 | * 18 | * The Initial Developer of the Original Code is David Millington. 19 | * 20 | * Portions created by the Initial Developer are Copyright (C) 2013 21 | * the Initial Developer. All Rights Reserved. 22 | * 23 | * Contributor(s): David Millington (author) 24 | * Edgar Reis 25 | * Ilya S 26 | * Paul Thornton 27 | * Sven Harazim 28 | * 29 | * Originally based on code found here: 30 | * - http://delphisorcery.blogspot.com/2011/09/delphi-xe2-heating-up-hype-playing.html 31 | * - http://stackoverflow.com/questions/7315050/delphi-xe2-possible-to-instantiate-a-firemonkey-form-in-vcl-application?rq=1 32 | * but with substantial modifications. 33 | * 34 | * ***** END LICENSE BLOCK ***** *) 35 | 36 | interface 37 | 38 | uses 39 | Vcl.Controls, Vcl.Forms, FMX.Forms, Winapi.Messages, System.Classes, 40 | Winapi.Windows, System.Generics.Collections; 41 | 42 | const 43 | WM_FMX_FORM_ACTIVATED = WM_USER + 1; 44 | 45 | type 46 | TOnCreateFMXFormEvent = procedure(var Form : FMX.Forms.TCommonCustomForm) of object; 47 | TCloseHostedFMXFormAction = (fcaNone, fcaFree); 48 | TOnDestroyFMXFormEvent = procedure(var Form : FMX.Forms.TCommonCustomForm; var Action : TCloseHostedFMXFormAction) of object; 49 | 50 | [ComponentPlatformsAttribute(pidWin32 or pidWin64)] // Thanks Edgar Reis 51 | TFireMonkeyContainer = class(TWinControl) 52 | private 53 | FFMXForm : FMX.Forms.TCommonCustomForm; 54 | FOldVCLWndProc : System.Classes.TWndMethod; 55 | FSubclassedForm : Vcl.Forms.TCustomForm; 56 | FOldFMXWndProc : Winapi.Windows.TFNWndProc; 57 | FNewFMXWndProc : Pointer; 58 | FOnCreateForm : TOnCreateFMXFormEvent; 59 | FOnDestroyForm : TOnDestroyFMXFormEvent; 60 | FCreateFormCalled : Boolean; 61 | FHandlingFMXActivation : Boolean; 62 | FAllowTabKey : Boolean; 63 | 64 | procedure DoOnCreate; 65 | procedure DoOnDestroy; 66 | 67 | procedure SetFMXForm(Form : FMX.Forms.TCommonCustomForm); 68 | procedure HandleResize; 69 | procedure HostTheFMXForm; 70 | procedure HideFMAppClassWindow; 71 | function GetHostedFMXFormWindowHandle : HWND; 72 | function GetFMXFormWindowHandle(const Form: FMX.Forms.TCommonCustomForm) : HWND; 73 | 74 | procedure SubClassVCLForm; 75 | procedure UnSubClassVCLForm; 76 | 77 | procedure SubClassFMXForm; 78 | procedure UnSubClassFMXForm; 79 | procedure FMXFormWndProc(var Msg: TMessage); 80 | procedure HandleFMXFormActivate(var Msg: TMessage); 81 | 82 | procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; 83 | procedure WMPaint(var Message: TWMPaint); message WM_PAINT; 84 | procedure WMFmxFormActivated(var Message: TMessage); message WM_FMX_FORM_ACTIVATED; 85 | protected 86 | procedure Resize; override; 87 | procedure CreateHandle; override; 88 | procedure Notification(AComponent: TComponent; Operation: TOperation); override; 89 | procedure SetParent(AParent: TWinControl); override; 90 | 91 | procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; 92 | procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE; 93 | procedure KeyUp(var Key: Word; Shift: TShiftState); override; 94 | public 95 | constructor Create(Owner : TComponent); override; 96 | destructor Destroy; override; 97 | procedure BeforeDestruction; override; 98 | 99 | property FireMonkeyFormHandle : HWND read GetHostedFMXFormWindowHandle; 100 | published 101 | property FireMonkeyForm : FMX.Forms.TCommonCustomForm read FFMXForm write SetFMXForm; 102 | property OnCreateFMXForm : TOnCreateFMXFormEvent read FOnCreateForm write FOnCreateForm; 103 | property OnDestroyFMXForm : TOnDestroyFMXFormEvent read FOnDestroyForm write FOnDestroyForm; 104 | property AllowTabKey: Boolean read FAllowTabKey write FAllowTabKey default False; 105 | property Align; 106 | property Anchors; 107 | property Constraints; 108 | property AlignWithMargins; 109 | property Left; 110 | property Top; 111 | property Width; 112 | property Height; 113 | property OnDragDrop; 114 | property OnDragOver; 115 | property OnEndDock; 116 | property OnEndDrag; 117 | end; 118 | 119 | implementation 120 | 121 | uses 122 | FMX.Platform, FMX.Platform.Win, System.Types, SysUtils, Graphics, Vcl.Dialogs, System.SyncObjs, 123 | System.UITypes, FMX.Types; 124 | 125 | const 126 | PW_CLIENTONLY = $1; 127 | 128 | var 129 | PFPrintWindow : function(Hnd: HWND; HdcBlt: HDC; nFlags: UINT): BOOL; stdcall; // Not declared in Windows.pas 130 | 131 | type 132 | TWinControlHack = class(TWinControl); 133 | TFMXApplicationHack = class(FMX.Forms.TApplication); 134 | 135 | TVCLFormHook = class 136 | strict private 137 | FOriginalWndProc : System.Classes.TWndMethod; 138 | FForm : Vcl.Forms.TCustomForm; 139 | FContainersOnThisForm : TList; 140 | 141 | class function IncrementFormUsed(const Form : Vcl.Forms.TCustomForm) : Boolean; 142 | class function DecrementFormUsed(const Form : Vcl.Forms.TCustomForm) : Boolean; 143 | 144 | procedure AddContainerUsed(const Container : TFireMonkeyContainer); 145 | procedure RemoveContainerUsed(const Container : TFireMonkeyContainer); 146 | procedure VCLFormWndProc(var Msg: TMessage); 147 | procedure HandleVCLFormNcActivate(var Msg: TMessage); 148 | function IsWindowInVCLFormTree(const Wnd : HWND) : Boolean; 149 | function IsHostedFMXForm(const Wnd : HWND) : Boolean; 150 | private 151 | class var FFormHooks : TDictionary; 152 | class var FFormContainerCount : TDictionary; 153 | public 154 | constructor Create(const Form : Vcl.Forms.TCustomForm); 155 | destructor Destroy; override; 156 | 157 | class procedure HookVCLForm(const Form : Vcl.Forms.TCustomForm; 158 | const Container : TFireMonkeyContainer); 159 | class procedure UnHookVCLForm(const Form : Vcl.Forms.TCustomForm; 160 | const Container : TFireMonkeyContainer); 161 | end; 162 | 163 | TFMXAppRunningHackThread = class(TThread) 164 | protected 165 | procedure Execute; override; 166 | end; 167 | 168 | TFMXAppRunningHack = class 169 | private 170 | class var FEvent : TEvent; 171 | class var FFMXAppRunningThread : TFMXAppRunningHackThread; 172 | 173 | class procedure EnsureFMXAppRunning; 174 | class procedure TerminateFMXApp; 175 | end; 176 | 177 | TFMXAppServiceReplacement = class(TInterfacedObject, IFMXApplicationService) 178 | strict private 179 | FEvent : TEvent; 180 | FTerminating : Boolean; 181 | public 182 | constructor Create(WakeEvent : TEvent); 183 | 184 | // IFMXApplicationService 185 | procedure Run; 186 | function HandleMessage: Boolean; 187 | procedure WaitMessage; 188 | function GetDefaultTitle: string; 189 | function GetTitle: string; 190 | procedure SetTitle(const Value: string); 191 | procedure Terminate; 192 | function Terminating: Boolean; 193 | 194 | {$if CompilerVersion >= 29} // XE8 and above 195 | function GetVersionString: string; 196 | {$endif} 197 | 198 | {$if CompilerVersion >= 32} // Tokyo and above 199 | function Running: Boolean; 200 | {$endif} 201 | 202 | property DefaultTitle: string read GetDefaultTitle; 203 | property Title: string read GetTitle write SetTitle; 204 | end; 205 | 206 | function EnumWindowCallback(hWnd: HWND; lParam: LPARAM): BOOL; stdcall; 207 | const 208 | FMXClassName = 'TFMAppClass'; 209 | var 210 | ProcessID : DWORD; 211 | ClassName : string; 212 | ClassNameLength : NativeInt; 213 | begin 214 | // XE4 (possibly others) show a phantom TFMAppClass window on the taskbar. Hide it. 215 | // Ensure the one we hide belongs to this thread / process - don't damage other FMX apps 216 | if (GetWindowThreadProcessId(hWnd, ProcessID) = GetCurrentThreadId) and (ProcessID = GetCurrentProcessId) then begin 217 | // Thanks to the ubiquitous David Heffernan... http://stackoverflow.com/questions/7096542/collect-all-active-window-class-names 218 | SetLength(ClassName, 256); 219 | ClassNameLength := GetClassName(hWnd, PChar(ClassName), Length(ClassName)); 220 | if ClassNameLength = 0 then RaiseLastOSError; 221 | SetLength(ClassName, ClassNameLength); 222 | if ClassName = FMXClassName then begin 223 | // Found. Hide it, and return false to stop enumerating 224 | ShowWindow(hWnd, SW_HIDE); 225 | Exit(False); 226 | end; 227 | end; 228 | Result := True; // Fallthrough, keep iterating 229 | end; 230 | 231 | { TFiremonkeyContainer } 232 | 233 | constructor TFireMonkeyContainer.Create(Owner: TComponent); 234 | begin 235 | inherited Create(Owner); 236 | FFMXForm := nil; 237 | FOldVCLWndProc := nil; 238 | FSubclassedForm := nil; 239 | FOldFMXWndProc := nil; 240 | FNewFMXWndProc := nil; 241 | FCreateFormCalled := false; 242 | FHandlingFMXActivation := false; 243 | FAllowTabKey := False; //if true Tab is handled inside the FMX form 244 | TabStop := true; // Want to be focused on tabs 245 | end; 246 | 247 | destructor TFireMonkeyContainer.Destroy; 248 | begin 249 | UnSubClassVCLForm; 250 | if Assigned(FFMXForm) then UnSubClassFMXForm; 251 | inherited; 252 | end; 253 | 254 | procedure TFireMonkeyContainer.BeforeDestruction; 255 | begin 256 | DoOnDestroy; 257 | inherited; 258 | end; 259 | 260 | procedure TFireMonkeyContainer.DoOnCreate; 261 | var 262 | OldForm, Form : FMX.Forms.TCommonCustomForm; 263 | Action : TCloseHostedFMXFormAction; 264 | begin 265 | if (not FCreateFormCalled) and Assigned(FOnCreateForm) and not (csDesigning in ComponentState) then begin 266 | FCreateFormCalled := true; 267 | Form := FFMXForm; 268 | FOnCreateForm(Form); 269 | if (Form <> FFMXForm) and Assigned(FOnDestroyForm) and Assigned(FFMXForm) then begin 270 | // Changed: want a new form, not the one it was set to. Call OnDestroy for the existing one, 271 | // otherwise free 272 | Action := fcaNone; 273 | FOnDestroyForm(FFMXForm, Action); 274 | case Action of 275 | fcaNone: ; 276 | fcaFree: begin 277 | OldForm := FFMXForm; 278 | SetFMXForm(nil); 279 | OldForm.Free; 280 | end; 281 | end; 282 | end; 283 | SetFMXForm(Form); 284 | end; 285 | end; 286 | 287 | procedure TFireMonkeyContainer.DoOnDestroy; 288 | var 289 | Action : TCloseHostedFMXFormAction; 290 | OldForm : FMX.Forms.TCommonCustomForm; 291 | begin 292 | if Assigned(FOnDestroyForm) and Assigned(FFMXForm) and not (csDesigning in ComponentState) then begin 293 | Action := fcaNone; 294 | FOnDestroyForm(FFMXForm, Action); 295 | case Action of 296 | fcaNone: ; 297 | fcaFree: begin 298 | OldForm := FFMXForm; 299 | SetFMXForm(nil); 300 | OldForm.Free; 301 | end; 302 | end; 303 | end; 304 | end; 305 | 306 | procedure TFireMonkeyContainer.CreateHandle; 307 | begin 308 | UnSubClassVCLForm; 309 | inherited; 310 | SubClassVCLForm; 311 | 312 | // Call OnCreateForm now. Loaded() is too early - a linked autocreated FMX form won't be created yet. 313 | // When this component's handle is first created, it and the parent form and the FMX form are 314 | // guaranteed to exist 315 | // I'd like an earlier time since this is quite late, but I can't find a reliable one... 316 | DoOnCreate; // Checks it is only called once (handle can be recreated) 317 | 318 | // When this form's handle changes, update the hosted FMX form (setting parent, position, etc) 319 | if Assigned(FFMXForm) then begin 320 | HostTheFMXForm; 321 | end; 322 | end; 323 | 324 | procedure TFireMonkeyContainer.SetParent(AParent: TWinControl); 325 | begin 326 | // If the parent changes, it might be changing forms. Unhook, process the parent change, and 327 | // re-hook 328 | 329 | UnSubClassVCLForm; 330 | inherited; 331 | if Assigned(Parent) then 332 | SubClassVCLForm; 333 | end; 334 | 335 | procedure TFireMonkeyContainer.SubClassVCLForm; 336 | begin 337 | if csDesigning in ComponentState then Exit; 338 | if not Assigned(FFMXForm) then Exit; // No point if not doing anything yet 339 | 340 | if Assigned(GetParentForm(Self)) then begin 341 | FSubclassedForm := GetParentForm(Self); 342 | TVCLFormHook.HookVCLForm(FSubclassedForm, Self); 343 | end; 344 | end; 345 | 346 | procedure TFireMonkeyContainer.UnSubClassVCLForm; 347 | begin 348 | if csDesigning in ComponentState then Exit; 349 | 350 | // May not have subclassed yet, eg if no FMX form assigned 351 | if Assigned(FSubclassedForm) then begin 352 | TVCLFormHook.UnHookVCLForm(FSubclassedForm, Self); 353 | FSubclassedForm := nil; 354 | end; 355 | end; 356 | 357 | procedure TFireMonkeyContainer.SubClassFMXForm; 358 | var 359 | FMXHandle : HWND; 360 | begin 361 | if csDesigning in ComponentState then Exit; 362 | 363 | FMXHandle := GetHostedFMXFormWindowHandle; 364 | if (FMXHandle <> 0) and not Assigned(FOldFMXWndProc) then begin // Not already subclassed 365 | // Subclass FMX windows the old-fashioned way - no WindowProc property to assign 366 | FOldFMXWndProc := TFNWndProc(Winapi.Windows.GetWindowLong(FMXHandle, GWL_WNDPROC)); 367 | FNewFMXWndProc := MakeObjectInstance(FMXFormWndProc); 368 | Winapi.Windows.SetWindowLong(FMXHandle, GWL_WNDPROC, NativeInt(FNewFMXWndProc)); 369 | end; 370 | end; 371 | 372 | procedure TFireMonkeyContainer.UnSubClassFMXForm; 373 | var 374 | FMXHandle : HWND; 375 | begin 376 | if csDesigning in ComponentState then Exit; 377 | 378 | FMXHandle := GetHostedFMXFormWindowHandle; 379 | //assert(FMXHandle <> 0); // Can occure when freeing parent VCL form 380 | if Assigned(FOldFMXWndProc) and (FMXHandle <> 0) then begin 381 | Winapi.Windows.SetWindowLong(FMXHandle, GWL_WNDPROC, NativeInt(FOldFMXWndProc)); 382 | FreeObjectInstance(FNewFMXWndProc); 383 | FNewFMXWndProc := nil; 384 | FOldFMXWndProc := nil; 385 | end; 386 | end; 387 | 388 | procedure TFireMonkeyContainer.FMXFormWndProc(var Msg: TMessage); 389 | var 390 | CallOriginal : Boolean; 391 | begin 392 | CallOriginal := true; 393 | 394 | case Msg.Msg of 395 | WM_ACTIVATE, WM_MOUSEACTIVATE: begin // Activate when clicked on 396 | HandleFMXFormActivate(Msg); 397 | CallOriginal := false; 398 | end; 399 | WM_LBUTTONDOWN, WM_RBUTTONDOWN: begin 400 | if Assigned(FFMXForm) and (GetFocus <> GetHostedFMXFormWindowHandle) then 401 | HandleFMXFormActivate(Msg); // clicked on the FMX form, ensure it's active 402 | end; 403 | WM_KILLFOCUS: begin 404 | if Assigned(FFMXForm) and (HWND(Msg.LParam) <> GetHostedFMXFormWindowHandle) and FFMXForm.Active 405 | and HandleAllocated and not Focused 406 | then begin 407 | FFMXForm.Active := false; // Stops the caret displaying 408 | end; 409 | end; 410 | WM_GETDLGCODE: begin 411 | // Want to process arrow keys and characters, for text fields 412 | // Characters work through FMX container's WM_KEYDOWN and WM_KEYUP but arrow keys don't 413 | WMGetDlgCode(Msg); 414 | CallOriginal := Msg.Result <> 0; 415 | end; 416 | end; 417 | 418 | if CallOriginal then 419 | Msg.Result := CallWindowProc(FOldFMXWndProc, GetHostedFMXFormWindowHandle, Msg.Msg, Msg.WParam, Msg.LParam); 420 | end; 421 | 422 | procedure TFireMonkeyContainer.HandleFMXFormActivate(var Msg: TMessage); 423 | begin 424 | assert((Msg.Msg = WM_ACTIVATE) or (Msg.Msg = WM_MOUSEACTIVATE) or (Msg.Msg = WM_LBUTTONDOWN) or (Msg.Msg = WM_RBUTTONDOWN)); 425 | // So many brackets! But: "if this isn't recursively being sent, and it's an activation message 426 | // or it's being clicked on" 427 | if (not FHandlingFMXActivation) and HandleAllocated then begin 428 | if ((Msg.Msg = WM_ACTIVATE) and (Msg.WParam <> WA_INACTIVE)) or 429 | ((Msg.Msg = WM_MOUSEACTIVATE) and ((Msg.WParam = MA_ACTIVATE) or ((Msg.WParam = MA_ACTIVATEANDEAT)))) or 430 | ((Msg.Msg = WM_LBUTTONDOWN) or (Msg.Msg = WM_RBUTTONDOWN)) then 431 | begin 432 | // Immediately tell the form it is active, because TCustomCaret.CanShow will check 433 | FFMXForm.Active := true; 434 | 435 | // Handle title bar (etc) activation 436 | Winapi.Windows.PostMessage(Handle, WM_FMX_FORM_ACTIVATED, WPARAM(GetHostedFMXFormWindowHandle), 0); 437 | end else if ((Msg.Msg = WM_ACTIVATE) and (Msg.WParam = WA_INACTIVE)) then begin 438 | FFMXForm.Active := false; 439 | end; 440 | end; 441 | end; 442 | 443 | procedure TFireMonkeyContainer.WMFmxFormActivated(var Message: TMessage); 444 | var 445 | VCLForm : Vcl.Forms.TCustomForm; 446 | FMXForm : FMX.Forms.TCommonCustomForm; 447 | Loop : Integer; 448 | begin 449 | // When the FMX form is clicked on, it activates (and gets focus etc) but the host VCL form doesn't 450 | // so the previous window stays on top and draws as active. Solve this by setting the active window 451 | // first to the host VCL form, then the hosted FMX form, so end up with an active FMX form in a 452 | // on-top, drawing-as-active VCL form. 453 | // The title bar still messes up occasionally: fix it by telling other forms they are not active. 454 | FHandlingFMXActivation := true; 455 | try 456 | SetActiveWindow(GetParentForm(Self).Handle); 457 | SetActiveWindow(GetHostedFMXFormWindowHandle); 458 | 459 | for Loop := 0 to Vcl.Forms.Screen.CustomFormCount-1 do begin 460 | VCLForm := Vcl.Forms.Screen.CustomForms[Loop]; 461 | if VCLForm <> GetParentForm(Self) then 462 | Winapi.Windows.PostMessage(VCLForm.Handle, WM_NCACTIVATE, WPARAM(False), 0); 463 | end; 464 | for Loop := 0 to FMX.Forms.Screen.FormCount-1 do begin 465 | FMXForm := FMX.Forms.Screen.Forms[Loop]; 466 | if FMXForm <> FFMXForm then 467 | Winapi.Windows.PostMessage(GetFMXFormWindowHandle(FMXForm), WM_NCACTIVATE, WPARAM(False), 0); 468 | end; 469 | 470 | Winapi.Windows.SetFocus(GetHostedFMXFormWindowHandle); 471 | finally 472 | FHandlingFMXActivation := false; 473 | end; 474 | end; 475 | 476 | procedure TFireMonkeyContainer.WMEraseBkgnd(var Message: TWMEraseBkgnd); 477 | begin 478 | // Prevent flicker when resizing 479 | if Assigned(FFMXForm) then 480 | Message.Result := 1 481 | else 482 | inherited; 483 | end; 484 | 485 | procedure TFireMonkeyContainer.Resize; 486 | begin 487 | inherited; 488 | HandleResize; 489 | end; 490 | 491 | procedure TFireMonkeyContainer.HandleResize; 492 | {$IF CompilerVersion >= 24.0} // XE3+ 493 | var 494 | WindowService : IFMXWindowService; 495 | {$IFEND} 496 | begin 497 | if csDesigning in ComponentState then Exit; // Do not actually change the form when designing 498 | 499 | if Assigned(FFMXForm) and HandleAllocated then begin 500 | {$IF CompilerVersion >= 24.0} // XE3+ 501 | WindowService := TPlatformServices.Current.GetPlatformService(IFMXWindowService) as IFMXWindowService; 502 | WindowService.SetWindowRect(FFMXForm, RectF(0, 0, Width, Height)); 503 | FFMXForm.Invalidate; 504 | {$ELSE} // XE2 505 | Platform.SetWindowRect(FFMXForm, RectF(0, 0, Width, Height)); 506 | {$IFEND} 507 | end; 508 | end; 509 | 510 | procedure TFireMonkeyContainer.SetFMXForm(Form: FMX.Forms.TCommonCustomForm); 511 | begin 512 | if Assigned(Form) then // No need to do this if there's no form 513 | TFMXAppRunningHack.EnsureFMXAppRunning; // The first time it's called, sets FMX.Forms.Application state to running 514 | 515 | UnSubClassVCLForm; 516 | if Assigned(FFMXForm) then begin 517 | UnSubClassFMXForm; 518 | FFMXForm.RemoveFreeNotification(Self); 519 | end; 520 | 521 | FFMXForm := Form; 522 | 523 | if Assigned(FFMXForm) then begin 524 | FFMXForm.FreeNotification(Self); 525 | HideFMAppClassWindow; 526 | if HandleAllocated then begin // Will otherwise occur in CreateHandle 527 | HostTheFMXForm; 528 | SubClassVCLForm; 529 | end; 530 | end; 531 | end; 532 | 533 | procedure TFireMonkeyContainer.Notification(AComponent: TComponent; Operation: TOperation); 534 | const 535 | strLostReference = 'The form %s has been closed, and so the %s.FireMonkeyForm property has been set to nil.' 536 | + #10#13 + #10#13 537 | + 'Either keep the FireMonkey form open in the IDE while the VCL form hosting it (%s) is open,' 538 | + ' or use the TFireMonkeyContainer events OnCreateFMXForm and OnDestroyFMXForm to define the hosted' 539 | + ' FireMonkey form.'; 540 | begin 541 | if (Operation = opRemove) and (AComponent = FFMXForm) then begin 542 | if csDesigning in ComponentState then begin 543 | Vcl.Dialogs.MessageDlg(Format(strLostReference, [FFMXForm.Name, GetParentForm(Self).Name + '.' + Name, GetParentForm(Self).Name]), 544 | mtWarning, [mbOk], 0, mbOk); 545 | end; 546 | SetFMXForm(nil); 547 | Invalidate; // Repaint to show missing form, not 'unable to draw form' 548 | end; 549 | inherited; 550 | end; 551 | 552 | procedure TFireMonkeyContainer.HostTheFMXForm; 553 | var 554 | ParentHandle : HWND; 555 | CurrentParent : TWinControl; 556 | FormName : string; 557 | begin 558 | // Don't change the FMX form etc when in design mode - changes the actual, designing form in the IDE tab 559 | if not (csDesigning in ComponentState) then begin 560 | ParentHandle := Winapi.Windows.GetAncestor(GetHostedFMXFormWindowHandle, GA_PARENT); 561 | CurrentParent := Vcl.Controls.FindControl(ParentHandle); 562 | if (CurrentParent = nil) then begin 563 | FFMXForm.BorderIcons := []; 564 | {$WARN SYMBOL_DEPRECATED OFF} // None is deprecated in favour of bsNone; keep this for compatibility 565 | FFMXForm.BorderStyle := TFmxFormBorderStyle.None; 566 | HandleResize; 567 | FFMXForm.Visible := True; 568 | 569 | // To set the parent, remove the WS_CHILD and WS_POPUP states - otherwise, the owner remains 570 | // the FMX app class window. (That means GetParent returns the FMX app window not the VCL host 571 | // window, which breaks some things including drag-drop.) Then set the parent, set ws_child 572 | // again. 573 | Winapi.Windows.SetWindowLong(GetHostedFMXFormWindowHandle, GWL_STYLE, 574 | Winapi.Windows.GetWindowLong(GetHostedFMXFormWindowHandle, GWL_STYLE) and not (WS_POPUP OR WS_CHILD)); 575 | Winapi.Windows.SetParent(GetHostedFMXFormWindowHandle, Handle); 576 | Winapi.Windows.SetWindowLong(GetHostedFMXFormWindowHandle, GWL_STYLE, 577 | Winapi.Windows.GetWindowLong(GetHostedFMXFormWindowHandle, GWL_STYLE) or WS_CHILD); 578 | Winapi.Windows.SetParent(GetHostedFMXFormWindowHandle, Handle); 579 | 580 | SubclassFMXForm; 581 | HandleResize; // Now it's reparented ensure it's in the right position 582 | Winapi.Windows.SetFocus(Handle); // Can lose focus to the VCL form, the first time hosted 583 | Winapi.Windows.SetFocus(GetHostedFMXFormWindowHandle); 584 | 585 | FFMXForm.Active := true; 586 | Winapi.Windows.PostMessage(Handle, WM_FMX_FORM_ACTIVATED, WPARAM(GetHostedFMXFormWindowHandle), 0); 587 | end else if CurrentParent <> Self then begin 588 | // The FMX form is already hosted by a VCL control. This can happen when a form is set at 589 | // designtime, and then two instances of the host VCL form are created and both try to host 590 | // the one FMX form. 591 | FormName := FFMXForm.Name; 592 | SetFMXForm(nil); 593 | raise Exception.Create('The FireMonkey form ''' + FormName + ''' is already hosted by another' 594 | + ' container, ''' + CurrentParent.Name + '''.'); 595 | end; 596 | end; 597 | end; 598 | 599 | procedure TFireMonkeyContainer.HideFMAppClassWindow; 600 | begin 601 | // XE4 (possibly others) show a phantom TFMAppClass window on the taskbar. Hide it. 602 | EnumWindows(@EnumWindowCallback, 0); 603 | end; 604 | 605 | function TFireMonkeyContainer.GetHostedFMXFormWindowHandle: HWND; 606 | begin 607 | // assert(Assigned(FFMXForm)); - can validly be nil at designtime or if unassigned at runtime 608 | Result := GetFMXFormWindowHandle(FFMXForm); 609 | end; 610 | 611 | function TFireMonkeyContainer.GetFMXFormWindowHandle(const Form: FMX.Forms.TCommonCustomForm): HWND; 612 | var 613 | {$IF CompilerVersion >= 25.0} // XE4+ 614 | WinHandle : TWinWindowHandle; 615 | {$ELSE} // XE3 and XE2 616 | WinHandle : HWND; 617 | {$IFEND} 618 | begin 619 | // assert(Assigned(Form)); -- ok unassigned at designtime etc 620 | Result := 0; 621 | {$IF CompilerVersion >= 25.0} // XE4+ 622 | if Assigned(Form) and Assigned(Form.Handle) then begin 623 | WinHandle := WindowHandleToPlatform(Form.Handle); 624 | if Assigned(WinHandle) then Exit(WinHandle.Wnd); 625 | end; 626 | {$ELSE} // XE3 and XE2 627 | if Assigned(Form) and (Form.Handle <> 0) then begin 628 | WinHandle := FmxHandleToHWND(Form.Handle); 629 | if (WinHandle <> 0) then Exit(WinHandle); 630 | end; 631 | {$IFEND} 632 | end; 633 | 634 | procedure TFireMonkeyContainer.WMPaint(var Message: TWMPaint); 635 | const 636 | strDefaultText = 'TFireMonkeyContainer' + #10#13#10#13 + 'Set the FireMonkeyForm property to ' + 637 | ' an autocreated FireMonkey form at designtime, or in code at runtime using the OnCreateFMXForm' + 638 | ' and OnDestroyFMXForm events (recommended.) You can host both 2D (HD) and 3D FireMonkey forms.'; 639 | var 640 | Canvas : TControlCanvas; 641 | Rect : TRect; 642 | strText : string; 643 | begin 644 | inherited; 645 | 646 | if csDesigning in ComponentState then begin 647 | Canvas := TControlCanvas.Create; 648 | try 649 | Canvas.Control := Self; 650 | // Fill background 651 | Rect := ClientRect; 652 | Canvas.Brush.Style := bsDiagCross; 653 | Canvas.Brush.Color := clSkyBlue; 654 | SetBkColor(Canvas.Handle, ColorToRGB(Parent.Brush.Color)); 655 | Canvas.FillRect(Rect); 656 | Canvas.Brush.Style := bsClear; 657 | // If hosting a form, paint an image of it 658 | if Assigned(FFMXForm) then begin 659 | if not Assigned(PFPrintWindow) or (not PFPrintWindow(GetHostedFMXFormWindowHandle, Canvas.Handle, PW_CLIENTONLY)) then begin 660 | // Paint a message that was unable to show a preview image 661 | Rect.Inflate(-16, -16); 662 | strText := FFMXForm.Name + ' : Unable to draw preview image'; 663 | Winapi.Windows.DrawTextEx(Canvas.Handle, PChar(strText), Length(strText), Rect, 664 | DT_CENTER or DT_WORDBREAK or DT_END_ELLIPSIS, nil); 665 | end; 666 | end else begin 667 | // Otherwise, paint a message that you can host a form 668 | Rect.Inflate(-16, -16); 669 | if Name <> '' then strText := Name + ' : ' + strDefaultText 670 | else strText := strDefaultText; 671 | Winapi.Windows.DrawTextEx(Canvas.Handle, PChar(strText), Length(strText), Rect, 672 | DT_CENTER or DT_WORDBREAK or DT_END_ELLIPSIS, nil); 673 | end; 674 | finally 675 | Canvas.Free; 676 | end; 677 | end; 678 | end; 679 | 680 | procedure TFireMonkeyContainer.WMGetDlgCode(var Msg: TMessage); 681 | var 682 | M: PMsg; 683 | begin 684 | // From http://stackoverflow.com/questions/5632411/arrow-key-not-working-in-component 685 | Msg.Result := DLGC_WANTALLKEYS or DLGC_WANTARROWS or DLGC_WANTCHARS; 686 | if FAllowTabKey then 687 | Msg.Result := Msg.Result or DLGC_WANTTAB; //handle Tabs 688 | if Msg.lParam <> 0 then 689 | begin 690 | M := PMsg(Msg.lParam); 691 | case M.message of 692 | WM_KEYDOWN, WM_KEYUP, WM_CHAR: 693 | begin 694 | Perform(M.message, M.wParam, M.lParam); 695 | Msg.Result := Msg.Result or DLGC_WANTMESSAGE; 696 | end; 697 | end; 698 | end 699 | else 700 | Msg.Result := Msg.Result or DLGC_WANTMESSAGE; 701 | end; 702 | 703 | procedure TFireMonkeyContainer.WMKeyDown(var Message: TWMKeyDown); 704 | var 705 | ParentForm : Vcl.Forms.TCustomForm; 706 | Msg : TMsg; 707 | Shift : TShiftState; 708 | Key : Word; 709 | KeyChar : Char; 710 | begin 711 | if not Assigned(FFMXForm) then begin 712 | inherited; 713 | Exit; 714 | end; 715 | 716 | // Mimic how FMX handles keys. In a key-down event, it translates the message (causing a WM_CHAR 717 | // message to be posted), looks in the queue for a WM_CHAR, and then sends that char to the 718 | // keydown event. 719 | // However, this has to integrate with the VCL too, so mimic part of what the VCL does - sending 720 | // WM_KEYDOWN to the parent form - before the FMX compatibility. 721 | 722 | // TWinControl.DoKeyDown does essentially this: 723 | ParentForm := GetParentForm(Self, false); 724 | while Assigned(ParentForm) do begin 725 | if ParentForm.KeyPreview and TWinControlHack(ParentForm).DoKeyDown(Message) then 726 | Exit; 727 | if Assigned(ParentForm.Parent) then // GetParentForm(form) returns the form itself, not its parent... 728 | ParentForm := GetParentForm(ParentForm.Parent, false) 729 | else 730 | ParentForm := nil; 731 | end; 732 | 733 | Shift := KeyDataToShiftState(Message.CharCode); 734 | 735 | // Now, behave as FMX does: 736 | // No need to call TranslateMessage(Message) first, TApplication.ProcessMessage does this 737 | if PeekMessage(Msg, 0, WM_CHAR, WM_CHAR, PM_REMOVE) then begin 738 | Key := Msg.wParam; 739 | KeyChar := Char(Msg.wParam); 740 | // Call again to remove any duplicate 741 | PeekMessage(Msg, 0, WM_CHAR, WM_CHAR, PM_REMOVE); 742 | FFMXForm.KeyDown(Key, KeyChar, Shift); 743 | end 744 | else if not (Message.CharCode in [VK_SHIFT, VK_CONTROL]) then //Shift and Control are handled by KeyDataToShiftState 745 | begin 746 | // In some circumstances non-character keycodes go directly to the FMX form (for instance after clicking the 747 | // form). In other circumstances we land will land here. 748 | // Without the following handling the KeyCodes are lost (eg. arrow keys, function keys etc. wont work) 749 | Key := Message.CharCode; 750 | KeyChar := #0; 751 | FFMXForm.KeyDown(Key, KeyChar, Shift); 752 | end; 753 | end; 754 | 755 | procedure TFireMonkeyContainer.KeyUp(var Key: Word; Shift: TShiftState); 756 | var 757 | KeyAsChar : Char; 758 | begin 759 | if Assigned(FFMXForm) then begin 760 | KeyAsChar := Char(Key); 761 | FFMXForm.KeyUp(Key, KeyAsChar, Shift); 762 | end; 763 | 764 | inherited; 765 | end; 766 | 767 | 768 | { TVCLFormHook } 769 | 770 | { 771 | FMX forms are embedded by parenting them to a TWinControl, essentially. However, there are focus 772 | issues where the form on which the parent TWinControl lives draws its title bar as unfocused when 773 | the FMX control has focus / is active, plus others situations, eg switching to the app via the 774 | Windows start bar etc. To solve this, subclass the VCL form and change the behaviour of the focus 775 | messages in some situations. 776 | This is easy for one FMX container <-> one form - the new WindowProc can be a method of the 777 | container. But for several FMX containers, each trying to hook the form, it gets messy: it can be 778 | hooked several times and if the first container is removed before the others, it resets (unhooks) 779 | the window proc back to the original despite there being other containers. The solution is a 780 | single TVCLFormHook instance per form: a count of containers per form is kept and a TVCLFormHook 781 | is created when the first container is parented, and it is removed when the last container is 782 | unparented/freed/etc. It keeps a list of containers so it can regard focus as belonging to the VCL 783 | form or not appropriately depending on if the window handle is a hosted FMX form or not. 784 | TFireMonkeyContainer calls TVCLFormHook.HookVCLForm / TVCLFormHook.UnHookVCLForm based on 785 | whether it itself needs a hook installed or not at the time (eg, it won't hook if it is not 786 | hosting a FMX form and is just sitting there empty.) HookVCLForm or UnHookVCLForm only actually 787 | hook or unhook if the container is the first/last, as above. 788 | } 789 | 790 | class procedure TVCLFormHook.HookVCLForm(const Form: Vcl.Forms.TCustomForm; 791 | const Container: TFireMonkeyContainer); 792 | var 793 | Hook : TVCLFormHook; 794 | begin 795 | assert(FFormContainerCount.ContainsKey(Form) = FFormHooks.ContainsKey(Form)); // Otherwise mismatched 796 | 797 | // If the form doesn't already have a hook, install one 798 | if IncrementFormUsed(Form) then begin // This is the first container on the form 799 | Hook := TVCLFormHook.Create(Form); 800 | FFormHooks.Add(Form, Hook); 801 | end; 802 | 803 | // Whether the above installed a new hook or not, one now exists. Tell it about this 804 | // container 805 | Hook := FFormHooks[Form]; 806 | Hook.AddContainerUsed(Container); 807 | end; 808 | 809 | class procedure TVCLFormHook.UnHookVCLForm(const Form: Vcl.Forms.TCustomForm; 810 | const Container: TFireMonkeyContainer); 811 | begin 812 | // Assuming a hook was already installed on the form (otherwise why is this being called?) 813 | // tell it this container is no longer being used 814 | assert(FFormHooks.ContainsKey(Form)); 815 | FFormHooks[Form].RemoveContainerUsed(Container); 816 | 817 | if DecrementFormUsed(Form) then begin // This was the last container on the form 818 | FFormHooks[Form].Free; 819 | FFormHooks.Remove(Form); 820 | end; 821 | end; 822 | 823 | class function TVCLFormHook.IncrementFormUsed(const Form: Vcl.Forms.TCustomForm) : Boolean; 824 | var 825 | Value : Integer; 826 | begin 827 | if FFormContainerCount.TryGetValue(Form, Value) then begin 828 | Result := false; 829 | FFormContainerCount.AddOrSetValue(Form, Value + 1); 830 | end else begin 831 | Result := true; // The first added 832 | FFormContainerCount.AddOrSetValue(Form, 1); 833 | end; 834 | end; 835 | 836 | class function TVCLFormHook.DecrementFormUsed(const Form: Vcl.Forms.TCustomForm) : Boolean; 837 | var 838 | Value : Integer; 839 | begin 840 | Result := false; 841 | if FFormContainerCount.TryGetValue(Form, Value) then begin 842 | Dec(Value); 843 | assert(Value >= 0, 'Container count decremented below 0'); 844 | if Value = 0 then begin 845 | Result := true; // This was the last container on the form 846 | FFormContainerCount.Remove(Form) 847 | end else begin 848 | FFormContainerCount.AddOrSetValue(Form, Value); 849 | end; 850 | end else 851 | assert(false, 'Container count decremented but count did not exist'); 852 | end; 853 | 854 | constructor TVCLFormHook.Create(const Form : Vcl.Forms.TCustomForm); 855 | begin 856 | FForm := Form; 857 | FOriginalWndProc := Form.WindowProc; 858 | Form.WindowProc := VCLFormWndProc; 859 | FContainersOnThisForm := TList.Create; 860 | 861 | inherited Create(); 862 | end; 863 | 864 | destructor TVCLFormHook.Destroy; 865 | begin 866 | FForm.WindowProc := FOriginalWndProc; 867 | assert(FContainersOnThisForm.Count = 0); // Unhooking form when a container hasn't unregistered itself? 868 | FContainersOnThisForm.Free; 869 | 870 | inherited; 871 | end; 872 | 873 | procedure TVCLFormHook.AddContainerUsed(const Container: TFireMonkeyContainer); 874 | begin 875 | assert(not FContainersOnThisForm.Contains(Container), 'FMX container added to form twice'); 876 | FContainersOnThisForm.Add(Container); 877 | end; 878 | 879 | procedure TVCLFormHook.RemoveContainerUsed(const Container: TFireMonkeyContainer); 880 | begin 881 | assert(FContainersOnThisForm.Contains(Container), 'FMX container not registered with form'); 882 | FContainersOnThisForm.Remove(Container); 883 | end; 884 | 885 | function TVCLFormHook.IsWindowInVCLFormTree(const Wnd: HWND): Boolean; 886 | begin 887 | // This method is the reason for registering the containers on a form etc - need to know if 888 | // Wnd represents a FMX control embedded somewhere in this form 889 | 890 | Result := (Wnd = FForm.Handle) or 891 | Winapi.Windows.IsChild(FForm.Handle, Wnd) or 892 | IsHostedFMXForm(Wnd); 893 | //(Wnd = GetHostedFMXFormWindowHandle); 894 | end; 895 | 896 | function TVCLFormHook.IsHostedFMXForm(const Wnd: HWND): Boolean; 897 | var 898 | Container : TFireMonkeyContainer; 899 | begin 900 | for Container in FContainersOnThisForm do 901 | if Container.GetHostedFMXFormWindowHandle = Wnd then 902 | Exit(true); 903 | 904 | // Fallthrough: not the handle of a FMX form hosted in a container on this form 905 | Exit(false); 906 | end; 907 | 908 | procedure TVCLFormHook.VCLFormWndProc(var Msg: TMessage); 909 | begin 910 | assert(Assigned(FOriginalWndProc)); 911 | 912 | if (Msg.Msg = WM_NCACTIVATE) then begin 913 | HandleVCLFormNcActivate(Msg); 914 | end else 915 | FOriginalWndProc(Msg); 916 | end; 917 | 918 | procedure TVCLFormHook.HandleVCLFormNcActivate(var Msg: TMessage); 919 | var 920 | Active : Boolean; 921 | HandleBeingActivated : HWND; 922 | begin 923 | // When the FMX form is clicked, the VCL forms draws with an inactive title bar, despite the 924 | // window parenting. Fix this by changing the active value the VCL form is told to draw 925 | assert(Msg.Msg = WM_NCACTIVATE); 926 | 927 | // If wants to draw as active, fine, pass through 928 | // If wants to draw as inactive, check if the FMX form is focused. If so, draw 929 | // as active too. 930 | if not Boolean(Msg.WParam) then begin // if not active 931 | HandleBeingActivated := HWND(Msg.LParam); // Doesn't follow MSDN, but see http://www.catch22.net/tuts/docking-toolbars-part-1 932 | if HandleBeingActivated = 0 then begin 933 | Active := false // Window being activated belongs to another thread 934 | end else begin 935 | Active := IsWindowInVCLFormTree(HandleBeingActivated); 936 | end; 937 | Msg.WParam := WPARAM(Active); 938 | end; 939 | 940 | FOriginalWndProc(Msg); 941 | end; 942 | 943 | { TFMXAppRunningHack } 944 | 945 | class procedure TFMXAppRunningHack.EnsureFMXAppRunning; 946 | begin 947 | // This is a really BAD hack. Need to get TApplication.TApplication.FRunning to true, because 948 | // it affects the behaviour of a lot of forms etc (including the caret, oddly enough, because a 949 | // FMX form won't be active if the app isn't running.) 950 | // This is private and completely inaccessible - there's no cracker class way to get at it, or a 951 | // method that will adjust it 952 | // TApplication.Run is very simple though: sets FRunning to true, calls IFMXApplicationService.Run, 953 | // and then sets it to false. So, replace IFMXApplicationService with our own implementation that 954 | // does nothing but wait for an event, then create a thread that calls TApplication.Run. That 955 | // thread sets FRunning to true, sits doing nothing in the custom IFMXApplicationService.Run 956 | // implementation, until the app shuts down and the thread is woken and terminated. 957 | if not Assigned(FFMXAppRunningThread) then begin 958 | // Create an event that will be signaled when the FMX application needs to stop running 959 | // Manual reset, initially in unset state 960 | FEvent := TEvent.Create(nil, true, false, ''); 961 | 962 | // Replace the application service 963 | TPlatformServices.Current.RemovePlatformService(IFMXApplicationService); 964 | TPlatformServices.Current.AddPlatformService(IFMXApplicationService, TFMXAppServiceReplacement.Create(FEvent)); 965 | 966 | // Finally, run! 967 | FFMXAppRunningThread := TFMXAppRunningHackThread.Create; 968 | end; 969 | end; 970 | 971 | class procedure TFMXAppRunningHack.TerminateFMXApp; 972 | begin 973 | if Assigned(FFMXAppRunningThread) then begin 974 | assert(Assigned(FEvent)); 975 | FEvent.SetEvent; // Wakes the FMX app running thread, which now terminates 976 | FFMXAppRunningThread.WaitFor; 977 | FreeAndNil(FFMXAppRunningThread); 978 | FreeAndNil(FEvent); 979 | end; 980 | end; 981 | 982 | { TFMXAppRunningHackThread } 983 | 984 | procedure TFMXAppRunningHackThread.Execute; 985 | begin 986 | // Check the custom IFMXApplicationService installed 987 | assert(TPlatformServices.Current.GetPlatformService(IFMXApplicationService) is TFMXAppServiceReplacement); 988 | 989 | NameThreadForDebugging('TFireMonkeyContainer FMX App Running Thread'); 990 | 991 | // Will immediately pause, waiting for an event 992 | FMX.Forms.Application.Run; 993 | end; 994 | 995 | { TFMXAppServiceReplacement } 996 | 997 | constructor TFMXAppServiceReplacement.Create(WakeEvent: TEvent); 998 | begin 999 | FEvent := WakeEvent; // Not owned, don't free on destruction 1000 | FTerminating := false; 1001 | end; 1002 | 1003 | procedure TFMXAppServiceReplacement.Run; 1004 | begin 1005 | // Do nothing while running; this event is set when the app should terminate 1006 | // See explanation for why this happens (and how the whole FMX app running hack works) in 1007 | // TFMXAppRunningHack.EnsureFMXAppRunning 1008 | FEvent.WaitFor(INFINITE); 1009 | end; 1010 | 1011 | procedure TFMXAppServiceReplacement.Terminate; 1012 | begin 1013 | // If for some reason FMX.Forms.Application.Terminate is called, terminate the FMX app 1014 | // and also terminate the VCL app 1015 | if not FTerminating then begin 1016 | FTerminating := true; 1017 | TFMXAppRunningHack.TerminateFMXApp; 1018 | VCL.Forms.Application.Terminate; 1019 | end; 1020 | end; 1021 | 1022 | function TFMXAppServiceReplacement.Terminating: Boolean; 1023 | begin 1024 | Result := FTerminating or Vcl.Forms.Application.Terminated; 1025 | end; 1026 | 1027 | function TFMXAppServiceReplacement.HandleMessage: Boolean; 1028 | var 1029 | Msg: TMsg; 1030 | begin 1031 | // Called from Application.ProcessMessages - that isn't called since the app 1032 | // loop doesn't run, but code can and does call it manually, including in FMX, 1033 | // eg in FMX.TabControl.LocalAnimateIntWait. 1034 | Result := False; 1035 | if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then begin 1036 | Result := true; 1037 | Vcl.Forms.Application.HandleMessage; 1038 | end; 1039 | end; 1040 | 1041 | procedure TFMXAppServiceReplacement.WaitMessage; 1042 | begin 1043 | Winapi.Windows.WaitMessage; 1044 | end; 1045 | 1046 | function TFMXAppServiceReplacement.GetDefaultTitle: string; 1047 | begin 1048 | Result := ''; 1049 | end; 1050 | 1051 | function TFMXAppServiceReplacement.GetTitle: string; 1052 | begin 1053 | Result := Vcl.Forms.Application.Title; 1054 | end; 1055 | 1056 | procedure TFMXAppServiceReplacement.SetTitle(const Value: string); 1057 | begin 1058 | Vcl.Forms.Application.Title := Value; 1059 | end; 1060 | 1061 | {$if CompilerVersion >= 29} // XE8 and above 1062 | function TFMXAppServiceReplacement.GetVersionString: string; 1063 | var 1064 | VersionInfo: Cardinal; 1065 | begin 1066 | Result := ''; 1067 | // based on FMX.Platform.Win's code 1068 | VersionInfo := GetFileVersion(ParamStr(0)); 1069 | if VersionInfo <> Cardinal(-1) then 1070 | Result := Format('%d.%d', [HiWord(VersionInfo), LoWord(VersionInfo)]); 1071 | end; 1072 | {$endif} 1073 | 1074 | {$if CompilerVersion >= 32} // Tokyo and above 1075 | function TFMXAppServiceReplacement.Running: Boolean; 1076 | begin 1077 | Result := not Terminating; 1078 | end; 1079 | {$endif} 1080 | 1081 | initialization 1082 | PFPrintWindow := GetProcAddress(GetModuleHandle(Winapi.Windows.user32), 'PrintWindow'); // XP+ only 1083 | // TVCLFormHook class constructor replacement (not a supported language feature in C++) 1084 | TVCLFormHook.FFormHooks := TDictionary.Create; 1085 | TVCLFormHook.FFormContainerCount := TDictionary.Create; 1086 | // TFMXAppRunningHack class constructor replacement (not a supported language feature in C++) 1087 | TFMXAppRunningHack.FFMXAppRunningThread := nil; 1088 | TFMXAppRunningHack.FEvent := nil; 1089 | 1090 | finalization 1091 | PFPrintWindow := nil; 1092 | // TVCLFormHook class destructor replacement (not a supported language feature in C++) 1093 | TVCLFormHook.FFormContainerCount.Free; 1094 | assert(TVCLFormHook.FFormHooks.Count = 0); 1095 | TVCLFormHook.FFormHooks.Free; 1096 | // TFMXAppRunningHack class destructor replacement (not a supported language feature in C++) 1097 | TFMXAppRunningHack.TerminateFMXApp; 1098 | 1099 | end. 1100 | 1101 | -------------------------------------------------------------------------------- /Demo/FiremonkeyContainerDemo.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {28435DF1-B994-4895-AE6E-168D1E5ED924} 4 | FiremonkeyContainerDemo.dpr 5 | True 6 | Debug 7 | FiremonkeyContainerDemo 8 | 3 9 | Application 10 | VCL 11 | 20.1 12 | Win32 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | true 34 | Cfg_1 35 | true 36 | true 37 | 38 | 39 | true 40 | Cfg_1 41 | true 42 | true 43 | 44 | 45 | true 46 | Base 47 | true 48 | 49 | 50 | true 51 | Cfg_2 52 | true 53 | true 54 | 55 | 56 | true 57 | Cfg_2 58 | true 59 | true 60 | 61 | 62 | true 63 | Cfg_2 64 | true 65 | true 66 | 67 | 68 | true 69 | Cfg_2 70 | true 71 | true 72 | 73 | 74 | false 75 | false 76 | false 77 | false 78 | false 79 | 00400000 80 | FiremonkeyContainerDemo 81 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 82 | 1031 83 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 84 | ..\;$(DCC_UnitSearchPath) 85 | .\$(Platform)\$(Config) 86 | .\$(Platform)\$(Config) 87 | 88 | 89 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 90 | Debug 91 | true 92 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 93 | 1033 94 | $(BDS)\bin\default_app.manifest 95 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 96 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 97 | 98 | 99 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 100 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 101 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 102 | Debug 103 | true 104 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 105 | 1033 106 | $(BDS)\bin\default_app.manifest 107 | 108 | 109 | RELEASE;$(DCC_Define) 110 | 0 111 | false 112 | 0 113 | 114 | 115 | PerMonitorV2 116 | 117 | 118 | PerMonitorV2 119 | 120 | 121 | DEBUG;$(DCC_Define) 122 | false 123 | true 124 | true 125 | true 126 | 127 | 128 | Debug 129 | 130 | 131 | Debug 132 | 133 | 134 | PerMonitorV2 135 | true 136 | 1033 137 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 138 | 139 | 140 | PerMonitorV2 141 | 142 | 143 | 144 | MainSource 145 | 146 | 147 |
Form1
148 | 149 | 150 |
FireMonkeyForm
151 | 152 | 153 |
FormExample3D
154 | 155 | 156 | Base 157 | 158 | 159 | Cfg_1 160 | Base 161 | 162 | 163 | Cfg_2 164 | Base 165 | 166 | 167 | 168 | Delphi.Personality.12 169 | 170 | 171 | 172 | 173 | FiremonkeyContainerDemo.dpr 174 | 175 | 176 | Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver 177 | Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server 178 | 179 | 180 | 181 | False 182 | False 183 | True 184 | True 185 | 186 | 187 | 188 | 189 | FiremonkeyContainerDemo.exe 190 | true 191 | 192 | 193 | 194 | 195 | 1 196 | 197 | 198 | Contents\MacOS 199 | 1 200 | 201 | 202 | 0 203 | 204 | 205 | 206 | 207 | classes 208 | 64 209 | 210 | 211 | classes 212 | 64 213 | 214 | 215 | 216 | 217 | res\xml 218 | 1 219 | 220 | 221 | res\xml 222 | 1 223 | 224 | 225 | 226 | 227 | library\lib\armeabi 228 | 1 229 | 230 | 231 | library\lib\armeabi 232 | 1 233 | 234 | 235 | 236 | 237 | library\lib\armeabi-v7a 238 | 1 239 | 240 | 241 | 242 | 243 | library\lib\mips 244 | 1 245 | 246 | 247 | library\lib\mips 248 | 1 249 | 250 | 251 | 252 | 253 | library\lib\armeabi-v7a 254 | 1 255 | 256 | 257 | library\lib\arm64-v8a 258 | 1 259 | 260 | 261 | 262 | 263 | library\lib\armeabi-v7a 264 | 1 265 | 266 | 267 | 268 | 269 | res\drawable 270 | 1 271 | 272 | 273 | res\drawable 274 | 1 275 | 276 | 277 | 278 | 279 | res\drawable-anydpi-v21 280 | 1 281 | 282 | 283 | res\drawable-anydpi-v21 284 | 1 285 | 286 | 287 | 288 | 289 | res\values 290 | 1 291 | 292 | 293 | res\values 294 | 1 295 | 296 | 297 | 298 | 299 | res\values-v21 300 | 1 301 | 302 | 303 | res\values-v21 304 | 1 305 | 306 | 307 | 308 | 309 | res\values-v31 310 | 1 311 | 312 | 313 | res\values-v31 314 | 1 315 | 316 | 317 | 318 | 319 | res\drawable-anydpi-v26 320 | 1 321 | 322 | 323 | res\drawable-anydpi-v26 324 | 1 325 | 326 | 327 | 328 | 329 | res\drawable 330 | 1 331 | 332 | 333 | res\drawable 334 | 1 335 | 336 | 337 | 338 | 339 | res\drawable 340 | 1 341 | 342 | 343 | res\drawable 344 | 1 345 | 346 | 347 | 348 | 349 | res\drawable 350 | 1 351 | 352 | 353 | res\drawable 354 | 1 355 | 356 | 357 | 358 | 359 | res\drawable-anydpi-v33 360 | 1 361 | 362 | 363 | res\drawable-anydpi-v33 364 | 1 365 | 366 | 367 | 368 | 369 | res\values 370 | 1 371 | 372 | 373 | res\values 374 | 1 375 | 376 | 377 | 378 | 379 | res\values-night-v21 380 | 1 381 | 382 | 383 | res\values-night-v21 384 | 1 385 | 386 | 387 | 388 | 389 | res\drawable 390 | 1 391 | 392 | 393 | res\drawable 394 | 1 395 | 396 | 397 | 398 | 399 | res\drawable-xxhdpi 400 | 1 401 | 402 | 403 | res\drawable-xxhdpi 404 | 1 405 | 406 | 407 | 408 | 409 | res\drawable-xxxhdpi 410 | 1 411 | 412 | 413 | res\drawable-xxxhdpi 414 | 1 415 | 416 | 417 | 418 | 419 | res\drawable-ldpi 420 | 1 421 | 422 | 423 | res\drawable-ldpi 424 | 1 425 | 426 | 427 | 428 | 429 | res\drawable-mdpi 430 | 1 431 | 432 | 433 | res\drawable-mdpi 434 | 1 435 | 436 | 437 | 438 | 439 | res\drawable-hdpi 440 | 1 441 | 442 | 443 | res\drawable-hdpi 444 | 1 445 | 446 | 447 | 448 | 449 | res\drawable-xhdpi 450 | 1 451 | 452 | 453 | res\drawable-xhdpi 454 | 1 455 | 456 | 457 | 458 | 459 | res\drawable-mdpi 460 | 1 461 | 462 | 463 | res\drawable-mdpi 464 | 1 465 | 466 | 467 | 468 | 469 | res\drawable-hdpi 470 | 1 471 | 472 | 473 | res\drawable-hdpi 474 | 1 475 | 476 | 477 | 478 | 479 | res\drawable-xhdpi 480 | 1 481 | 482 | 483 | res\drawable-xhdpi 484 | 1 485 | 486 | 487 | 488 | 489 | res\drawable-xxhdpi 490 | 1 491 | 492 | 493 | res\drawable-xxhdpi 494 | 1 495 | 496 | 497 | 498 | 499 | res\drawable-xxxhdpi 500 | 1 501 | 502 | 503 | res\drawable-xxxhdpi 504 | 1 505 | 506 | 507 | 508 | 509 | res\drawable-small 510 | 1 511 | 512 | 513 | res\drawable-small 514 | 1 515 | 516 | 517 | 518 | 519 | res\drawable-normal 520 | 1 521 | 522 | 523 | res\drawable-normal 524 | 1 525 | 526 | 527 | 528 | 529 | res\drawable-large 530 | 1 531 | 532 | 533 | res\drawable-large 534 | 1 535 | 536 | 537 | 538 | 539 | res\drawable-xlarge 540 | 1 541 | 542 | 543 | res\drawable-xlarge 544 | 1 545 | 546 | 547 | 548 | 549 | res\values 550 | 1 551 | 552 | 553 | res\values 554 | 1 555 | 556 | 557 | 558 | 559 | res\drawable-anydpi-v24 560 | 1 561 | 562 | 563 | res\drawable-anydpi-v24 564 | 1 565 | 566 | 567 | 568 | 569 | res\drawable 570 | 1 571 | 572 | 573 | res\drawable 574 | 1 575 | 576 | 577 | 578 | 579 | res\drawable-night-anydpi-v21 580 | 1 581 | 582 | 583 | res\drawable-night-anydpi-v21 584 | 1 585 | 586 | 587 | 588 | 589 | res\drawable-anydpi-v31 590 | 1 591 | 592 | 593 | res\drawable-anydpi-v31 594 | 1 595 | 596 | 597 | 598 | 599 | res\drawable-night-anydpi-v31 600 | 1 601 | 602 | 603 | res\drawable-night-anydpi-v31 604 | 1 605 | 606 | 607 | 608 | 609 | 1 610 | 611 | 612 | Contents\MacOS 613 | 1 614 | 615 | 616 | 0 617 | 618 | 619 | 620 | 621 | Contents\MacOS 622 | 1 623 | .framework 624 | 625 | 626 | Contents\MacOS 627 | 1 628 | .framework 629 | 630 | 631 | Contents\MacOS 632 | 1 633 | .framework 634 | 635 | 636 | 0 637 | 638 | 639 | 640 | 641 | 1 642 | .dylib 643 | 644 | 645 | 1 646 | .dylib 647 | 648 | 649 | 1 650 | .dylib 651 | 652 | 653 | Contents\MacOS 654 | 1 655 | .dylib 656 | 657 | 658 | Contents\MacOS 659 | 1 660 | .dylib 661 | 662 | 663 | Contents\MacOS 664 | 1 665 | .dylib 666 | 667 | 668 | 0 669 | .dll;.bpl 670 | 671 | 672 | 673 | 674 | 1 675 | .dylib 676 | 677 | 678 | 1 679 | .dylib 680 | 681 | 682 | 1 683 | .dylib 684 | 685 | 686 | Contents\MacOS 687 | 1 688 | .dylib 689 | 690 | 691 | Contents\MacOS 692 | 1 693 | .dylib 694 | 695 | 696 | Contents\MacOS 697 | 1 698 | .dylib 699 | 700 | 701 | 0 702 | .bpl 703 | 704 | 705 | 706 | 707 | 0 708 | 709 | 710 | 0 711 | 712 | 713 | 0 714 | 715 | 716 | 0 717 | 718 | 719 | 0 720 | 721 | 722 | Contents\Resources\StartUp\ 723 | 0 724 | 725 | 726 | Contents\Resources\StartUp\ 727 | 0 728 | 729 | 730 | Contents\Resources\StartUp\ 731 | 0 732 | 733 | 734 | 0 735 | 736 | 737 | 738 | 739 | 1 740 | 741 | 742 | 1 743 | 744 | 745 | 746 | 747 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 748 | 1 749 | 750 | 751 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 752 | 1 753 | 754 | 755 | 756 | 757 | ..\ 758 | 1 759 | 760 | 761 | ..\ 762 | 1 763 | 764 | 765 | ..\ 766 | 1 767 | 768 | 769 | 770 | 771 | Contents 772 | 1 773 | 774 | 775 | Contents 776 | 1 777 | 778 | 779 | Contents 780 | 1 781 | 782 | 783 | 784 | 785 | Contents\Resources 786 | 1 787 | 788 | 789 | Contents\Resources 790 | 1 791 | 792 | 793 | Contents\Resources 794 | 1 795 | 796 | 797 | 798 | 799 | library\lib\armeabi-v7a 800 | 1 801 | 802 | 803 | library\lib\arm64-v8a 804 | 1 805 | 806 | 807 | 1 808 | 809 | 810 | 1 811 | 812 | 813 | 1 814 | 815 | 816 | 1 817 | 818 | 819 | Contents\MacOS 820 | 1 821 | 822 | 823 | Contents\MacOS 824 | 1 825 | 826 | 827 | Contents\MacOS 828 | 1 829 | 830 | 831 | 0 832 | 833 | 834 | 835 | 836 | library\lib\armeabi-v7a 837 | 1 838 | 839 | 840 | 841 | 842 | 1 843 | 844 | 845 | 1 846 | 847 | 848 | 1 849 | 850 | 851 | 852 | 853 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 854 | 1 855 | 856 | 857 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 858 | 1 859 | 860 | 861 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 862 | 1 863 | 864 | 865 | 866 | 867 | ..\ 868 | 1 869 | 870 | 871 | ..\ 872 | 1 873 | 874 | 875 | ..\ 876 | 1 877 | 878 | 879 | 880 | 881 | 1 882 | 883 | 884 | 1 885 | 886 | 887 | 1 888 | 889 | 890 | 891 | 892 | ..\$(PROJECTNAME).launchscreen 893 | 64 894 | 895 | 896 | ..\$(PROJECTNAME).launchscreen 897 | 64 898 | 899 | 900 | 901 | 902 | 1 903 | 904 | 905 | 1 906 | 907 | 908 | 1 909 | 910 | 911 | 912 | 913 | Assets 914 | 1 915 | 916 | 917 | Assets 918 | 1 919 | 920 | 921 | 922 | 923 | Assets 924 | 1 925 | 926 | 927 | Assets 928 | 1 929 | 930 | 931 | 932 | 933 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 934 | 1 935 | 936 | 937 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 938 | 1 939 | 940 | 941 | 942 | 943 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 944 | 1 945 | 946 | 947 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 948 | 1 949 | 950 | 951 | 952 | 953 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 954 | 1 955 | 956 | 957 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 958 | 1 959 | 960 | 961 | 962 | 963 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 964 | 1 965 | 966 | 967 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 968 | 1 969 | 970 | 971 | 972 | 973 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 974 | 1 975 | 976 | 977 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 978 | 1 979 | 980 | 981 | 982 | 983 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 984 | 1 985 | 986 | 987 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 988 | 1 989 | 990 | 991 | 992 | 993 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 994 | 1 995 | 996 | 997 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 998 | 1 999 | 1000 | 1001 | 1002 | 1003 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1004 | 1 1005 | 1006 | 1007 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1008 | 1 1009 | 1010 | 1011 | 1012 | 1013 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1014 | 1 1015 | 1016 | 1017 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1018 | 1 1019 | 1020 | 1021 | 1022 | 1023 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1024 | 1 1025 | 1026 | 1027 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1028 | 1 1029 | 1030 | 1031 | 1032 | 1033 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1034 | 1 1035 | 1036 | 1037 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1038 | 1 1039 | 1040 | 1041 | 1042 | 1043 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1044 | 1 1045 | 1046 | 1047 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1048 | 1 1049 | 1050 | 1051 | 1052 | 1053 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1054 | 1 1055 | 1056 | 1057 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1058 | 1 1059 | 1060 | 1061 | 1062 | 1063 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1064 | 1 1065 | 1066 | 1067 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1068 | 1 1069 | 1070 | 1071 | 1072 | 1073 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1074 | 1 1075 | 1076 | 1077 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1078 | 1 1079 | 1080 | 1081 | 1082 | 1083 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1084 | 1 1085 | 1086 | 1087 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1088 | 1 1089 | 1090 | 1091 | 1092 | 1093 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1094 | 1 1095 | 1096 | 1097 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1098 | 1 1099 | 1100 | 1101 | 1102 | 1103 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1104 | 1 1105 | 1106 | 1107 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1108 | 1 1109 | 1110 | 1111 | 1112 | 1113 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1114 | 1 1115 | 1116 | 1117 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1118 | 1 1119 | 1120 | 1121 | 1122 | 1123 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1124 | 1 1125 | 1126 | 1127 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1128 | 1 1129 | 1130 | 1131 | 1132 | 1133 | 1134 | 1135 | 1136 | 1137 | 1138 | 1139 | 1140 | 1141 | 1142 | 1143 | 1144 | 1145 | 12 1146 | 1147 | 1148 | 1149 | 1150 | 1151 | --------------------------------------------------------------------------------