Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Свойства компонента при создании нового компонента 
:(
    Опции темы
krik
Дата 20.7.2014, 14:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



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


 
PM MAIL   Вверх
Pavia
Дата 21.7.2014, 05:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

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



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

PM MAIL   Вверх
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.

PM MAIL   Вверх
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 можно регулировать размер компонента? На данный момент пока размер статичен.
PM MAIL   Вверх
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.

PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

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


 




[ Время генерации скрипта: 0.0998 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.