Komponenten-Entwicklung allegemein

[Rungholt]

Hallo,

ich schraube gerade an meiner ersten Komponente. Vereinfacht ausgedrückt ist es ein von TCustomPanel
abgeleiteter "container". Ich möchte nun eine DB-gebundene CheckBox darauf legen und verwenden.
Dies klappt auch soweit. Allerdings habe ich das Problem, dass die DBCheckBox die zur Designzeit gesetzten
Eigenschaften verliert. "Gewöhnliche" Eigenschaften kann ich ja mit der Direktive "stored" in der DFM speichern.
Aber mit einer Objekt-Eigenschaft scheint das nicht zu klappen. Die wichtigsten Eigenschaften meiner DBCheckBox "DataSource"
und "DataField" sind zur Laufzeit immer leer.

Anbei mal mein code. Dieser wird bei euch zwar nicht lauffähig sein, weil ich spezielle Komponenten (LMD-Tools) verwende,
aber vielleicht erkennt ihr ja schon die Probleme. Die Komponente ist übrigens noch nicht fertig, also nicht wundern, wenn
gewisse Dinge , zum Beispiel Ereignisse fehlen.

Vielen Dank schon mal !

Delphi-Quellcode:

(*******************************************************************************
 Unit Name : GMTFarbContainer
 Autor     : SLo
 Datum     : 17.11.06 :o)
 Zweck     : Eine Container-Komponente (Mit Farbverlauf)
 Hinweise  : SLo: Der zu Grunde liegende Container ist ein TPanel.
                  Um optisch einen Header zu erzeugen, werden zwei Farbverläufe
                  (Glaseffekt) mit der Höhe 23 gezeichnet. Außerdem gibt es in
                  diesem Bereich eine Textausgabe.
 *******************************************************************************)
unit GMTFarbContainer;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Graphics, ExtCtrls, Windows, LMDCustomControl,
  LMDCustomPanel, LMDButtonControl,  LMDCustomCheckBox, LMDDBCheckBox, DesignIntf, DB;

const  hoehe_Kopf = 23;

type
  TMyCheckBox = class(TLMDDBCheckBox)
   public
       procedure Assign(Source: TPersistent); override;
  end;

  TGMTFarbContainer = class(TCustomPanel)
  private
    { Private-Deklarationen }

    (* Eigenschaften *)
    FCaptText       : String;
    FCaptTyp        : TFont;
    FBodyColor          : TColor;
    FHeaderColTone1_1   : TColor;
    FHeaderColTone1_2   : TColor;
    FHeaderColTone2_1   : TColor;
    FHeaderColTone2_2   : TColor;
    FRahmenCol          : TColor;
    FContainerRahmenCol : TColor;
    FMitHeaderRahmen    : Boolean;
    FMitContainerRahmen : Boolean;
    FKopfGrenze         : TBevel;
    FMitCheckBox        : Boolean;
    FCheckBox           : TMyCheckBox;
    procedure SetHeaderCaption(Value: String);
    function GetHeaderCaption: String;
    procedure SetCaptionFont(Font: TFont);
    function GetCaptionFont: TFont;
    procedure SetBodyColor(Col : TColor);
    function  GetBodyColor : TColor;
    procedure SetHeaderColTone1_1(Col : TColor);
    function  GetHeaderColTone1_1 : TColor;
    procedure SetHeaderColTone1_2(Col : TColor);
    function  GetHeaderColTone1_2 : TColor;
    procedure SetHeaderColTone2_1(Col : TColor);
    function  GetHeaderColTone2_1 : TColor;
    procedure SetHeaderColTone2_2(Col : TColor);
    function  GetHeaderColTone2_2 : TColor;
    function  GetHeaderRahmen: Boolean;
    function  GetHeaderRahmenCol: TColor;
    procedure SetHeaderRahmen(const Value: Boolean);
    procedure SetHeaderRahmenCol(const Value: TColor);
    function  GetContainerRahmen: Boolean;
    function  GetContainerRahmenCol: TColor;
    procedure SetContainerRahmen(const Value: Boolean);
    procedure SetContainerRahmenCol(const Value: TColor);
    procedure SetMyCheckBox(value: TMyCheckBox);
  protected
    { Protected-Deklarationen }
    procedure Paint; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    Procedure Ini_CheckBox;
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    destructor destroy; override;
  published
    { Published-Deklarationen }

    property HeaderCaption       : String read GetHeaderCaption        write SetHeaderCaption;
    property HeaderCaptionFont   : TFont   read GetCaptionFont         write SetCaptionFont;
    property BodyColor           : TColor  read GetBodyColor           write SetBodyColor;
    property HeaderRahmen        : Boolean read GetHeaderRahmen        write SetHeaderRahmen;
    property HeaderRahmenCol     : TColor  read GetHeaderRahmenCol     write SetHeaderRahmenCol;
    property HeaderColTone1_1    : TColor  read GetHeaderColTone1_1    write SetHeaderColTone1_1;
    property HeaderColTone1_2    : TColor  read GetHeaderColTone1_2    write SetHeaderColTone1_2;
    property HeaderColTone2_1    : TColor  read GetHeaderColTone2_1    write SetHeaderColTone2_1;
    property HeaderColTone2_2    : TColor  read GetHeaderColTone2_2    write SetHeaderColTone2_2;
    property Caption             : string  read GetHeaderCaption       write SetHeaderCaption;
    property ContainerRahmen     : Boolean read GetContainerRahmen     write SetContainerRahmen stored TRUE;
    property ContainerRahmenCol  : TColor  read GetContainerRahmenCol  write SetContainerRahmenCol stored TRUE;

    (* Die hier macht mir die Probleme :o\  *)
    property DBCheckBox          : TMyCheckBox read FCheckBox          write SetMyCheckBox stored TRUE;
  end;

  tmypanel = class(TPanel)
  end;

procedure Register;

implementation

uses Types, Dialogs, LMDGraph;



{ TGMTFarbContainer }

constructor TGMTFarbContainer.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   ParentBiDiMode       := FALSE;
   BevelInner := TBevelCut(bvNone);
   BevelOuter := TBevelCut(bvNone);

   ParentColor          := FALSE;
   Color                := $00F7F7F2;
   Caption              := '';
   DoubleBuffered       := TRUE;

   FBodyColor           := $00F7F7F2;
   FHeaderColTone1_1    := $00FDF8F2;
   FHeaderColTone1_2    := $00F1D5B8;
   FHeaderColTone2_1    := $00EDC69E;
   FHeaderColTone2_2    := $00F1D5B8;
   FRahmenCol           := $00F1D5B8;
   FContainerRahmenCol  := $009C8D92;

   FKopfGrenze          := TBevel.create(self);
   FKopfGrenze.parent   := self;
   FKopfGrenze.Height   := hoehe_Kopf+1;
   FKopfGrenze.Align    := alTop;
   FKopfGrenze.Shape    := bsSpacer;

   Color                := FBodyColor;

   FCaptTyp             := TFont.Create;
   FCaptTyp.Name        := 'Tahoma';
   FCaptTyp.Style       := [fsBold];
   FCaptTyp.Size        := 8;
   FCaptText            := Self.ClassName;

   FCheckBox := TMyCheckBox.Create(self);
   FCheckBox.Parent  := self;
   FCheckBox.Visible := TRUE;
   FCheckBox.Name    := 'DBCheckBox';
   FMitCheckBox      := TRUE;
   Ini_CheckBox;
end;


destructor TGMTFarbContainer.destroy;
begin
   FreeAndNil(FCheckBox);
   FreeAndNil(FCaptTyp);
   inherited destroy;
end;

function TGMTFarbContainer.GetCaptionFont: TFont;
begin
   result := FCaptTyp;
end;


procedure TGMTFarbContainer.SetCaptionFont(Font: TFont);
begin
   FCaptTyp.Assign(Font);
   Repaint;
end;

function TGMTFarbContainer.GetHeaderCaption: String;
begin
   result := FCaptText;
end;

procedure TGMTFarbContainer.SetHeaderCaption(value : String);
begin
   FCaptText := Value;
   Invalidate;
   Repaint;
end;

function TGMTFarbContainer.GetHeaderColTone1_1: TColor;
begin
   result := FHeaderColTone1_1;
end;

function TGMTFarbContainer.GetHeaderColTone1_2: TColor;
begin
   result := FHeaderColTone1_2;
end;

function TGMTFarbContainer.GetHeaderColTone2_1: TColor;
begin
   result := FHeaderColTone2_1;
end;

function TGMTFarbContainer.GetHeaderColTone2_2: TColor;
begin
   result := FHeaderColTone2_2;
end;

procedure TGMTFarbContainer.SetHeaderColTone1_1(Col: TColor);
begin
   FHeaderColTone1_1 := col;
   Repaint;
end;

procedure TGMTFarbContainer.SetHeaderColTone1_2(Col: TColor);
begin
   FHeaderColTone1_2 := col;
   Repaint;
end;

procedure TGMTFarbContainer.SetHeaderColTone2_1(Col: TColor);
begin
   FHeaderColTone2_1 := col;
   Repaint;
end;

procedure TGMTFarbContainer.SetHeaderColTone2_2(Col: TColor);
begin
   FHeaderColTone2_2 := col;
   Repaint;
end;

function TGMTFarbContainer.GetBodyColor: TColor;
begin
   result := FBodyColor;
end;

procedure TGMTFarbContainer.SetBodyColor(Col: TColor);
begin
   FBodyColor := Col;
   Repaint;
end;


procedure TGMTFarbContainer.Paint;

var
 Y, R, G, B: Integer;
 ix : Integer;

 RColor1, GColor1, BColor1: Integer;
 RColor2, GColor2, BColor2: Integer;

 RColor3, GColor3, BColor3: Integer;
 RColor4, GColor4, BColor4: Integer;

 Color1,Color2,Color3,Color4  : TColor;

begin
 // inherited paint;

   (* Farbe des Bodys*)
   self.Color := FBodyColor;

   (*Farbverlauf I*)
   Color1:=ColorToRGB(FHeaderColTone1_1);
   Color2:=ColorToRGB(FHeaderColTone1_2);

   RColor1:=GetRValue(Color1);
   GColor1:=GetGValue(Color1);
   BColor1:=GetBValue(Color1);

   RColor2:=GetRValue(Color2);
   GColor2:=GetGValue(Color2);
   BColor2:=GetBValue(Color2);

   (*Farbverlauf II*)
   Color3:=ColorToRGB(FHeaderColTone2_1);
   Color4:=ColorToRGB(FHeaderColTone2_2);

   RColor3:=GetRValue(Color3);
   GColor3:=GetGValue(Color3);
   BColor3:=GetBValue(Color3);

   RColor4:=GetRValue(Color4);
   GColor4:=GetGValue(Color4);
   BColor4:=GetBValue(Color4);

   TMyPanel(self).Canvas.Pen.Width:=1;
   TMyPanel(self).Canvas.Pen.Style:=psInsideFrame;

   ix := 0;

   for Y:= self.ClientRect.Top to hoehe_Kopf do
   begin
      If y <= (hoehe_Kopf div 2 ) then begin
         R:=Round(RColor1 + ((RColor2 - RColor1) * Y / ((hoehe_Kopf div 2 ) - self.ClientRect.Top)));
         G:=Round(GColor1 + ((GColor2 - GColor1) * Y / ((hoehe_Kopf div 2 )- self.ClientRect.Top)));
         B:=Round(BColor1 + ((BColor2 - BColor1) * Y / ((hoehe_Kopf div 2 )- self.ClientRect.Top)));
      end else begin
         inc(ix);
         R:=Round(RColor3 + ((RColor4 - RColor3) * ix / (hoehe_Kopf - (hoehe_Kopf div 2 ))));
         G:=Round(GColor3 + ((GColor4 - GColor3) * ix / (hoehe_Kopf- (hoehe_Kopf div 2 ))));
         B:=Round(BColor3 + ((BColor4 - BColor3) * ix / (hoehe_Kopf- (hoehe_Kopf div 2 ))));
      end;

      TMyPanel(self).Canvas.Brush.Color := RGB(R, G, B);
      TMyPanel(self).Canvas.FillRect(Classes.Rect(self.ClientRect.Left, Y, self.ClientRect.Right, Y+1));
   end;

   If FMitHeaderRahmen and (not FMitContainerRahmen) then begin
      TMyPanel(self).Canvas.Brush.Color := FRahmenCol;
      TMyPanel(self).Canvas.FillRect(Classes.Rect(self.ClientRect.Left, self.ClientRect.Top, self.ClientRect.Left+1, hoehe_Kopf));
      TMyPanel(self).Canvas.FillRect(Classes.Rect(self.ClientRect.Left, self.ClientRect.Top, self.ClientRect.Right, self.ClientRect.Top+1));
      TMyPanel(self).Canvas.FillRect(Classes.Rect(self.ClientRect.Left, hoehe_Kopf, self.ClientRect.Right, hoehe_Kopf+1));
      TMyPanel(self).Canvas.FillRect(Classes.Rect(self.ClientRect.Right-1, self.ClientRect.Top, self.ClientRect.Right, hoehe_Kopf));
   end;

   (* Der Body *)
   TMyPanel(self).Canvas.Brush.Color := FBodyColor;
   TMyPanel(self).Canvas.FillRect(Classes.Rect(self.ClientRect.Left, hoehe_Kopf+1, self.ClientRect.Right, self.ClientRect.Bottom));

   If FMitContainerRahmen then begin
      TMyPanel(self).Canvas.Brush.Color := FContainerRahmenCol;
      TMyPanel(self).Canvas.FillRect(Classes.Rect(self.ClientRect.Left, self.ClientRect.Top, self.ClientRect.Left+1, self.ClientRect.Bottom));
      TMyPanel(self).Canvas.FillRect(Classes.Rect(self.ClientRect.Left, self.ClientRect.Top, self.ClientRect.Right, self.ClientRect.Top+1));
      TMyPanel(self).Canvas.FillRect(Classes.Rect(self.ClientRect.Left, self.ClientRect.Bottom, self.ClientRect.Right, self.ClientRect.Bottom-1));
      TMyPanel(self).Canvas.FillRect(Classes.Rect(self.ClientRect.Right-1, self.ClientRect.Top, self.ClientRect.Right, self.ClientRect.Bottom));
   end;


   (* Der Font der Beschriftung *)
   TMyPanel(self).Canvas.Brush.Style := bsClear;
   TMyPanel(self).Canvas.Font.Name   := FCaptTyp.Name;
   TMyPanel(self).Canvas.Font.Style  := FCaptTyp.Style;
   TMyPanel(self).Canvas.Font.Size   := FCaptTyp.Size;
   TMyPanel(self).Canvas.TextOut(12,5,FCaptText);

end;

procedure Register;
begin
  RegisterComponents('GMT', [TGMTFarbContainer]);

end;

function TGMTFarbContainer.GetHeaderRahmen: Boolean;
begin
   result := FMitHeaderRahmen;
end;

function TGMTFarbContainer.GetHeaderRahmenCol: TColor;
begin
   result := FRahmenCol;
end;

procedure TGMTFarbContainer.SetHeaderRahmen(const Value: Boolean);
begin
   FMitHeaderRahmen := Value;
   Repaint;
end;

procedure TGMTFarbContainer.SetHeaderRahmenCol(const Value: TColor);
begin
   FRahmenCol :=  value;
   Repaint;
end;

procedure TGMTFarbContainer.SetContainerRahmen(const Value: Boolean);
begin
   FMitContainerRahmen := Value;
   Repaint;
end;

procedure TGMTFarbContainer.SetContainerRahmenCol(const Value: TColor);
begin
   FContainerRahmenCol :=  value;
   Repaint;
end;

function TGMTFarbContainer.GetContainerRahmen: Boolean;
begin
   result := FMitContainerRahmen;
end;

function TGMTFarbContainer.GetContainerRahmenCol: TColor;
begin
   result := FContainerRahmenCol;
end;

procedure TGMTFarbContainer.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FCheckBox) then
    FCheckBox := nil;

end;

procedure TGMTFarbContainer.Ini_CheckBox;
begin
   FCheckBox.Transparent := TRUE;
   FCheckBox.Caption := '';
   FCheckBox.Alignment.AlignText2Glyph :=  taLeft;
   FCheckBox.Alignment.Alignment :=  agCenterRight;
   FCheckBox.Top := (hoehe_Kopf div 2)-(FCheckBox.Height div 2);
   FCheckBox.Width := self.Width-10;
   FCheckBox.Anchors := FCheckBox.Anchors+[akRight];
end;

procedure TGMTFarbContainer.SetMyCheckBox(value: TMyCheckBox);
begin
   FCheckBox.Assign(value);
end;

{ TMyCheckBox }

procedure TMyCheckBox.Assign(Source: TPersistent);
begin
   If Source is TMyCheckBox then begin
     DataSource := TMyCheckBox(Source).DataSource;
     DataField := TMyCheckBox(Source).DataField;
  end else
     inherited Assign(Source);
end;


end.

[daddy]

So wie ich das sehe, wird das so nicht funktionieren. Das Property "DBCheckBox" würde normalerweise dazu verwendet werden, um eine CheckBox vom Typ "TMyCheckBox" der Komponente vom Typ "TGMTFarbContainer" zuweisen zu können. Diese CheckBox würde aber eine eigenständige Komponente innerhalb des Formulars sein.
Was Du vorhast, ist die CheckBox in der Komponente selber zu erzeugen. Das geht natürlioch auch. Dazu wird sie aber nicht als Property sondern unter private, protected oder public (je nachdem) als ganz normale Eigenschaft deklariert. Im "Create" wird sie dann erzeugt, so wie Du es ja jetzt auch schon machst, die feststehenden Eigenschaften werden zugewiesen (wie Du es ja ebenfalls schon machst) und für die variablen Eigenschaften wie z.B. "DataSource" und "DataField" müsstest Du eigene Properties definieren, in deren "Set..."-Routine dann eine Zuweisung an die CheckBox erfolgt. Also etwa so:

Delphi-Quellcode:

Type
  TGMTFarbContainer = class(TCustomPanel) 
  private
    DBCheckBox: TMyCheckBox;
    FDBCheckBoxDataSource: TDataSource;
    procedure SetDBCheckBoxDataSource(value : TDataSource);
    ...
  property
    ...
    DBCheckBoxDataSource: TDataSource read FDBCheckBoxDataSource 
                                      write SetDBCheckBoxDataSource;
    ...
 end;   

procedure TGMTFarbContainer.SetDBCheckBoxDataSource(value : TDataSource); 
begin 
  DBCheckBox.DataSource := Value; 
end;

[Rungholt]

Das wäre meine Alternative gewesen. Allerdings wollte ich nicht extra nochmal Eigenschaften erzeugen, die ja in den
Eigenschaften der CheckBox eh schon angezeigt werden.

Aber dann muss das wohl so sein. :lol:

Vielen Dank !

[Hawkeye219]

Hallo,

vielleicht hilt dir auch dieser Beitrag.

Gruß Hawkeye

[Rungholt]

Boah, das ist doe Lösung meines Problems. :bounce1:

Vielen vielen Dank !

[daddy]

@Hawkeye219:
"SetSubComponent" kannte ich noch gar nicht, ist aber ja wirklich superpraktisch und wenn man die "write"-Klausel bei der property "DBCheckBox" weg lässt, ist es ja genau das, was Rungholt suchte.