VPF::Свойства компонента при создании нового компонента

krik

Дата 20.7.2014, 14:53 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 24
Регистрация: 28.7.2008

Репутация: 1
Всего: 1

Всем привет. Ребят, подскажите как правильно создавать дополнительные свойства компоненту. Для изучения данного вопроса решил сделать компонент "BoolInput". В компоненте имеются 2 подкопонента, это TCricle и TRectangle. Добавленны 3 свойства. 1 - Negate (отрицание), 2 - Working (то что на входе отрицания), 3 - Output (выход с отрицания). Необходимо получить то, что показанно на рисунке к этому сообщению.

Суть в том, что если включено Negate = True, то видно белый кружочек. Если working = true, то видно зеленый прямоугольник, если false то черный прямоугольник. Проблема в том, что если меняю свойства - ничего не получается. Не корректно отрабатывает (кружочек не видно, а прямоугольник только в дизайнере меняется). Подскажите как сделать задуманное.

Использую Delphi XE5 Firemonkey desktop application
Вот код, который имеется:

Код


unit BoolInput;

interface

uses
  System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMXTee.Procs,
  FMX.Objects, FMX.Graphics;

type
  TBoolInput = class(TCustomPanelNoCaption)
  private
    { Private declarations }
    FCircle: TCircle;
    FRectangle: TRectangle;
    FWorking: Boolean;
    FNegate: Boolean;
    FOutput: Boolean;
    function GetWorking: Boolean;
    procedure SetWorking(Value: Boolean);
    function GetNegate: Boolean;
    procedure SetNegate(Value: Boolean);
    function GetOutput: Boolean;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    property Output: Boolean read GetOutput;
  published
    { Published declarations }
    property Working: Boolean read GetWorking write SetWorking;
    property Negate: Boolean read GetNegate write SetNegate;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TBoolInput]);
end;

{ TBoolInput }

constructor TBoolInput.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCircle := TCircle.Create(self);
  FCircle.Parent := Self;
  FCircle.Position.X := 23;
  FCircle.Position.Y := 0;
  FCircle.Width := 12;
  FCircle.Height := 12;
  FCircle.Stroke.Thickness := 0;
  FCircle.Stroke.Color := 0;
  FCircle.Fill.Color := $FFFFFFFF; //Dirty White $FFF8F8FF


  FRectangle:= TRectangle.Create(self);
  FRectangle.Parent := Self;
  FRectangle.Position.X := 0;
  FRectangle.Position.Y := 0;
  FRectangle.Width := 35;
  FRectangle.Height := 12;
  FRectangle.Stroke.Thickness := 0;
  FRectangle.Stroke.Color := 0;
  FRectangle.Fill.Kind := TBrushKind.bkSolid;
  FRectangle.Fill.DefaultColor := $FF696969;
  FRectangle.Fill.Color := $FF696969;

  Width := 35;
  Height := 12;
end;

function TBoolInput.GetNegate: Boolean;
begin
  Result := FNegate;
end;

function TBoolInput.GetOutput: Boolean;
begin
  Result := FOutput;
end;

function TBoolInput.GetWorking: Boolean;
begin
  Result := FWorking;
end;

procedure TBoolInput.SetNegate(Value: Boolean);
begin
  if(Value = True) then
    begin
      FCircle.Fill.Color := $FFFFFFFF;
      FOutput := Not(FWorking)
    end
  else
    begin
      FCircle.Fill.Color := 0;
      FOutput := FWorking;
    end;

  FNegate := Value;
end;

procedure TBoolInput.SetWorking(Value: Boolean);
begin
  if(Value = True) then
    begin
      FRectangle.Fill.Color := $FF00FF00;
      FOutput := (Value AND (Not FNegate));
    end
  else
    begin
      FRectangle.Fill.Color := $FF696969;
      FOutput := (Value OR FNegate);
    end;

  FWorking := Value;
end;

end.

Pavia

Дата 21.7.2014, 05:26 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 6.12.2008

Репутация: нет
Всего: 12

Так вы же не перерисовываете добавьте RePaint;

krik

Дата 21.7.2014, 08:51 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 24
Регистрация: 28.7.2008

Репутация: 1
Всего: 1

Куда еще добавить?

Сейчас получается, что при запуске светло-серый прямоугольник. Хотя такого цвета я ни где не ставил.

Давайте упросим задачу. Как добавить свойство любому компоненту, чтобы к примеру менялся цвет чего-либо, если это свойство в true? Разве совсем никто не знает?

Код


unit BoolInput;

interface

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

type
  TBoolInput = class(TControl)
  private
    FWorking: Boolean;
    FNegate: Boolean;
    FOutput: Boolean;
    FCircle: TCircle;
    FRectangle: TRectangle;
    function GetWorking: Boolean;
    procedure SetWorking(Value: Boolean);
    function GetNegate: Boolean;
    procedure SetNegate(Value: Boolean);
    function GetOutput: Boolean;
    procedure MyRePaint;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    property Output: Boolean read GetOutput;
  published
    { Published declarations }
    property Position;
    property Working: Boolean read GetWorking write SetWorking;
    property Negate: Boolean read GetNegate write SetNegate;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TBoolInput]);
end;

{ TBoolInput }

constructor TBoolInput.Create(AOwner: TComponent);
begin
  inherited;
  Width := 35;
  Height := 12;

  FRectangle:= TRectangle.Create(Self);
  FRectangle.Parent := Self;
  FRectangle.Width := 35;
  FRectangle.Height := 12;
  FRectangle.Position.X := 0;
  FRectangle.Position.Y := 0;
  FRectangle.Stroke.Thickness := 0;
  FRectangle.Stroke.Color := 0;
  FRectangle.Fill.Kind := TBrushKind.bkSolid;
  FRectangle.Fill.DefaultColor := $FF696969;
  FRectangle.Fill.Color := $FF696969;
  FRectangle.Visible := true;
  FRectangle.Repaint;

  FCircle := TCircle.Create(Self);
  FCircle.Parent := Self;
  FCircle.Width := 12;
  FCircle.Height := 12;
  FCircle.Position.X := 23;
  FCircle.Position.Y := 0;
  FCircle.Stroke.Thickness := 0;
  FCircle.Stroke.Color := 0;
  FCircle.Fill.Color := $FFFFFFFF;
  FCircle.Visible := false;
  FCircle.Repaint;
end;

function TBoolInput.GetNegate: Boolean;
begin
  Result := FNegate;
end;

function TBoolInput.GetOutput: Boolean;
begin
  Result := FOutput;
end;

function TBoolInput.GetWorking: Boolean;
begin
  Result := FWorking;
end;

procedure TBoolInput.MyRePaint;
begin
  if(Working=true) then
    FRectangle.Fill.Color := $FF00FF00
  else
    FRectangle.Fill.Color := $FF696969;

  if(Negate=true) then
    FCircle.Visible := true
  else
    FCircle.Visible := false;

  FCircle.Repaint;
  FRectangle.Repaint;
end;

procedure TBoolInput.SetNegate(Value: Boolean);
begin
  if(Value = True) then
    begin
      FOutput := Not(FWorking)
    end
  else
    begin
      FOutput := FWorking;
    end;

  FNegate := Value;
  MyRePaint;
end;

procedure TBoolInput.SetWorking(Value: Boolean);
begin
  if(Value = True) then
    begin
      FOutput := (Value AND (Not FNegate));
    end
  else
    begin
      FOutput := (Value OR FNegate);
    end;

  FWorking := Value;
  MyRePaint;
end;

end.

krik

Дата 21.7.2014, 10:02 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 24
Регистрация: 28.7.2008

Репутация: 1
Всего: 1

Вообщем, выкрутился используя Canvas. Кому интересно вот код:

Код


unit BoolInput;

interface

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

type
  TBoolInput = class(TControl)
  private
    FWorking: Boolean;
    FNegate: Boolean;
    FOutput: Boolean;
    function GetWorking: Boolean;
    procedure SetWorking(Value: Boolean);
    function GetNegate: Boolean;
    procedure SetNegate(Value: Boolean);
    function GetOutput: Boolean;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    property Output: Boolean read GetOutput;
    procedure Paint; override;
  published
    { Published declarations }
    property Position;
    property Working: Boolean read GetWorking write SetWorking;
    property Negate: Boolean read GetNegate write SetNegate;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TBoolInput]);
end;

{ TBoolInput }

constructor TBoolInput.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 35;
  Height := 12;
end;

function TBoolInput.GetNegate: Boolean;
begin
  Result := FNegate;
end;

function TBoolInput.GetOutput: Boolean;
begin
  Result := FOutput;
end;

function TBoolInput.GetWorking: Boolean;
begin
  Result := FWorking;
end;

procedure TBoolInput.Paint;
var
  MyRect: TRectF;
begin
  inherited Paint;

  MyRect := TRectF.Create(0, 0, Width, Height);
  Canvas.Stroke.Thickness := 0;
  Canvas.Stroke.Color := 0;

  if(Working=true) then
    Canvas.Fill.Color := $FF00FF00
  else
    Canvas.Fill.Color := $FF696969;

  Canvas.BeginScene;
  Canvas.FillRect(MyRect,0,0,AllCorners,100);
  Canvas.EndScene;

  MyRect := TRectF.Empty;

  MyRect := TRectF.Create(23, 0, Width, Height);
  if(Negate=true) then
    Canvas.Fill.Color := $FFFFFFFF
  else
    Canvas.Fill.Color := 0;

  Canvas.BeginScene;
  //Canvas.FillRect(MyRect,0,0,AllCorners,100);
  Canvas.FillEllipse(MyRect, 100);
  Canvas.EndScene;

  MyRect := TRectF.Empty;
end;

procedure TBoolInput.SetNegate(Value: Boolean);
begin
  if(Value = True) then
    begin
      FOutput := Not(FWorking)
    end
  else
    begin
      FOutput := FWorking;
    end;

  FNegate := Value;
  Repaint;
end;

procedure TBoolInput.SetWorking(Value: Boolean);
begin
  if(Value = True) then
    begin
      FOutput := (Value AND (Not FNegate));
    end
  else
    begin
      FOutput := (Value OR FNegate);
    end;

  FWorking := Value;
  Repaint;
end;

end.

Но вопрос всеравно открыт, как делать тогда с компонентами. Мне кажется необходимо каким-то образом опубликовать свойства вложенных компонентов.

А также вопрос, как в FireMonkey можно регулировать размер компонента? На данный момент пока размер статичен.

krik

Дата 21.7.2014, 10:37 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 24
Регистрация: 28.7.2008

Репутация: 1
Всего: 1

Ну вот и решение по размеру smile

Код


unit BoolInput;

interface

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

type
  TBoolInput = class(TControl)
  private
    FWorking: Boolean;
    FNegate: Boolean;
    FOutput: Boolean;
    function GetWorking: Boolean;
    procedure SetWorking(Value: Boolean);
    function GetNegate: Boolean;
    procedure SetNegate(Value: Boolean);
    function GetOutput: Boolean;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    property Output: Boolean read GetOutput;
    procedure Paint; override;
  published
    { Published declarations }
    property Position;
    property Working: Boolean read GetWorking write SetWorking;
    property Negate: Boolean read GetNegate write SetNegate;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TBoolInput]);
end;

{ TBoolInput }

constructor TBoolInput.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 35;
  Height := 12;
end;

function TBoolInput.GetNegate: Boolean;
begin
  Result := FNegate;
end;

function TBoolInput.GetOutput: Boolean;
begin
  Result := FOutput;
end;

function TBoolInput.GetWorking: Boolean;
begin
  Result := FWorking;
end;

procedure TBoolInput.Paint;
var
  MyRect: TRectF;
begin
  inherited Paint;

  MyRect := TRectF.Create(0, 0, Width, Height);
  Canvas.Stroke.Thickness := 0;
  Canvas.Stroke.Color := 0;

  if(Working=true) then
    Canvas.Fill.Color := $FF00FF00
  else
    Canvas.Fill.Color := $FF696969;

  Canvas.BeginScene;
  Canvas.FillRect(MyRect,0,0,AllCorners,100);
  Canvas.EndScene;

  MyRect := TRectF.Empty;

  MyRect := TRectF.Create((Width/100)*68, 0, Width, Height);
  if(Negate=true) then
    Canvas.Fill.Color := $FFFFFFFF
  else
    Canvas.Fill.Color := 0;

  Canvas.BeginScene;
  //Canvas.FillRect(MyRect,0,0,AllCorners,100);
  Canvas.FillEllipse(MyRect, 100);
  Canvas.EndScene;

  MyRect := TRectF.Empty;
end;

procedure TBoolInput.SetNegate(Value: Boolean);
begin
  if(Value = True) then
    begin
      FOutput := Not(FWorking)
    end
  else
    begin
      FOutput := FWorking;
    end;

  FNegate := Value;
  Repaint;
end;

procedure TBoolInput.SetWorking(Value: Boolean);
begin
  if(Value = True) then
    begin
      FOutput := (Value AND (Not FNegate));
    end
  else
    begin
      FOutput := (Value OR FNegate);
    end;

  FWorking := Value;
  Repaint;
end;

end.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »