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.