I'm trying to develop a component, specifically a button linked to a popup menu.
I can not understand why I do not see the PopupMenu.
Down here my code:
unit DropDownButton;
interface
uses
System.SysUtils,
System.Classes,
Vcl.Controls,
Vcl.StdCtrls,
System.Types,
Vcl.Menus;
type
TDropDownButton = class;
TDropDownButton = class(TButton)
private
FDropDownMenu: TPopupMenu;
protected
public
constructor Create(AOwner: TComponent); override;
procedure Click; override;
published
property DropDownMenu: TPopupMenu read FDropDownMenu;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Flexline', [TDropDownButton]);
end;
constructor TDropDownButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDropDownMenu:= TPopupMenu.Create(Self);
FDropDownMenu.Name:= 'Menu';
FDropDownMenu.SetSubComponent(True);
end;
procedure TDropDownButton.Click;
var
_point: TPoint;
begin
_point:= Self.ClientToScreen(Point(0,0));
FDropDownMenu.Popup(_point.X,_point.Y + Height);
inherited Click;
end;
end.
Thanks in advance.
I'd like to make a dropdown button to use in my project
Related
I'm trying to build a component based on FMX.Objects.TImage. I want the permanently assigned images by MultiResBitmap.Items to change without having to use OnMouseEnter and OnMouseLeave in the application. Of course, I will use the constructor and the destructor.
I'm a beginner, and maybe I don't understand something. I've been trying for a week now, and I can't detect the mouse over the component and assign events correctly to it. I temporarily used ShowMessage() for the test.
Theoretically, this code should probably work and not work. Tell me what I'm doing wrong.
unit ImageCustoms;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, FMX.Types, vcl.Controls, FMX.Objects, FMX.ImgList, vcl.Dialogs, vcl.Graphics, FMX.ExtCtrls;
type
TImageCostoms = class(TImage)
private
{ Private declarations }
FOnMouseLeave: TNotifyEvent;
FOnMouseEnter: TNotifyEvent;
procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
protected
{ Protected declarations }
procedure DoMouseEnter; virtual;
procedure DoMouseLeave; virtual;
public
{ Public declarations }
//constructor Create(AOwner: TComponent); override;
//destructor Destroy; override;
published
{ Published declarations }
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TImageCostoms]);
end;
procedure TImageCostoms.CMMouseEnter(var msg: TMessage);
begin
ShowMessage('Enter');
DoMouseEnter;
end;
procedure TImageCostoms.CMMouseLeave(var msg: TMessage);
begin
ShowMessage('Leave');
DoMouseLeave;
end;
procedure TImageCostoms.DoMouseEnter;
begin
if Assigned(FOnMouseEnter) then
ShowMessage('Enter');
FOnMouseEnter(Self);
end;
procedure TImageCostoms.DoMouseLeave;
begin
if Assigned(FOnMouseLeave) then
ShowMessage('Leave');
FOnMouseLeave(Self);
end;
{constructor TImageCostoms.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png'); // .\img\i.png
end;
destructor TImageCostoms.Destroy;
begin
inherited Destroy;
end; }
end.
First off, don't mix VCL and FMX units together in your own units. VCL and FMX are not designed to be used together. And since FMX is cross-platform, don't use Winapi units in your code unless you are writing Windows-specific code (which you are not, in this situation).
You don't need to handle the CM_MOUSE(ENTER|LEAVE) messages directly, the framework already does that internally for you. And you don't need to redeclare the OnMouse(Enter|Leave) events, they already exist and are published in TImage.
All you really need to do is override (not redeclare) the existing virtual DoMouse(Enter|Leave) methods from Timage, eg:
unit ImageCustoms;
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Objects, FMX.ImgList, FMX.ExtCtrls;
type
TImageCostoms = class(TImage)
private
{ Private declarations }
protected
{ Protected declarations }
procedure DoMouseEnter; override;
procedure DoMouseLeave; override;
public
{ Public declarations }
//constructor Create(AOwner: TComponent); override;
//destructor Destroy; override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TImageCostoms]);
end;
procedure TImageCostoms.DoMouseEnter;
begin
...
inherited;
end;
procedure TImageCostoms.DoMouseLeave;
begin
...
inherited;
end;
{constructor TImageCostoms.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png'); // .\img\i.png
end;
destructor TImageCostoms.Destroy;
begin
inherited Destroy;
end; }
end.
Don't use ShowMessage() to debug component code, especially in events that react to keyboard/mouse focus changes. If you want to see debug messages, use OutputDebugString() or equivilent instead, and then look for the messages in the IDE's Output window. Or, just make display changes in your UI, like color changes, etc.
Thank you, it helped me, I was trying very uphill. In fact, in FMX it is simple and everything works. Thank you very much. I write the virtual keyboard support for the program, the whole is just a transparent button changing the focus slightly. Thanks again. For posterity, for now, it looks like this, I will try to add support from the global ImageList.
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Objects, FMX.ImgList, vcl.Dialogs, System.UITypes;
type
TImageCostoms = class(TImage)
private
{ Private declarations }
procedure DoMouseEnter; override;
procedure DoMouseLeave; override;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TImageCostoms]);
end;
procedure TImageCostoms.DoMouseEnter;
begin
inherited ;
MultiResBitmap.Items[1].Bitmap.LoadFromFile('focus1.png');
end;
procedure TImageCostoms.DoMouseLeave;
begin
inherited;
MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png');
end;
constructor TImageCostoms.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
width:=45;
height:=45;
MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png');
end;
end.```
I run in this situation where Destroy() is never called.
unit Unit2;
interface
type
// Interface
ITest = Interface(IInterface)
function IsTrue() : Boolean;
end;
TmyClass = class(TInterfacedObject, ITest)
public
// Interface implementation
function IsTrue() : Boolean;
constructor Create();
destructor Destroy(); override;
end;
implementation
constructor TmyClass.Create();
begin
inherited Create();
end;
destructor TmyClass.Destroy();
begin
inherited Destroy();
end;
published
// Property
property IsItTrue: Boolean read IsTrue;
end.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
Vcl.Dialogs, Vcl.StdCtrls, unit2;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
fMyClass: TmyClass;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
fMyClass.Free; // if refcount = 0 this works, if refcount <> 0 pointer error.
//or
fMyClass := Nil; // no error but Destroy wil not be executed
Close();
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fMyClass := TMyClass.Create();
end;
end.
Reading this article, there is only a constructor but no destructor implemented.
Is there any particular reason for this?
And should I release (if needed) all other objects that will be defined in myClass by implementing a finalization section?
The most likely reason for the destructor not being called would be because you don't assign your object to an interface variable.
procedure Test1;
var
vMyObj : TObject;
begin
vMyObj := myclass.Create;
end; <-Destructor NOT called here
procedure Test2;
var
vMyIntf : IInterface;
begin
vMyIntf := myclass.Create;
end; <-Destructor IS called here.
If that's the case, I invite you to read this answer for more information.
Your fMyClass variable is an object reference, not an interface, so it does not participate in TInterfaceObject's reference counting.
You need to change this:
fMyClass: TmyClass;
to this:
fMyClass: ITest;
And then you can get rid of fMyClass.Free; altogether:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
Vcl.Dialogs, Vcl.StdCtrls, unit2;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
fMyClass: ITest;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
fMyClass := nil; // no error and Destroy will be executed
Close();
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fMyClass := TMyClass.Create();
end;
end.
fMyClass := nil; will invoke reference counting only if fMyClass is an interface variable, not an object reference, and you can't call Free() on an interface variable.
I have a custom control derived from TPanel named TTestCtrl. It holds a TImage32 (from Graphics32).
When the user double clicks on the image, I show a message. The problem is that after I close the message, the focus is not returned back to the main application. So, the first click, no matter what I click on in the main app/main form, is lost.
Strange thing: If I call the Mesaj() procedure not from the TTestCtrl but from the main form, it works (the first click is not lost anymore):
unit DerivedControl;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Vcl.Dialogs, Vcl.Forms, GR32, GR32_Image;
type
TTestCtrl = class(TPanel)
private
Img: TImage32;
protected
procedure ChromaDblClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
published
end;
procedure Mesaj(const MessageText, Title: string);
implementation
procedure Mesaj(const MessageText, Title: string);
begin
{$IFDEF MSWINDOWS}
Application.MessageBox(PChar(MessageText), PChar(Title), 0) { 'Title' will appear in window's caption }
{$ELSE}
MessageDlg(MessageText, mtInformation, [mbOk], 0);
{$ENDIF}
end;
constructor TTestCtrl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 200;
Height := 86;
Img := TImage32.Create(Self);
Img.Parent := Self;
Img.Align := alClient;
Img.OnDblClick := ChromaDblClick;
end;
procedure TTestCtrl.ChromaDblClick(Sender: TObject);
begin
Mesaj('Caption', 'From derived control'); // focus lost
end;
end.
The simple/minimal application below is the tester:
unit TesterForm;
interface
uses
System.SysUtils, System.Classes, Vcl.StdCtrls, Vcl.Samples.Spin, Vcl.Controls, vcl.Forms, DerivedControl;
type
TfrmTester = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
frmTester: TfrmTester;
implementation
{$R *.dfm}
var
Ctrl: TTestCtrl;
procedure TfrmTester.FormCreate(Sender: TObject);
begin
Ctrl := TTestCtrl.Create(Self);
Ctrl.Parent := Self;
end;
procedure TfrmTester.Button1Click(Sender: TObject);
begin
Mesaj('Caption', 'From main form'); // works
end;
end.
Try this :
procedure TTestCtrl.ChromaDblClick(Sender: TObject);
var F : TcustomForm;
begin
Mesaj('Caption', 'From derived control'); // focus lost
F := GetParentForm(Self);
if Assigned(F) then F.BringToFront;
end;
Delphi XE-6
I am trying to create my own custom Firemonkey control derived from TGroupBox, where I create a TGridPanelLayout Control on the groupbox.
constructor TMyRadioGroup.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FLayout:= TGridPanelLayout.Create(self);
FLayout.Parent:= self;
end;
How do I prevent the user from being able to select and /or delete the TGridPanelLayout control? At design time, I only want my parent control (derived from TGroupbox) to be select-able and delete-able from the form.
You need to set the Stored property to false for each child control you do not want selectable at design time. For example the following code creates a panel with two child controls, a TEdit and a TButton.
unit PanelCombo;
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Controls,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Edit;
type
TPanelCombo = class(TPanel)
private
{ Private declarations }
edit1: TEdit;
button1: TButton;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TPanelCombo]);
end;
constructor TPanelCombo.Create(AOwner: TComponent);
begin
inherited;
edit1:= TEdit.create(self);
edit1.parent:= self;
edit1.align:= TAlignLayout.Top;
edit1.stored:= false;
button1:= TButton.create(self);
button1.parent:= self;
button1.align:= TAlignLayout.bottom;
button1.stored:= false;
end;
destructor TPanelCombo.Destroy;
begin
inherited;
edit1.Free;
button1.Free;
end;
end.
Being new to OOP, I'm curious why Delphi XE7 generated an invalid pointer operation on a logging class I was using whenI try to free it. So I created a simple test to create an object and then free it. I'm not sure what I'm missing here and why it throws this exception when MyObject.Free is called.
In the first unit, I create an instance of this object as shown here.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Unit2;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MyObject: TMyObject;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
MyObject := TMyObject.Create;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
MyObject.Free;
end;
end.
In the 2nd unit, I have the object defined as follows.
unit Unit2;
interface
uses System.Classes;
type
TMyObject = class
public
constructor Create;
destructor Free;
end;
implementation
constructor TMyObject.Create;
begin
inherited Create;
end;
destructor TMyObject.Free;
begin
inherited Free;
end;
end.
Any help is appreciated.
Always implement a destructor by overriding the virtual destructor named Destroy.
type
TMyObject = class
public
constructor Create;
destructor Destroy; override;
end;
constructor TMyObject.Create;
begin
inherited;
end;
destructor TMyObject.Destroy;
begin
inherited;
end;
To destroy an instance call the method named Free in TObject. This calls the virtual destructor Destroy only if the instance is not nil.
Learn more from the documentation:
http://docwiki.embarcadero.com/Libraries/en/System.TObject.Free
http://docwiki.embarcadero.com/Libraries/en/System.TObject.Destroy
The name MyObject is weak. Object is used for instances. Class is used for classes.