I was trying to reproduce a small example (same problem with Delphi 10.3 and 10.4).
My question: how to fix these "strange" extra lines? Is there a better resolution to fix the ImageList? (I put bigger images but looks like imagelist issue)
Original Size:
Full Screen:
Some extra lines are happening. I create de objects first and after I included ScaledLayout.
Code:
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
System.ImageList, FMX.ImgList, FMX.Menus, FMX.Objects, FMX.Layouts;
type
TForm1 = class(TForm)
Image1: TImage;
PopupMenu1: TPopupMenu;
MenuItem1: TMenuItem;
ImageList1: TImageList;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
ScaledLayout1: TScaledLayout;
procedure Image1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.Image1Click(Sender: TObject);
begin
PopupMenu1.Popup(Image1.Position.X,Image1.Position.Y);
end;
end.
I have an application to implement CRUD on many tables.
The main form has a tab for each table and a single toolbar with Insert, Update, Delete buttons valid for all tabs.
Every time the tab is changed, a variable
frameClass: TFrameClass; (where TFrameClass = class of TFrame) gets the type of frame created under the tab, and other variable frame: TFrame; gets the frame created under the tab.
When, say, the INSERT button is clicked, I would like to direct to the Insert() procedure corresponding to the active tab, like:
frameClass(frame).insert // trying to cast
But the compiler says insert is not a valid method. But if I cast with the content of frameClass, it works:
TFrame1(frame).insert; // does not work in general case.
What am I doing wrong?
This is the sample code:
Unit1.pas
unit unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Menus,
FMX.TabControl,
unit2, unit3;
type
TFrameClass = class of TFrame;
TFormMain = class(TForm)
TabControl1: TTabControl;
TabItem1: TTabItem;
TabItem2: TTabItem;
PopupMenu1: TPopupMenu;
MenuItemInsert: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure TabControl1Change(Sender: TObject);
procedure MenuItemInsertClick(Sender: TObject);
public
frame: TFrame;
frameClass: TFrameClass;
frames: array[0..1] of TFrameClass;
end;
var
FormMain: TFormMain;
implementation
{$R *.fmx}
procedure TFormMain.FormCreate(Sender: TObject);
begin
frames[0]:= TFrame1;
frames[1]:= TFrame2;
end;
procedure TFormMain.MenuItemInsertClick(Sender: TObject);
begin
// want the insert click to work whatever the activeTab is
// (frame as FrameClass).insert; // insert is not a method
// THIS IS THE GIST OF MY QUESTION:
// TFrame1(frame).insert; // it works but want it general
// FrameClass(frame).insert; // this is how I'd like it to work
end;
procedure TFormMain.TabControl1Change(Sender: TObject);
begin
frameClass:= frames[tabControl1.tabIndex];
frame:= frameClass.Create(tabControl1.activeTab);
frame.Parent:= tabControl1.activeTab;end;
end.
Unit2.pas
unit Unit2;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Controls.Presentation;
type
// if try to descend from other than TFrame, some properties like align, size, etc, are lost
TFrame1 = class(TFrame)
Label1: TLabel;
private
{ Private declarations }
public
{ Public declarations }
procedure insert;
end;
implementation
{$R *.fmx}
procedure TFrame1.insert;
begin
//
end;
end.
unit3.pas
unit Unit3;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Controls.Presentation, FMX.Edit;
type
// if try to descend from other than TFrame, some properties like align, size, etc, are lost
TFrame2 = class(TFrame)
Edit1: TEdit;
private
{ Private declarations }
public
{ Public declarations }
procedure insert;
end;
implementation
{$R *.fmx}
procedure TFrame2.insert;
begin
//
end;
end.
It doesn't work the way you want because the base class TFrame doesn't have the methods you are looking for, only your derived frame classes do. When you access a TFrame object via the TFrameClass class reference (or a base TFrame object pointer), you can only access methods that are in TFrame itself. To access derived class methods, you would need to do something more like this:
if frame is TFrame1 then
TFrame1(frame).insert
else if frame is TFrame2 then
TFrame2(frame).insert;
Which defeats what you are trying to accomplish. For that, you need to have your frame classes derive from a common ancestor that declares the methods you want, and then you can access those methods via that ancestor when needed.
There are two ways you can do this:
create a new base class derived from TFrame and has your desired methods, and then change your frame classes to derive from that base.
Unit1.pas
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Menus,
FMX.TabControl,
MyFrameBase;
type
TMyFrameBaseClass = class of TMyFrameBase;
TFormMain = class(TForm)
TabControl1: TTabControl;
TabItem1: TTabItem;
TabItem2: TTabItem;
PopupMenu1: TPopupMenu;
MenuItemInsert: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure TabControl1Change(Sender: TObject);
procedure MenuItemInsertClick(Sender: TObject);
public
frame: TMyFrameBase;
frames: array[0..1] of TMyFrameBaseClass;
end;
var
FormMain: TFormMain;
implementation
{$R *.fmx}
uses
Unit2, Unit3;
procedure TFormMain.FormCreate(Sender: TObject);
begin
frames[0] := TFrame1;
frames[1] := TFrame2;
end;
procedure TFormMain.MenuItemInsertClick(Sender: TObject);
begin
frame.Insert;
end;
procedure TFormMain.TabControl1Change(Sender: TObject);
var
frameClass: TMyFrameBaseClass;
begin
frameClass := frames[TabControl1.TabIndex];
frame := frameClass.Create(TabControl1.ActiveTab);
frame.Parent := TabControl1.ActiveTab;
end;
end.
MyFrameBase.pas
unit MyFrameBase;
interface
uses
FMX.Forms;
type
TMyFrameBase = class(TFrame)
public
procedure Insert; virtual; abstract;
end;
implementation
end.
Unit2.pas
unit Unit2;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Controls.Presentation,
MyFrameBase;
type
TFrame1 = class(TMyFrameBase)
Label1: TLabel;
private
{ Private declarations }
public
{ Public declarations }
procedure Insert; override;
end;
implementation
{$R *.fmx}
procedure TFrame1.Insert;
begin
//
end;
end.
Unit3.pas
unit Unit3;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Controls.Presentation, FMX.Edit,
MyFrameBase;
type
TFrame2 = class(TMyFrameBase)
Edit1: TEdit;
private
{ Private declarations }
public
{ Public declarations }
procedure Insert; override;
end;
implementation
{$R *.fmx}
procedure TFrame2.Insert;
begin
//
end;
end.
declare an interface that has your desired methods, and then have your frame classes implement that interface. You can query a frame object for that interface when needed.
Unit1.pas
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Menus,
FMX.TabControl;
type
TFrameClass = class of TFrame;
TFormMain = class(TForm)
TabControl1: TTabControl;
TabItem1: TTabItem;
TabItem2: TTabItem;
PopupMenu1: TPopupMenu;
MenuItemInsert: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure TabControl1Change(Sender: TObject);
procedure MenuItemInsertClick(Sender: TObject);
public
frame: TFrame;
frames: array[0..1] of TFrameClass;
end;
var
FormMain: TFormMain;
implementation
{$R *.fmx}
uses
MyFrameIntf, Unit2, Unit3;
procedure TFormMain.FormCreate(Sender: TObject);
begin
frames[0] := TFrame1;
frames[1] := TFrame2;
end;
procedure TFormMain.MenuItemInsertClick(Sender: TObject);
var
intf: IMyFrameIntf;
begin
if Supports(frame, IMyFrameIntf, intf) then
intf.Insert;
end;
procedure TFormMain.TabControl1Change(Sender: TObject);
var
frameClass: TFrameClass;
begin
frameClass := frames[TabControl1.TabIndex];
frame := frameClass.Create(TabControl1.ActiveTab);
frame.Parent := TabControl1.ActiveTab;
end;
end.
MyFrameIntf.pas
unit MyFrameIntf;
interface
type
IMyFrameIntf = interface
['{83A4D2BF-C72F-4075-9450-4A1480A674A4}']
procedure Insert;
end;
implementation
end.
Unit2.pas
unit Unit2;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Controls.Presentation,
MyFrameIntf;
type
TFrame1 = class(TFrame, IMyFrameIntf)
Label1: TLabel;
private
{ Private declarations }
public
{ Public declarations }
procedure Insert;
end;
implementation
{$R *.fmx}
procedure TFrame1.Insert;
begin
//
end;
end.
Unit3.pas
unit Unit3;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Controls.Presentation, FMX.Edit,
MyFrameBase;
type
TFrame2 = class(TFrame, IMyFrameIntf)
Edit1: TEdit;
private
{ Private declarations }
public
{ Public declarations }
procedure Insert;
end;
implementation
{$R *.fmx}
procedure TFrame2.Insert;
begin
//
end;
end.
Create your base class (with the additional functions that you want) from New Items dialog, Delphi Projects|Delphi File|VCL Frame, as now.
But then develop all your other frames from that base one you created by selecting from the New Items dialog Delphi Project|Inheritable Items|Your base dialog (which will have been added to this page).
Note that this is not really any different from Remy's first solution, but it explains how in practice you might do it. You are obviously doing something wrong in trying to follow Remy's instructions.
I have a problem with the MediaLibrary on Delphi.
I make this code below on my main form:
unit uPrincipal;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants,FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics,
FMX.Dialogs,
FMX.Controls.Presentation, FMX.MultiView, FMX.Objects, FMX.Layouts,
FMX.StdCtrls, System.Actions, FMX.ActnList, FMX.StdActns,
FMX.MediaLibrary.Actions, FMX.MediaLibrary, FMX.Platform, System.Messaging;
type
TfmPrincipal = class(TForm)
Layout1: TLayout;
mvMenu: TMultiView;
rctMenuPrincipal: TRectangle;
rctMenuTop: TRectangle;
rctMenuBody: TRectangle;
rctOpHome: TRectangle;
rctBodyPrincipal: TRectangle;
tbPrincipal: TToolBar;
StyleBook1: TStyleBook;
sbMenu: TSpeedButton;
sbPhoto: TSpeedButton;
ActionList1: TActionList;
TakePhotoFromLibraryAction1: TTakePhotoFromLibraryAction;
Image1: TImage;
TakePhotoFromCameraAction1: TTakePhotoFromCameraAction;
procedure TakePhotoFromLibraryAction1DidFinishTaking(Image: TBitmap);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmPrincipal: TfmPrincipal;
implementation
{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}
{$R *.NmXhdpiPh.fmx ANDROID}
{$R *.iPhone.fmx IOS}
uses uLogin, uTeste;
procedure TfmPrincipal.TakePhotoFromLibraryAction1DidFinishTaking(
Image: TBitmap);
begin
Image1.Bitmap.Assign(Image);
end;
end.
When I run this on my phone, I click on the SpeedButton, and I receive an "invalid class typecast" error message.
I have added TakePhotoFromLibraryAction1 in the TActionList, and set it as the Action for the SpeedButton.
I don't know why I am getting this error.
It's a bug in your version of Delphi.
One workaround is to use a TButton instead of a TSpeedButton.
Another workaround is to remove the Action assignment from the SpeedButton, and then use the button's OnClick event to call the action's ExecuteTarget()method, passing it a different control as the Target parameter.
I have this code that is merely trying to create a form in a DLL. I created the DLL and the form through the RAD studio Berlin IDE. I wanted to just put up a blank form to make sure it was working, unfortunately it is crashing with an EAcess violation (or alternately, an EResNotFound exception with message "Resource TSigForm can not be found"), and I can't figure out what is missing.
DLL code:
library SigDLL;
uses
System.SysUtils, System.Classes, Windows, Vcl.Forms, Vcl.Dialogs,
SignatureForm in 'SignatureForm.pas' {SigForm1};
{$R *.res}
var
SigForm: TSigForm;
procedure PrepareSigDLL(AppHandle : HWND); stdcall;
begin
SigForm := TSigForm.Create(nil); // <--------- CRASHES HERE
end;
procedure GetSignature(Variables: PChar); stdcall;
begin
ShowMessage('GetSignature called!');
end;
procedure CloseSigDLL; stdcall;
begin
ShowMessage('CloseSigDLL called!');
end;
exports
PrepareSigDLL,
GetSignature,
CloseSigDLL;
begin
end.
SigForm code:
unit SignatureForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
type
TSigForm = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
SigForm: TSigForm;
implementation
{$R *.dfm}
end.
Generic Host app for DLL:
unit SigDllHost;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
procedure PrepareSigDLL(handle: HWND); stdcall; external 'SigDll.dll';
type
TForm2 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
PrepareSigDLL(Self.Handle);
end;
end.
This is a continuation of my question: How can I display a Delphi form in a panel?
I want to use a forms global variable to embed it in a panel to display it now, but it only creates the form to embed, without it's buttons.
In the code of the executable I'm creating the form to embed first and the form that I want to embed it in second, like so:
program Project1;
uses
System.StartUpCopy,
FMX.Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm2, Form2);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
The main form's code is:
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Panel1: TPanel;
procedure EmbedForm(ArgParent : TControl; ArgForm : TCustomForm);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
uses Unit2;
procedure TForm1.FormCreate(Sender: TObject);
begin
EmbedForm(Panel1, Form2);
end;
procedure TForm1.EmbedForm(ArgParent: TControl; ArgForm: TCustomForm);
begin
while ArgForm.ChildrenCount>0 do
begin
ArgForm.Children[0].Parent:= ArgParent;
end;
end;
end.
The code of the form to embed is:
unit Unit2;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls;
type
TForm2 = class(TForm)
Button2: TButton;
Button1: TButton;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.fmx}
end.
The way I've done this before to avoid having to iterate through all you ArgForm's children is by having a "master container" of sorts on the ArgForm that has all the children you need.
How I set this up is by
first placing a TLayout, aligned to Client on the ArgForm
Next, I added all my children controls to the TLayout of ArgForm (buttons etc..)
Next add a panel to the form we want this embedded in
After that form was setup, I assign the layout of ArgForm to the Parent form's panel on ParentForm's OnShow rather than the OnCreate ( ArgForm.Children[0].Parent:=Self.Panel1;)
Project Source:
program Project1;
uses
System.StartUpCopy,
FMX.Forms,
Unit1 in 'Unit1.pas' {ParentForm},
Unit2 in 'Unit2.pas' {ArgForm};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TParentForm, ParentForm);
Application.CreateForm(TArgForm, ArgForm);
Application.Run;
end.
Parent Form Code:
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,unit2,
FMX.StdCtrls;
type
TParentForm = class(TForm)
Panel1: TPanel;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
ParentForm: TParentForm;
implementation
{$R *.fmx}
procedure TParentForm.FormShow(Sender: TObject);
begin
ArgForm.Children[0].Parent:=Self.Panel1;
end;
end.
ArgForm Code:
unit Unit2;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
FMX.Layouts;
type
TArgForm = class(TForm)
Layout1: TLayout;
Button1: TButton;
Button2: TButton;
private
{ Private declarations }
public
{ Public declarations }
end;
var
ArgForm: TArgForm;
implementation
{$R *.fmx}
end.
Maybe someone else could answer, but it just seemed to me the reason why the buttons weren't showing on the create, was that the controls hadn't been created at that time?