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.```
Related
I have made a data module and a button. When I send info to the data module it gives an access violation when the program is done even when nothing needs to be done. What is going wrong? I use Delphi XE on w8.1.
procedure TForm1.btnCalcClick(Sender: TObject);
var
ACake: TCake;
begin
ACake.Diameter:= StrToFloat(edtDiam.Text);
modMain.Calc(ACake);
end;
Here is the data module unit:
interface
uses
System.SysUtils, System.Classes, classdef;
type
TmodMain = class(TDataModule)
private
{ Private declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Calc(ACake: TCake);
end;
var
modMain: TmodMain;
implementation
{%CLASSGROUP 'System.Classes.TPersistent'}
{$R *.dfm}
{ TmodMain }
procedure TmodMain.Calc(ACake: TCake);
begin
end;
constructor TmodMain.Create(AOwner: TComponent);
begin
inherited;
end;
destructor TmodMain.Destroy;
begin
inherited;
end;
end.
To clarify my class definitions unit I will post it here.
Here is my classdef unit:
unit classdef;
interface
type
TCake = class
private
FDiameter: Double;
public
property Diameter: Double read FDiameter write FDiameter;
end;
implementation
end.
The problem is that you need to create a class instance before you can use it.
In this example I assume that your datamodule has been autocreated by the IDE.
So your code:
procedure TForm1.btnCalcClick(Sender: TObject);
var
ACake: TCake;
begin
ACake.Diameter:= StrToFloat(edtDiam.Text);
modMain.Calc(ACake);
end;
becomes:
procedure TForm1.btnCalcClick(Sender: TObject);
var
ACake: TCake;
begin
ACake := TCake.Create;
try
ACake.Diameter:= StrToFloat(edtDiam.Text);
modMain.Calc(ACake);
finally
ACake.Free;
end;
end;
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
I'm trying to create a VCL component like TImage, that lets me add a variable amount of different sized TPictures.
The Goal is to be able to assign that number of TPictures through the VCL editor in the property list.
delphi component property: TObjectList<TPicture> here we came to the conclusion, that a TCollection with TCollectionItems should be used. This is what I'm trying to do now, but as many times before i end up with the compiler error: "Published property 'Pictures' can not be of Type ARRAY" in this line:
property Pictures[Index: Integer]: TPic read GetPic write SetPic;
unit ImageMultiStates;
interface
uses
Vcl.Graphics, Vcl.StdCtrls, System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Forms, Generics.Collections;
type
TPic = class(TCollectionItem)
private
FPicture: TPicture;
public
procedure Assign(Source: TPersistent); override;
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
published
property Picture: TPicture read FPicture write FPicture;
end;
TPictures = class(TCollection)
private
function GetPic(Index: Integer): TPic;
procedure SetPic(Index: Integer; APicture: TPic);
public
constructor Create;
published
property Pictures[Index: Integer]: TPic read GetPic write SetPic;
end;
TImageMultiStates = class(TImage)
private
FPictures: TPictures;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Activate(Index: Integer);
end;
procedure Register;
implementation
constructor TPic.Create(Collection: TCollection);
begin
inherited Create(Collection);
end;
destructor TPic.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;
procedure TPic.Assign(Source: TPersistent);
begin
FPicture.Assign(Source);
end;
constructor TPictures.Create;
begin
inherited Create(TPic);
end;
procedure TPictures.SetPic(Index: Integer; APicture: TPic);
begin
Items[Index].Assign(APicture);
end;
function TPictures.GetPic(Index: Integer): TPic;
begin
Result := TPic(inherited Items[Index]);
end;
constructor TImageMultiStates.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TImageMultiStates.Destroy;
begin
FPictures.Free;
inherited Destroy;
end;
procedure TImageMultiStates.Activate(Index: Integer);
begin
Picture.Assign(FPictures.Items[Index]);
end;
procedure Register;
begin
RegisterComponents('Standard', [TImageMultiStates]);
end;
end.
Since noone seems to expect this error to be thrown, maybe it's related to my installed components? I used the internal GetIt Package-Manager to install the Jedi Code Library 2.8, Jedi Visual Component Library and PNGComponents 1.0. I guess that's about it as far as TImage-related components are concerned. Maybe one of these overrides some of my TImage contents with funky stuff...
I experimented a little and derived a TPicturePanel from TPanel. It has a Pictures property, which is a TPictures, a descendant of TOwnedCollection and which contains TPics. Each TPic has a Picture property. I can install this component, and it allows me to edit the Pictures collection using the so called Collection editor, which allows you to add or remove TPic instances. If you select a TPic in the Collection editor, you can assign a picture to its Picture property, i.e. load from file, etc.
Here is the working code for TPicturePanel. You can model your component after this:
unit PicturePanels;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Vcl.Graphics;
type
TPic = class(TCollectionItem)
private
FPicture: TPicture;
procedure SetPicture(const Value: TPicture);
public
procedure Assign(Source: TPersistent); override;
constructor Create(AOwner: TCollection); override;
destructor Destroy; override;
published
property Picture: TPicture read FPicture write SetPicture;
end;
TPictures = class(TOwnedCollection)
private
function GetItem(Index: Integer): TPic;
procedure SetItem(Index: Integer; const Value: TPic);
public
constructor Create(AOwner: TPersistent);
property Items[Index: Integer]: TPic read GetItem write SetItem;
end;
TPicturePanel = class(TPanel)
private
FPictures: TPictures;
procedure SetPictures(const Value: TPictures);
published
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Pictures: TPictures read FPictures write SetPictures;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TPicturePanel]);
end;
{ TPicturePanel }
constructor TPicturePanel.Create(AOwner: TComponent);
begin
inherited;
FPictures := TPictures.Create(Self);
end;
destructor TPicturePanel.Destroy;
begin
FPictures.Free;
inherited;
end;
procedure TPicturePanel.SetPictures(const Value: TPictures);
begin
FPictures.Assign(Value);
end;
{ TPic }
procedure TPic.Assign(Source: TPersistent);
begin
inherited;
if Source is TPic then
FPicture.Assign(TPic(Source).FPicture);
end;
constructor TPic.Create(AOwner: TCollection);
begin
inherited;
FPicture := TPicture.Create;
end;
destructor TPic.Destroy;
begin
FPicture.Free;
inherited;
end;
procedure TPic.SetPicture(const Value: TPicture);
begin
FPicture.Assign(Value);
end;
{ TPictures }
constructor TPictures.Create(AOwner: TPersistent);
begin
inherited Create(AOwner, TPic);
end;
function TPictures.GetItem(Index: Integer): TPic;
begin
Result := inherited GetItem(Index) as TPic;
end;
procedure TPictures.SetItem(Index: Integer; const Value: TPic);
begin
inherited SetItem(Index, Value);
end;
end.
Your indexed property uses syntax that looks like it returns an array, but it doesn't do that. The pictures property returns an indexed TPic. It can only ever return one TPic at a time.
If you want to return an array you'll have to say so:
function GetPictures: TArray<TPicture>;
procedure SetPictures(const value: TArray<TPicture>);
property Pictures: TArray<TPicture> read GetPictures write SetPictures;
//GetPictures might look something like this:
function TMyClass.GetPictures: TArray<TPicture>;
var
i: integer;
begin
SetLength(Result, Self.FPictureCount);
for i:= 0 to FPictureCount - 1 do begin
Result[i]:= GetMyPicture[i];
end;
end;
I'm not sure how your TPic collection works, so you'll have to adjust it to suit your needs.
Obviously you can have an TArray<TArray<TPicture>> (aka: array of array of TPicture) if you so desire.
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.
I need to send a windows message to a TDataModule in my Delphi 2010 app.
I would like to use
PostMessage(???.Handle, UM_LOG_ON_OFF, 0,0);
Question:
The TDataModule does not have a Handle. How can I send a windows message to it?
You can give it a handle easily enough. Take a look at AllocateHWND in the Classes unit. Call this to create a handle for your data module, and define a simple message handler that will process UM_LOG_ON_OFF.
Here is an example demonstrating how to create a TDataModule's descendant with an Handle
uses
Windows, Winapi.Messages,
System.SysUtils, System.Classes;
const
UM_TEST = WM_USER + 1;
type
TMyDataModule = class(TDataModule)
private
FHandle: HWND;
protected
procedure WndProc(var Message: TMessage); virtual;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy(); override;
property Handle : HWND read FHandle;
end;
...
uses
Vcl.Dialogs;
constructor TMyDataModule.Create(AOwner : TComponent);
begin
inherited;
FHandle := AllocateHWND(WndProc);
end;
destructor TMyDataModule.Destroy();
begin
DeallocateHWND(FHandle);
inherited;
end;
procedure TMyDataModule.WndProc(var Message: TMessage);
begin
if(Message.Msg = UM_TEST) then
begin
ShowMessage('Test');
end;
end;
Then we can send messages to the datamodule, like this:
procedure TForm1.Button1Click(Sender: TObject);
begin
PostMessage(MyDataModule.Handle, uMyDataModule.UM_TEST, 0, 0);
end;