Ver Mensaje Individual
  #2  
Antiguo 02-11-2022
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
 
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Reputación: 23
José Luis Garcí Va camino a la fama
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
    { Private declarations }
    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
    { Protected declarations }
     Procedure Notification(AComponent:TComponent;Operation:TOperation); override;
     Procedure Click; override;
  public
    { Public declarations }
    Constructor Create(AOwner : TComponent); override;
    Destructor Destroy; override;
  published
    { Published declarations }
     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;

{ TDBToggleSwitch1 }

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
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita