Problema con el componente, se activa al cambiar (DataSource.State)

[[José Luis Garcí]]

Buenos días compañeros, tengo un problema con este componente, que es el siguiente, cuando cambia el State de este TDBToggleSwitch, me activa directamente el Datasource.State DsEdit y no se como remediarlo, como siempre espero a vuestras indicaciones y os doy mil gracias como siempre.

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;
    Function GetDataField:string;
    Procedure SetDataField(const Value:string);
    Function GetDataSource:TDataSource;
    procedure SetDataSource(Value:TDataSource);
    Procedure DataChange(Sender:TObject);
  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;
  end;

procedure Register;

implementation

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

{ TDBToggleSwitch1 }

procedure TDBToggleSwitch.Click;
begin
   if (csDesigning in ComponentState) or FReadOnly or (FDataLink=nil) or (not fdatalink.Edit) then exit
   else
   begin
      if DataSource.State IN [dsEdit, dsInsert] then
      BEGIN
          if State=tssOff then DataSource.DataSet.FieldByName(DataField).Value:=stateCaptions.CaptionOff
                          else DataSource.DataSet.FieldByName(DataField).Value:=stateCaptions.CaptionOn;
        inherited;
        FDataLink.Modified;
      end;
   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 (DataSource.DataSet.FieldByName(DataField).Value=Self.stateCaptions.CaptionOff) OR
     (DataSource.DataSet.FieldByName(DataField).IsNull) then STATE:=TSSOFF
                                                        else STATE:=TSSON;
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;

end.

[[José Luis Garcí]]

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

[[José Luis Garcí]]

Por cierto por si a alguien le interesa pongo el enlace del componente que encontré para modificar el mío

https://github.com/amarildolacerda/M...ggleSwitch.pas

[Neftali [Germán.Estévez]]

Creo que el problema está en el procedimiento Click.
Estás utilizando un código como este:

Código Delphi [-]
procedure TDBToggleSwitch.Click;
begin
   if (csDesigning in ComponentState) or FReadOnly or (FDataLink=nil) or
      (not fdatalink.Edit) or (internalUpdate) then exit
   else
   begin
      if DataSource.State IN [dsEdit, dsInsert] then
      BEGIN
      ...

Y creo que tú mismo estás poniendo el Dataset en edición cuando ejecutas ese código en rojo.
Tal vez lo que querías hacer es:

Código Delphi [-]
... (not fdatalink.Editing)...

Porque no le veo sentido a lo que tienes ahora.

[Neftali [Germán.Estévez]]

Empezado por José Luis Garcí

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.

En el caso de este componente, simplemente debes redefinir los métodos que dibujan el texto, para que se haga donde deseas.
TDBToggleSwitch deriva de TToggleSwitch, que a su vez lo hace de TCustomToggleSwitch.

TCustomToggleSwitch a la hora de pintar llama al método paint que está protected y redefinido (por lo tanto puedes sobreescribirlo):

Código Delphi [-]
procedure Paint; override;

Dentro de ese método, tienes una llamada a DrawText, que en realidad son 2 similares dependiendo de estilos:

Código Delphi [-]
        StyleServices.DrawText(MemImage.Canvas.Handle, StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal),
          GetActiveStateCaption, R, TextFormat, TextColor);

Si redefines ese método podrás llamar a DrawText con el parámetro lpRect (posición) diferente.
https://learn.microsoft.com/en-us/wi...nuser-drawtext

[[José Luis Garcí]]

Gracias Neftali, tomo nota