Firemonkey custom component

  

I’m trying to create a cross-platform component for FireMonkey on Delphi XE8…

But I’m facing some problems. Although up the properties “Width” and “Height” in the Object Inspector to compile apparently the size settings are ignored. And when I reopen the project my component is also small. (I noticed that the width and height settings are not saved to the DFM file).

Note: All other native components of FireMonkey work properly, just my custom not.

Whats the problem?

unit FMX.Card;

interface

uses
System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Graphics, System.Types;

type

TCardNum = (Ace, Deuce, Three, Four, Five, Six, Seven, Eight, Nine, Ten, Jack, Queen, King);

TCardSuit = (Clubs, Diamonds, Hearts, Spades);

TCard = class(TControl)
private
{ Private declarations }
FCardBack: TBitmap;
FCardDown: Boolean;
FCardSet: TBitmap;
FCardNum: TCardNum;
FCardSuit: TCardSuit;
procedure SetCardDown(AValue: Boolean);
procedure SetCardNum(AValue: TCardNum);
procedure SetCardSuit(AValue: TCardSuit);
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Position;
property RotationAngle;
property Width;
property Height;
property CardDown: Boolean read FCardDown write FCardDown;
property CardNum: TCardNum read FCardNum write FCardNum;
property CardSuit: TCardSuit read FCardSuit write FCardSuit;
end;

implementation

{$R ‘CardResource.res’}

const
DEFAULT_CARD_WIDTH = 71;
DEFAULT_CARD_HEIGHT = 96;

{ TCard }

constructor TCard.Create(AOwner: TComponent);
var
LRStream: TResourceStream;
begin
inherited;
LRStream := TResourceStream.Create(HInstance, ‘CardBack’, RT_RCDATA);
try
FCardBack := TBitmap.CreateFromStream(LRStream);
finally
LRStream.Free;
end;
LRStream := TResourceStream.Create(HInstance, ‘CardSet’, RT_RCDATA);
try
FCardSet := TBitmap.CreateFromStream(LRStream);
finally
LRStream.Free;
end;
end;

destructor TCard.Destroy;
begin
FCardBack.Free;
FCardSet.Free;
inherited;
end;

procedure TCard.Paint;
var
LLeft: Single;
LTop: Single;
begin
inherited;
Canvas.BeginScene;
try
if FCardDown then
Canvas.DrawBitmap(FCardBack, TRectF.Create(0, 0, FCardBack.Width, FCardBack.Height), TRectF.Create(0, 0, Width, Height), 1.0)
else
begin
LLeft := Ord(FCardNum) * DEFAULT_CARD_WIDTH;
LTop := Ord(FCardSuit) * DEFAULT_CARD_HEIGHT;
Canvas.DrawBitmap(FCardSet, TRectF.Create(LLeft, LTop, LLeft + DEFAULT_CARD_WIDTH, LTop + DEFAULT_CARD_HEIGHT), TRectF.Create(0, 0, Width, Height), 1.0);
end;
finally
Canvas.EndScene;
end;
end;

Comments are closed.