Alle DB Controls je nach state einfärben.

[Kostas]

Hallo Zusammen,

ich habe bis jetzt mit IBObjects gearbeitet. Dessen native Komponenten hatten eine sehr coole
Funktion. Sobald das Dataset den Status geändert hat, wurde die Hintergrundfarbe geändert,
bei Insert=Grün, Edit=Gelb und Delete=Rot. Das vermisse ich sehr z.B.: bei TMSControls.
Deshalb mein Versuch es nachzubauen. Doch das scheint nicht so einfach zu sein.

Die folgende Methode bekommt die Form und das Dataset. Es durchläuft alle Controls des
Forms und such Contols die ein Publisched Property=DataSource haben. Somit sind das schon mal Datensensitive Controls. Wenn das aktuelle Controll auch noch am gleichen Dataset und
nicht Readonly ist, setze ich die Farbe anhand des state vom DataSet. Das funktioniert schon mal. Nun jetzt gibt es unterschiedliche Controls. Ich möchte jetzt nicht jedes Control in der case Typcasten. Am liebste wäre mir, ich hätte ein Set mit allen Controls die ich einfärben möchte.

Ich habe keine Idee wie ich die Typabfrage und den Cast über alle Elemente des Sets hinbekomme. Hat hierfür jemand eine Idee?

Delphi-Quellcode:

if (ctrl is TDBAdvEdit)
                  then TDBAdvEdit(ctrl).color := clGreen else
        if (ctrl is TAdvDBDateTimePicker
                  then TAdvDBDateTimePicker(ctrl).color := clGreen else ...

Delphi-Quellcode:

procedure ModifyStateColor(ctrl: TWinControl; ds:TDataSet);
  procedure ModifyColor(ctrl: TControl);
  var
    c: TColor;
    aDataSource:TDataSource;
  begin

    if (IsPublishedProp(ctrl, 'DataSource')and
        IsPublishedProp(ctrl, 'ReadOnly'))then
    begin
      aDataSource := TDataSource(GetObjectProp(ctrl, 'DataSource', TDataSource));
      if aDataSource=nil then exit;

      if ((GetOrdProp(ctrl, 'ReadOnly') = Ord(false))and
          (aDataSource.DataSet = ds))then
      begin

        case aDataSource.DataSet.State of
          dsInsert: if (ctrl is TDBAdvEdit)
                  then TDBAdvEdit(ctrl).color := clGreen;

          dsEdit: if (ctrl is TDBAdvEdit)
                  then TDBAdvEdit(ctrl).color := clYellow;

          else if (ctrl is TDBAdvEdit)
                  then TDBAdvEdit(ctrl).color := clWindow;
        end;
      end;
    end;
  end;

var
  i: Integer;
begin
  for i := 0 to ctrl.controlcount - 1 do
    if ctrl.controls[i] is Twincontrol then
    begin
      ModifyStateColor(TWincontrol(ctrl.controls[i]), ds);
    end else
      ModifyColor(ctrl.controls[i]);
end;

Gruß Kostas

[Bummi]

Du hast es doch eh schon fast ....

Delphi-Quellcode:

if IsPublishedProp (ctrl, 'Color') then
    begin
      SetPropValue (ctrl, 'Color',clLime);  // was auch immer
    end;

[stahli]

Du könntest auch ein SubClassing (nennt man das so?) nutzen, sofern die Controls eine passende Stelle zum Überschreiben anbieten.

In Deiner Projektunit fügst Du in der uses-Liste an der letzten Stelle eine Unit hinzu, in der Du die verwendeten Controls anpasst.
Zur Laufzeit werden die Änderungen dann wirksam.

Delphi-Quellcode:

unit MainForm;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
  System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Edit,
  FMX.Effects, ssClientManager,

  ssfControls; // hinzufügen !!!

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
...

Alle betroffenen Controls müsstest Du dann überschreiben...

Delphi-Quellcode:

unit ssfControls;

interface

uses
  FMX.Edit, FMX.Controls, System.Classes;

type

  TEdit = class(FMX.Edit.TEdit)
  private
    MasterFlag: Boolean;
  protected
    procedure SetText(const Value: string); override;
    function HasSsfCtrl: Boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Painting; override;
  published
  end;

  TCheckBox = class(FMX.Controls.TCheckBox)
  private
    MasterFlag: Boolean;
  protected
    function HasSsfCtrl: Boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Painting; override;
  published
  end;

  TSpinBox = class(FMX.Edit.TSpinBox)
  private
    CreateFlag: Boolean;
    MasterFlag: Boolean;
  protected
    procedure SetValue(const AValue: Single); override;
    function HasSsfCtrl: Boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Painting; override;
  published
  end;

implementation

uses
  FMX.Types, ssClientManager, System.SysUtils;

{ TEdit }

constructor TEdit.Create(AOwner: TComponent);
begin
  inherited;
end;

destructor TEdit.Destroy;
begin
  inherited;
end;

function TEdit.HasSsfCtrl: Boolean;
var
  FmxObj: TFmxObject;
begin
  Result := False;
  if Assigned(FChildren) then
    for FmxObj in FChildren do
    begin
      if FmxObj is TssfCtrl then
        Exit(True);
    end;
end;

procedure TEdit.Painting;
var
  FmxObj: TFmxObject;
  ssfCtrl: TssfCtrl;
begin
  inherited;
  if HasSsfCtrl then
  begin
    for FmxObj in FChildren do
    begin
      if FmxObj is TssfCtrl then
      begin
        ssfCtrl := (FmxObj as TssfCtrl);
        if (MasterFlag) or (ssfCtrl.AllowMaster) then
        begin
          MasterFlag := False;
          if ssfCtrl.OwnerPropName <> '' then
            ssfCtrl.SetPropData
          else
            ssfCtrl.PropText := Text;
        end
        else if ssfCtrl.AllowSlave then
        begin
          if ssfCtrl.IsValid then
          begin
          if ssfCtrl.OwnerPropName <> '' then
            ssfCtrl.GetPropData
          else
            Text := ssfCtrl.PropText;
          end;
        end;
      end;
    end;
  end;
end;

procedure TEdit.SetText(const Value: string);
begin
  if not(csLoading in ComponentState) then
    MasterFlag := True;
  inherited;
end;

...

[Furtbichler]

Also die Lösung ist sehr unsauber, denn man geht davon aus, das die Eigenschaften 'Datasource', 'ReadOnly' und 'Color' unterschiedlicher Klassen eine identische semantische Funktionalität aufweisen, obwohl sie offenbar nichts miteinander zu tun (=keinen gemeinsamen Vorfahren) haben.

Desweiteren funktioniert der Ansatz auch nur dann, wenn die Eigenschaften überall auch wirklich so heißen. Bei DevExpress z.B. klappt das schon nicht mehr. Dort heißen die Properties "TcxDBTextEdit.Style.Color", "TcxDBTExtEdit.Databinding.Datasource" und "TcxDBTextEdit.Properties.ReadOnly".

Das ist Anti-OOP. Da kann man dann gleich aufhören mit dem Programmieren und Klempter werden. Obwohl, die arbeiten auch sauber und nach Plan.

Sauber wäre z.B. ein ModifyController für jede (Basis-)DB-Klasse und eine Factory, die einem den ModifyController anhand der TDBxxxEdit-Klasse liefert. Damit kann man dann auch sehr elegant auf die Fälle eingehen, bei denen die Properties anders heißen.

Das ist einsfixdrei gemacht, erweiterbar, übersichtlich usw. Mit diesem RTTI-Rumgefrickele mag das funktionieren, aber das tun mit Duct-Tape reparierte Autos auch. Irgendwie.

Verständnisfrage; Stahli's Methode funktioniert auch dann, wenn man Formulare in einer vorkompilierten BPL verwendet?

[Kostas]

Zitat von Bummi:

Delphi-Quellcode:

if IsPublishedProp (ctrl, 'Color') then
    begin
      SetPropValue (ctrl, 'Color',clLime);  // was auch immer
    end;

Hallo Thomas,
das Problem ist, nicht jedes Control welches ein DataSource Published hat,
auch eingefärbt werden darf. Als Beispiel wäre da das Grid. Beim Grid
soll die Zeile eingefärbt werden nicht der komplette Hintergrund. Deshalb
würde ich gerne ein Set haben(im Source händisch gepflegt) mit allen relevanten
Controls die ich einfärben möchte- so die ursprüngliche Idee.

[Bummi]

Mit einem Set wird es nicht gehen, aber Du kannst die gewünschten Klassen auf folgende Art eingrenzen.

Delphi-Quellcode:

Const
C_CLASSARRAY:Array[0..2] of TClass=(TButton,TEdit,TLabel);

implementation

{$R *.dfm}


Function IsInClassArray(o:TObject):Boolean;
var
 i:Integer;
begin
  i := -1;
  Result := false;
  if Assigned(o) then
  while not Result and  (i<High(C_CLASSARRAY))  do
    begin
       inc(i);
       Result := o.ClassType= C_CLASSARRAY[i];
    end;
end;

[Kostas]

Zitat von stahli:

Du könntest auch ein SubClassing (nennt man das so?) nutzen, sofern die Controls eine passende Stelle zum Überschreiben anbieten.

In Deiner Projektunit fügst Du in der uses-Liste an der letzten Stelle eine Unit hinzu, in der Du die verwendeten Controls anpasst.
Zur Laufzeit werden die Änderungen dann wirksam.

...

Hallo stahli,

alle mögliche Controls zu vererben fand ich für eine Menge Arbeite. Noch zudem bin ich
in OOP mit Delphi nicht sattelfest. In alles meinen Projekten bin ich bis jetzt komplett
ohne OOP ausgekommen. Meine Anwendungen sind reine C/S Datenbankanwendungen und in Zukunft
auch Multitier Datenbankanwendungen auch da wird noch kein OOP notwendig sein.
Eigentlich habe ich die Funktionalität von den Herstellern der Datenbankkomponenten erwartet, wie es die IBObjects Komponenten auch machen. Doch leider nur die Nativen und somit kann ich keine andere Komponenten einsetzen. Deshalb will ich bei neuen Projekten IBO nicht mehr einsetzen. Für den Anwender ist es auf ein Blick ersichtlich in welchen Felder was zum Eintragen ist. Bei Insert/Append sind alle Felder Grün, bei Edit Gelb und beim Versuch einen Datensatz zu löschen werde die entsprechende Felder Rot. Alle ReadOnly Felder sind Grau hinterlegt. Somit hat der User sofort einen Überblick was zu tun ist.
In TIB_DataSoure gab es sogar eine Liste mit allen gebundenen Controls.

[Uwe Raabe]

Ich würde hier das Visitor-Pattern verwenden. Dazu habe ich mal einen Artikel geschrieben, der die Hintergründe ausführlich beleuchtet und ein paar Lösungsansätze aufzeigt. Im 4.Teil des Artikels wird eine Implementation beschrieben, die ich bei dieser Lösung verwendet habe. Als Beispiel habe ich ein Form mit einem DbEdit und einem DbText verwendet. Beide führen das DataSource-Property parallel ein und man kann somit nicht auf einen gemeinsamen Vorfahren zugreifen.

Hier zunächst der Basis-Visitor:

Delphi-Quellcode:

unit uVisitor;

interface

type
  TVisitor = class
  public
    procedure Visit(Instance: TObject); virtual;
  end;

implementation

uses
  Rtti;

procedure TVisitor.Visit(Instance: TObject);
var
  context: TRttiContext;
  currentClass: TClass;
  params: TArray<TRttiParameter>;
  paramType: TRttiType;
  selfMethod: TRttiMethod;
  S: string;
begin
  context := TRttiContext.Create;
  currentClass := Instance.ClassType;
  repeat
    S := currentClass.ClassName;
    Delete(S, 1, 1); // remove "T"
    for selfMethod in context.GetType(self.ClassType).GetMethods('Visit' + S) do begin
      params := selfMethod.GetParameters;
      if (Length(params) = 1) then begin
        paramType := params[0].ParamType;
        if ParamType.IsInstance and (ParamType.AsInstance.MetaclassType = currentClass)then begin
          selfMethod.Invoke(Self, [Instance]);
          Exit;
        end;
      end;
    end;
    currentClass := currentClass.ClassParent;
  until currentClass = nil;
end;

end.

Und hier die abgeleitete Klasse mit den Implementationen für die verschiedenen Controls. Weitere Controls (z.B. TDBAdvEdit) kann man durch einfaches Hinzufügen einer procedure VisitDBAdvEdit(Instance: TDBAdvEdit); abdecken:

Delphi-Quellcode:

unit uVisitorDbState;

interface

uses
  uVisitor, Vcl.DBCtrls, Data.DB;

type
  TVisitorDbState = class(TVisitor)
  private
    FDataSource: TDataSource;
  public
    procedure VisitDbEdit(Instance: TDbEdit);
    procedure VisitDbText(Instance: TDbText);
    property DataSource: TDataSource read FDataSource write FDataSource;
  end;

implementation

uses
  Vcl.Graphics;

procedure TVisitorDbState.VisitDbEdit(Instance: TDbEdit);
begin
  if Instance.DataSource = DataSource then begin
    case DataSource.State of
      dsEdit: Instance.Color := clYellow;
      dsInsert: Instance.Color := clGreen;
    else
      Instance.Color := clWindow;
    end;
  end;
end;

procedure TVisitorDbState.VisitDbText(Instance: TDbText);
begin
  if Instance.DataSource = DataSource then begin
    case DataSource.State of
      dsEdit: Instance.Font.Style := [fsBold];
      dsInsert: Instance.Font.Style := [fsItalic];
    else
      Instance.Font.Style := [];
    end;
  end;
end;

end.

Hier die Verwendung des Visitors. Natürlich kann man auch die Iteration über die Controls durchführen, statt über die Components:

Delphi-Quellcode:

procedure TForm188.AdjustStateColor;
var
  I: Integer;
  visitor: TVisitorDbState;
begin
  visitor := TVisitorDbState.Create;
  try
    visitor.DataSource := DataSource1;
    for I := 0 to ComponentCount - 1 do
      visitor.Visit(Components[I]);
  finally
    visitor.Free;
  end;
end;

procedure TForm188.DataSource1StateChange(Sender: TObject);
begin
  AdjustStateColor;
end;

[Kostas]

Zitat von Furtbichler:

Also die Lösung ist sehr unsauber, denn man geht davon aus, das die Eigenschaften 'Datasource', 'ReadOnly' und 'Color' unterschiedlicher Klassen eine identische semantische Funktionalität aufweisen, obwohl sie offenbar nichts miteinander zu tun (=keinen gemeinsamen Vorfahren) haben.
...

Hallo Furtbichler,

du beschreibst natürlich den Königsweg. Diesen Wissensstand habe ich leider nicht. Da kann ich nicht mithalten. OOP ist auch nicht immer notwendig. Bei Datenbankanwendungen ist es nicht für jedes Projekt notwendig- so meine Meinung.

Mich wundert es doch eigentlich sehr dass das nicht Standard ist. Oder wie macht ihr das eigentlich? Sind alle Controls statusunabhängig immer Weiß? Wenn die Kunden es nicht anders kennen, werde sie vermutlich nicht danach fragen. Meine Kunden sind es gewohnt dass sich die Hintergrundfarben je nach Status ändern, die Labels je nach required Fett oder Normal dargestellt werden, die Felder komplett Grau sind wenn sie ReadOnly sind und Schwarz wenn das DataSet geschlossen ist. Ich finde das selbst sehe sehr nützlich. Da ich das sonst noch bei keiner Datensensitive Komponente gesehen habe, außer bei IBObjects, muss ich davon ausgehen dass irgendwie anders gearbeitet wird.

Gruß Kostas

[Kostas]

Zitat von Uwe Raabe:

Ich würde hier das Visitor-Pattern verwenden.

Hallo Uwe,

das ist hervorragend und funktioniert perfekt und ist erweiterbar.
Tausend Dank Uwe.

Gruß Kostas