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