FMX: удаление самодельного компонента на дубликатах субкомпонентов формы - PullRequest
Новая
       6

FMX: удаление самодельного компонента на дубликатах субкомпонентов формы

0 голосов
/ 31 октября 2018

Я создал свой собственный индикатор выполнения (TProgressBalken), состоящий из TRectangle, внутри которого есть еще один TRectangle (a) другого цвета, ширина которого зависит от значения прогресса (0..100). Наконец Tlabel сидит поверх него, отображая текущее значение в виде текста. Все отлично работает при создании этого компонента во время выполнения.

При отбрасывании этого на новую мульти-аппаратную форму (IDE, установленная на 32-битные окна) она также работает нормально. Но при переключении IDE на Android TRectangle (a) и Label дублируются в файле fmx, теперь я вижу, что метка окрашена дважды. А Дельфи жалуется на дубликаты.

Первоначально я не назначил имя TRectangle (a) и Label, но Delphi пожаловался, поэтому я назначил имена во время создания, но фактическая проблема остается.

Есть идеи, чего не хватает?

Это мой компонент: 

unit ProgressBalken;

interface
uses
  System.SysUtils, System.Classes, System.UITypes,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.StdCtrls, FMX.Graphics, FMX.Objects;

type
  TProgressBalken = class(TRectangle)
    procedure FormDestroy(Sender: TObject);
    procedure BalkenUpdate;
    procedure SizeUpdate;
    procedure SetValue(v: integer);
    procedure SetUnits(v: string);
    procedure SetBalkenColor(v: TAlphaColor);
    function  GetBalkenColor: TAlphaColor;
    procedure aResize(Sender: TObject);
  private
    Balken: TRectangle;
    labelx: Tlabel;
    fValue: integer;
    funits: string;
  public
    constructor Create(AOwner: TComponent); override;

  published
    property Value: integer read fValue write SetValue;
    property ValueUnits: string read fUnits write SetUnits;
    property BalkenColor: TAlphaColor read GetBalkenColor write SetBalkenColor; // stored IsColorStored;
  end;

  procedure Register;

implementation
uses
windows, System.Math;

constructor TProgressBalken.Create(AOwner: TComponent);
begin
  inherited;
  width:=100;
  height:= 40;
  fValue:= 1;
  fUnits:= '';
  Parent:= TForm(AOwner);
  Fill.Color:= System.UITypes.TAlphaColorRec.red; //Null;
  Balken:= TRectangle.Create(self);
  Balken.Parent:= self;
  Balken.Position.X:= 0;
  Balken.Position.Y:= 0; ;
  Balken.Fill.Color:= System.UITypes.TAlphaColorRec.Aqua;
  Balken.name:= 'balken'+name;
  labelx:= Tlabel.Create(self);
  labelx.Parent:= Balken;
  labelx.name:= 'labelx'+name;
  OnResize:= aResize;
  SizeUpdate;
end;

procedure TProgressBalken.aResize(Sender: TObject);
begin
 SizeUpdate;
end;

procedure TProgressBalken.FormDestroy(Sender: TObject);
begin
  Balken.Free;
  labelx.Free;
  inherited;
end;

procedure TProgressBalken.SizeUpdate;
var
 h, y: single;
begin
  Balken.Height:= Height;
  Balken.Width:= Width;
  h:= System.Math.min(40, Height);
  labelx.StyledSettings:= labelx.StyledSettings - [TStyledSetting.Size];
  if h>20 then
    labelx.TextSettings.Font.Size:= round(0.5 * h)
  else
    labelx.TextSettings.Font.Size:= round(0.7 * h);
  y:= (height / 2) - (labelx.TextSettings.Font.Size / 2) -2;
  labelx.Position.Y:= System.Math.max(-5, y);
  labelx.Position.X:=  Width / 4;
  BalkenUpdate;
end;

procedure TProgressBalken.BalkenUpdate;
begin
  Balken.Width:= fValue / 100 *(width - 2*Balken.Position.x);
  labelx.Text:= IntToStr(fValue) +' ' +fUnits;
end;

procedure TProgressBalken.SetValue(v: integer);
var i: integer;
begin
  v:= System.Math.max(v, -1);
  fValue:= System.Math.min(v, 100);
  BalkenUpdate;
end;

procedure TProgressBalken.SetUnits(v: string);
begin
  fUnits:= v;
  SetValue(fValue);
end;

function TProgressBalken.GetBalkenColor: TAlphaColor;
begin
 result:= Balken.Fill.Color;
end;

procedure TProgressBalken.SetBalkenColor(v: TAlphaColor);
begin
  Balken.Fill.Color:= v;
end;

procedure Register;
begin
  RegisterComponents('3s_Spezielles', [TProgressBalken]);
end;

initialization
  RegisterFmxClasses([TProgressBalken]);

end.

Это fmx после удаления моего компонента TProgressBalken
IDE установлена ​​на 32-битную Windows 

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 480
  ClientWidth = 640
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 3
  object Button1: TButton
    Position.X = 56.000000000000000000
    Position.Y = 168.000000000000000000
    TabOrder = 1
    Text = 'Button1'
    OnClick = Button1Click
  end
  object ProgressBalken1: TProgressBalken
    Fill.Color = claRed
    Position.X = 40.000000000000000000
    Position.Y = 64.000000000000000000
    Size.Width = 100.000000000000000000
    Size.Height = 40.000000000000000000
    Size.PlatformDefault = False
    Value = 1
    BalkenColor = claAqua
    object balken: TRectangle
      Fill.Color = claAqua
      Size.Width = 1.000000000000000000
      Size.Height = 40.000000000000000000
      Size.PlatformDefault = False
      object labelx: TLabel
        StyledSettings = [Family, Style, FontColor]
        Position.X = 25.000000000000000000
        Position.Y = 8.000000000000000000
        TextSettings.Font.Size = 20.000000000000000000
        Text = '1 '
      end
    end
  end
end

Это fmx после установки IDE на Android
объект 'balken' теперь вставляется дважды 

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 480
  ClientWidth = 640
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object Button1: TButton
    Position.X = 56.000000000000000000
    Position.Y = 168.000000000000000000
    TabOrder = 1
    Text = 'Button1'
    OnClick = Button1Click
  end
  object ProgressBalken1: TProgressBalken
    Fill.Color = claRed
    Position.X = 40.000000000000000000
    Position.Y = 64.000000000000000000
    Size.Width = 100.000000000000000000
    Size.Height = 40.000000000000000000
    Size.PlatformDefault = False
    Value = 1
    BalkenColor = claAqua
    object balken: TRectangle
      Fill.Color = claAqua
      Size.Width = 1.000000000000000000
      Size.Height = 40.000000000000000000
      Size.PlatformDefault = False
      object labelx: TLabel
        StyledSettings = [Family, Style, FontColor]
        Position.X = 25.000000000000000000
        Position.Y = 8.000000000000000000
        TextSettings.Font.Size = 20.000000000000000000
        Text = '1 '
      end
    end
    object balken: TRectangle
      Fill.Color = claAqua
      Size.Width = 1.000000000000000000
      Size.Height = 40.000000000000000000
      Size.PlatformDefault = False
      object labelx: TLabel
        StyledSettings = [Family, Style, FontColor]
        Position.X = 25.000000000000000000
        Position.Y = 8.000000000000000000
        TextSettings.Font.Size = 20.000000000000000000
        Text = '1 '
      end
    end
  end
end

Ответы [ 2 ]

0 голосов
/ 31 октября 2018

В FMX для любого подкомпонента, который вы создаете в конструкторе, чтобы он был доступен во время разработки и для потоковой передачи DFM, необходимо установить для свойства Stored компонента значение False, а также вызвать SetSubComponent() на нем, например: 

constructor TProgressBalken.Create(AOwner: TComponent);
begin
  inherited;
  ...
  Balken := TRectangle.Create(self);
  Balken.SetSubComponent(True);
  Balken.Stored := False;
  ...
  labelx := Tlabel.Create(self);
  labelx.SetSubComponent(True);
  labelx.Stored := False;
  ...
end;

См. Firemonkey: как определить компонент, содержащий другой компонент?

0 голосов
/ 31 октября 2018

Вам необходимо вызвать SetSubComponent (True) для двух ваших подкомпонентов: 

constructor TProgressBalken.Create(AOwner: TComponent);
begin
  inherited;
  width:=100;
  height:= 40;
  fValue:= 1;
  fUnits:= '';
  Parent:= TForm(AOwner);
  Fill.Color:= System.UITypes.TAlphaColorRec.red; //Null;
  Balken:= TRectangle.Create(self);
  Balken.SetSubComponent(True);
  Balken.Parent:= self;
  Balken.Position.X:= 0;
  Balken.Position.Y:= 0; ;
  Balken.Fill.Color:= System.UITypes.TAlphaColorRec.Aqua;
  Balken.name:= 'balken'+name;
  labelx:= Tlabel.Create(self);
  labelx.SetSubComponent(True);
  labelx.Parent:= Balken;
  labelx.name:= 'labelx'+name;
  OnResize:= aResize;
  SizeUpdate;
end;
...