Jump to content
Sign in to follow this  
JackT

Styled controls registering

Recommended Posts

I have made an extended rectangle class TRoundRectExt in a unit called RoundedRectExt

 

I register it like this in the initialization section

 

initialization
begin
RegisterFMXClasses([TRoundRectExt]);
end;

 

TRoundRectExt lives in a package with other custom controls.

 

 

I then refer to TRoundRectExt inside a custom style file.

 

The problem comes when I apply that style to a new form and run my program I get the exception Class TRoundRectExt not found because TRoundRectExt has not been registered because 

the initialization section for TRoundRectExt hasn't been run.

 

Adding RounderRectExt to the uses clause of the form fixes the problem.

 

Am I registering my custom component in the right way ?

 is there any way I can tell a style file that it needs to load a package first ?

 

Thanks for any help in advance

 

 

Jack T

 

unit RoundedRectExt;

interface

uses FMX.Objects,FMX.Types,Classes,FMX.Graphics;

type TRoundRectExt=class(TRoundRect)
private
FCornerType:TCornerType;
FDisabledFill:TBrush;
FDisabledStroke:TStrokeBrush;
FDisabledOpacity:Single;
FXRadius,FYRadius:Single;
procedure SetCornerType(CT:TCornerType);
procedure SetDisabledOpacity(NV:Single);
procedure SetXRadius(NV:Single);
procedure SetYRadius(NV:Single);
procedure SetDisabledStroke(NB:TStrokeBrush);
procedure SetDisabledFill(NB:TBrush);
protected
procedure Paint;override;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy();override;
published
property CornerType:TCornerType read FCOrnerType write SetCornerType;
property DisabledOpacity:Single read FDisabledOpacity Write SetDisabledOpacity;
property DisabledFill:TBrush read FDisabledFill write SetDisabledFill;
property DisabledStroke:TStrokeBrush read FDisabledStroke write SetDisabledStroke;
property XRadius:Single read FXRadius write SetXRadius;
property YRadius:Single read FYRadius write SetYRadius;
end;

procedure Register;

implementation

{ TRoundRectExt }



uses  System.Types,Math,UITypes,FMXCommonFunc,FMX.Controls,SysUtils;

procedure Register;
begin
   RegisterComponents('JPTCerca', [TRoundRectExt]);
end;

function GetDrawingShapeRectAndSetThickness(const AShape: TShape; const Fit: Boolean; var FillShape, DrawShape: Boolean;
  var StrokeThicknessRestoreValue: Single): TRectF;
const
  MinRectAreaSize = 0.01;
begin
  FillShape := (AShape.Fill <> nil) and (AShape.Fill.Kind <> TBrushKind.None);
  DrawShape := (AShape.Stroke <> nil) and (AShape.Stroke.Kind <> TBrushKind.None);

  if Fit then
    Result := TRectF.Create(0, 0, 1, 1).FitInto(AShape.LocalRect)
  else
    Result := AShape.LocalRect;

  if DrawShape then
  begin
    if Result.Width < AShape.Stroke.Thickness then
    begin
      StrokeThicknessRestoreValue := AShape.Stroke.Thickness;
      FillShape := False;
      AShape.Stroke.Thickness := Min(Result.Width, Result.Height);
      Result.Left := (Result.Right + Result.Left) * 0.5;
      Result.Right := Result.Left + MinRectAreaSize;
    end
    else
      Result.Inflate(-AShape.Stroke.Thickness * 0.5, 0);

    if Result.Height < AShape.Stroke.Thickness then
    begin
      if StrokeThicknessRestoreValue < 0.0 then
        StrokeThicknessRestoreValue := AShape.Stroke.Thickness;
      FillShape := False;
      AShape.Stroke.Thickness := Min(Result.Width, Result.Height);
      Result.Top := (Result.Bottom + Result.Top) * 0.5;
      Result.Bottom := Result.Top + MinRectAreaSize;
    end
    else
      Result.Inflate(0, -AShape.Stroke.Thickness * 0.5);
  end;
end;





constructor TRoundRectExt.Create(AOwner: TComponent);
begin
FXRadius :=-1;
FYRadius :=-1;
FDisabledOpacity :=0.5;
FCornerType := TCornerType.Round;
FDisabledFill:=TBrush.Create(TBrushKind.Solid,TAlphaColorRec.Slategray);
FDisabledStroke:=TStrokeBrush.Create(TBrushKind.Solid,TAlphaColorRec.Grey);
  inherited;

end;

destructor TRoundRectExt.Destroy;
begin
  if Assigned(FDisabledFill) then FreeAndNil(DisabledFill);
  if Assigned(FDisabledStroke) then FreeAndNil(FDisabledStroke);
  inherited;
end;

procedure TRoundRectExt.Paint;
var
  Radius: Single;
  R: TRectF;
  StrokeThicknessRestoreValue: Single;
  FillShape, DrawShape: Boolean;
  XR:Single; //XRadius
  YR:Single; //YRadius;
  HalfWidth:Single;
  HAlfHeight:Single;
  Level:Integer;
  UseFill:TBrush;
  UseStroke:TStrokeBrush;
  UseOpacity:Single;
  C:TControl;
begin
  StrokeThicknessRestoreValue := Stroke.Thickness;
  try
    R := GetDrawingShapeRectAndSetThickness(Self, False, FillShape, DrawShape, StrokeThicknessRestoreValue);
    HalfWidth := R.Width/2;
    HalfHeight := R.Height /2;
    if Height < Width then
      Radius := HalfHeight
    else
      Radius := HalfWidth;
      //Set the X Radius to the Correct Value
   if FXRadius < 0 then
   begin
    XR := Radius;
   end
   else
   begin
    if FXRadius > HalfWidth then XR := HalfWidth else XR := FXRadius;
   end;

      if FYRadius < 0 then
   begin
    YR := Radius;
   end
   else
   begin
    if FYRadius > HalfHeight then XR := HalfHeight else YR := FYRadius;
   end;
   C:=Self As TControl;
   if ControlDisabledAtLevel(C,Level) then
   begin
      UseFill := FDisabledFill;
      UseStroke := FDisabledStroke;
      UseOpacity := FDisabledOpacity;
   end
   else
   begin
        UseFill := Fill;
       UseStroke := Stroke;
       UseOpacity :=  AbsoluteOpacity;
   end;

    if FillShape then
      Canvas.FillRect(R, XR, YR, Corners, UseOpacity, UseFill,FCornerType);
    if DrawShape then
      Canvas.DrawRect(R, XR, YR, Corners, UseOpacity, UseStroke,FCornerType);
  finally
    if StrokeThicknessRestoreValue <> Stroke.Thickness then
      Stroke.Thickness := StrokeThicknessRestoreValue;
  end;

end;



procedure TRoundRectExt.SetCornerType(CT: TCornerType);
begin
if CT <> FCornerType then
begin
  FCornerType := CT;
  repaint;
end;
end;



procedure TRoundRectExt.SetDisabledFill(NB: TBrush);
begin
FDisabledFill.Assign(NB);
end;

procedure TRoundRectExt.SetDisabledOpacity(NV: Single);
begin
if NV<0 then NV:=0;
if NV>1 then NV:=1;
FDisabledOpacity := NV;
end;



procedure TRoundRectExt.SetDisabledStroke(NB: TStrokeBrush);
begin
FDisabledStroke.Assign(NB);
end;

procedure TRoundRectExt.SetXRadius(NV: Single);
begin
FXRadius := NV;
Repaint;
end;

procedure TRoundRectExt.SetYRadius(NV: Single);
begin
FYRadius := NV;
RePaint;
end;

initialization
begin
RegisterFMXClasses([TRoundRectExt]);
end;

end.

 

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×