YA lo he resuelto, encontré el mismo componente en una página italiana, pero en otro lenguaje de programación, por lo que lo adapte, os pongo el código
Código Delphi
[-]unit DBToggleSwitch;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.WinXCtrls, VCL.DBCtrls, dATA.DB;
type
TDBToggleSwitch = class(TToggleSwitch)
private
FDataLink : TFieldDataLink;
FReadOnly : Boolean;
FInLoading: boolean;
FValorOn: string;
FValorOff: string;
Function GetDataField:string;
Procedure SetDataField(const Value:string);
Function GetDataSource:TDataSource;
procedure SetDataSource(Value:TDataSource);
Procedure DataChange(Sender:TObject);
procedure SetValorOff (const Value: string);
procedure SetValorOn(const Value: string);
protected
Procedure Notification(AComponent:TComponent;Operation:TOperation); override;
Procedure Click; override;
public
Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override;
published
Property ReadOnly : Boolean read FReadOnly write FReadOnly default False;
Property DataField : String read GetDataField write SetDataField;
Property DataSource : TDataSource read GetDataSource write SetDataSource;
property ValorOn: string read FValorOn write SetValorOn;
property ValorOff: string read FValorOff write SetValorOff;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TDBToggleSwitch]);
end;
procedure TDBToggleSwitch.Click;
begin
if FInLoading then exit;
if (csDesigning in ComponentState) or FReadOnly or (FDataLink=nil) or (not fdatalink.Edit) then exit
else
begin
if not(DataSource.DataSet.State in dsEditModes) then
begin
DataSource.DataSet.edit;
if State = tssOff then
DataSource.DataSet.fieldByName(DataField).Value := FValorOn
else
DataSource.DataSet.fieldByName(DataField).Value := FValorOff;
end
else
begin
if State = tssOff then
DataSource.DataSet.fieldByName(DataField).Value := FValorOff
else
DataSource.DataSet.fieldByName(DataField).Value := FValorOn;
end;
inherited;
FDataLink.Modified;
END;
end;
constructor TDBToggleSwitch.Create(AOwner: TComponent);
begin
inherited;
FReadOnly:=False;
FDataLink:=TFieldDataLink.Create;
FDataLink.OnDataChange:=DataChange;
end;
procedure TDBToggleSwitch.DataChange(Sender: TObject);
begin
if not assigned(Datasource.DataSet) then exit
eLSE
BEGIN
FInLoading := true;
try
if FValorOn=Datasource.DataSet.fieldByName(DataField).AsString then
begin
if State <> tssOn then State := tssOn;
end
else
begin
if State <> tssOff then State := tssOff;
end;
finally
FInLoading := False;
end;
end;
end;
destructor TDBToggleSwitch.Destroy;
begin
FDataLink.Free;
FDataLink:=nil;
inherited Destroy;
end;
function TDBToggleSwitch.GetDataField: string;
begin
Result:=FDataLink.FieldName;
end;
function TDBToggleSwitch.GetDataSource: TDataSource;
begin
Result:=FDataLink.DataSource;
end;
procedure TDBToggleSwitch.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(Acomponent,Operation);
if (Operation=opRemove) AND (FDataLink<>nil) and (AComponent=DataSource) then DataSource:=nil;
end;
procedure TDBToggleSwitch.SetDataField(const Value: string);
begin
FDataLink.FieldName:=Value;
end;
procedure TDBToggleSwitch.SetDataSource(Value: TDataSource);
BEGIN
if (FDataLink.DataSource<>Value) then
begin
FDataLink.DataSource:=Value;
If Value<>nil then Value.FreeNotification(self);
end;
end;
procedure TDBToggleSwitch.SetValorOn(const Value: string);
begin
FValorOn:= Value;
StateCaptions.CaptionOn:=Value;
end;
procedure TDBToggleSwitch.SetValorOff(const Value: string);
begin
FValorOff := Value;
StateCaptions.CaptionOff:= Value;
end;
end.
Ahora mi pregunta es si es posible que el texto StateCaptions.CamptionOn/Caption Off, en vez de estar externo al interruptor, podría estar interno, en VCL, ya que en Firemonkey si es posible.
Un saludo y gracias