Vererbung von Komponenten

[Chris211183]

Hallo DP´ler,

ich habe bereits das Forum durchforstet und sämtliche alternativen, die mir einfielen getestet, aber nichts geht (oder nur teilweise).

Folgendes Problem:

Ich habe bereits zwei fertige Komponenten (Achsenbeschriftung in X und Y Richtung)

Diese möchte ich in einer neuen Komponente gern verwenden, mit allen Eigenschaften.
Im angehängten Screenshot seht ihr links, wie es aussehen soll, rechts, wie der Stand der Dinge ist.
Das Problem liegt, glaube Ich, in der Parent Zuweisung.
Auf dem Screenshot seht Ihr auch, dass XScale und YScale im OI rot dargestellt sind und die Untereigenschaften grün.

Bin über jede Anregung dankbar !

Delphi-Quellcode:

unit HixHistograph;

interface

uses
  Windows,SysUtils, Classes,QControls, Controls, Graphics, StdCtrls, Variants, Forms,
  Dialogs, Math, QExtCtrls, ExtCtrls, Types, Mathe, Scales;

type

   THixHistoGraph = class(TGraphicControl)

private
   FValue                   : Real;
   FVisible                 : Boolean;
   FTabOrder                : Integer;
   FBorderstyle             : TBorderstyle;
   FGapLeft                 : Integer;                                          // Abstand vom linken Rand
   FGapRight                : Integer;                                          // Abstand vom rechten Rand
   FGapTop                  : Integer;                                          // Abstand von Oberkante
   FGapBottom               : Integer;                                          // Abstand von Unterkante
   FHistoBkColor            : TColor;                                           // Farbe der Darstellungsfläche
   FColor                   : TColor;                                           // Farbe des Hintergrundes
   FFont                    : TFont;                                            // Schriftart und Farbe der Werteanzeige
   FGridLineStyle           : TPenStyle;
   FViewXCurrentMin         : Real;
   FViewXCurrentMax         : Real;
   FViewYMin                : Real;
   FViewYMax                : Real;


   FXScale                  : THorScale;     ///////// Da muss irgendwo ein fehler stecken, wohl im Constructor ???
   FYScale                  : TVertScale;

   function getAParent      : TWinControl;

   Procedure SetTabOrder(const Value: Integer);
   procedure SetVisible(const Value: Boolean);
   procedure SetBorderstyle(const Value: TBorderstyle);
   procedure SetGapLeft(const Value: Integer);
   procedure SetGapRight(const Value: Integer);
   procedure SetGapTop(const Value: Integer);
   procedure SetGapBottom(const Value: Integer);
   procedure SetHistoBkColor(const Value: TColor);
   procedure SetColor(const Value: TColor);
   procedure SetFont(const Value: TFont);
   procedure SetValue(const Value: Real);
   procedure DrawComponent;                                              // zeichnet Hintergrund und Darstellungsfläche
 //  procedure DrawScales;
   procedure SetGridLineStyle(const Value: TPenStyle);
   procedure SetViewXCurrentMin(const Value: Real);
   procedure SetViewXCurrentMax(const Value: Real);
   procedure SetViewYMin(const Value: Real);
   procedure SetViewYMax(const Value: Real);
   procedure SetXScale(const Value: THorScale);
   procedure SetYScale(const Value: TVertScale);

   procedure SetAParent(AParent: TWinControl);
   { Private-Deklarationen }

protected
   procedure Paint; override;
   { Protected-Deklarationen }

public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds (Left, Top, Width, Height: Integer); override;
    property Parent read getAParent write setAParent;
    { Public-Deklarationen }

published
   Property Color              : TColor                    read  FColor
                                                           write SetColor;
   Property HistoBkColor       : TColor                    read  FHistoBkColor
                                                           write SetHistoBkColor;
   Property GapLeft            : Integer                   read  FGapLeft
                                                           write SetGapLeft;
   Property GapRight           : Integer                   read  FGapRight
                                                           write SetGapRight;
   Property GapTop             : Integer                   read  FGapTop
                                                           write SetGapTop;
   Property GapBottom          : Integer                   read  FGapBottom
                                                           write SetGapBottom;
   Property Borderstyle        : TBorderstyle              read  FBorderstyle
                                                           write SetBorderstyle;
   Property Visible            : Boolean                   read  FVisible
                                                           write SetVisible;
   Property TabOrder           : Integer                   read  FTabOrder
                                                           write SetTabOrder;
   Property Font               : TFont                     read  FFont
                                                           write SetFont;
   Property GridLineStyle      : TPenStyle                 read  FGridLineStyle
                                                           write SetGridLineStyle;
   Property ViewXCurrentMin    : Real                      read  FViewXCurrentMin
                                                           write SetViewXCurrentMin;
   Property ViewXCurrentMax    : Real                      read  FViewXCurrentMax
                                                           write SetViewXCurrentMax;
   Property Value              : Real                      read  FValue
                                                           write SetValue;
   Property ViewYMin           : Real                      read  FViewYMin
                                                           write SetViewYMin;
   Property ViewYMax           : Real                      read  FViewYMax
                                                           write SetViewYMax;
   Property XScale             : THorScale                 read  FXScale
                                                           write SetXScale;
   Property YScale             : TVertScale                read  FYScale
                                                           write SetYScale;
   Property Anchors;
   Property Cursor;
   Property Constraints;
   Property Align;
   Property OnClick;
   Property OnDblClick;
   Property Enabled;
   Property OnDragDrop;
   Property OnDragOver;
   Property OnEndDock;
   Property OnEndDrag;
   Property ShowHint;
   Property Caption;
   Property Name;
   Property DockOrientation;
  { published-Deklarationen }
end;

procedure Register;

implementation

{$R HixHistoGraph.dcr}                                                          

procedure Register;
begin
   RegisterComponents('Histo',[THixHistoGraph]);                               
end;

constructor THixHistoGraph.Create(AOwner: TComponent);
begin
  inherited;
  FCopyright       := 'Ingenieurbüro Dr. Hillger';
  FVersion         := '2014.4';
  FColor           := clBtnFace;
  FHistoBkColor    := clBtnFace;
  Width            := 270;
  Height           := 200;
  FGapTop          := 40;
  FGapBottom       := 60;
  FGapLeft         := 70;
  FGapRight        := 40;
  FBorderstyle     := bsSingle;
  FVisible         := true;
  FFont            := TFont.Create;
  FGridLineStyle   := psSolid;
  FViewXCurrentMin := 0;
  FViewXCurrentMax := 10;
  FViewYMin        := 0;
  FViewYMax        := 10;

  FXScale          := THorScale.Create(Self);        
  FYScale          := TVertScale.Create(Self);

end;

destructor THixHistoGraph.Destroy;
begin
   inherited Destroy;
   FreeAndNil(FFont);
end;

procedure THixHistoGraph.DrawComponent;

var
   ComponentBackround          : TRect;                                         // zeichnet den Hintergrund der Komponente
   HistoBackround              : TRect;                                         // zeichnet die Darstellungsfläche der Komponente
begin
   inherited;
   if (Parent = NIL) or not visible
   then Exit;

   begin
      ComponentBackround  := Rect(0, 0, Width, Height);
   end;
   Canvas.Brush.Color := FColor;
   Canvas.Pen.Color   := FColor;
   Canvas.FillRect(ComponentBackround);
   Frame3D(Canvas, ComponentBackround, clBtnHighlight, clBtnShadow, 1);         // 3D Rahmen mit der Breite von 1 für Komponentenhintergrund

   with HistoBackround do
   begin
      HistoBackround := Rect(GapLeft,
                             GapTop,
                             Width - GapRight,
                             Height - GapBottom);
   end;
   Canvas.Brush.Color := FHistoBkColor;
   Canvas.Pen.Color   := FHistoBkColor;
   Canvas.FillRect(HistoBackround);
   Frame3D(Canvas, HistoBackround, clBtnShadow, clBtnHighlight, 1); 
end;


{procedure THixHistoGraph.DrawScales;

begin
   inherited;                                              /////auch wenn ich hier Parametrisiere, wird nichts visuell

end;  }


procedure THixHistoGraph.Paint;
begin
  inherited;
  DrawComponent;
  //DrawScales;
end;

procedure THixHistoGraph.SetHistoBkColor(const Value: TColor);
begin
   FHistoBkColor := Value;
   invalidate;
end;

procedure THixHistoGraph.SetBorderstyle(const Value: TBorderstyle);
begin
   FBorderstyle := Value;
end;

procedure THixHistoGraph.SetColor(const Value: TColor);
begin
   FColor := Value;
   invalidate;
end;

procedure THixHistoGraph.SetFont(const Value: TFont);
begin
   FFont.Assign(Value);
   FFont := Value;
   invalidate;
end;


procedure THixHistoGraph.SetGapBottom(const Value: Integer);
begin
   if FGapBottom <> Value
   then
     begin
       FGapBottom := Value;
       invalidate;
     end;
end;

procedure THixHistoGraph.SetGapLeft(const Value: Integer);
begin
   if FGapLeft <> Value
   then
     begin
       FGapLeft := Value;
       invalidate;
     end;
end;

procedure THixHistoGraph.SetGapRight(const Value: Integer);
begin
   if FGapRight <> Value
   then
     begin
       FGapRight := Value;
       invalidate;
     end;
end;

procedure THixHistoGraph.SetGapTop(const Value: Integer);
begin
   if FGapTop <> Value
   then
     begin
       FGapTop := Value;
       invalidate;
     end;
end;


procedure THixHistoGraph.SetTabOrder(const Value: Integer);
begin
   FTabOrder := Value;
end;

procedure THixHistoGraph.SetVisible(const Value: Boolean);
begin
   FVisible := Value;
end;

procedure THixHistoGraph.SetGridLineStyle(const Value: TPenStyle);
begin
   FGridLineStyle := Value;
end;
     
procedure THixHistoGraph.SetViewXCurrentMin(const Value: Real);
begin
   if (ViewXCurrentMin) >= (ViewXCurrentMax)
   then FViewXCurrentMin := 0
   else FViewXCurrentMin := (Value);
   invalidate;
end;

procedure THixHistoGraph.SetViewYMin(const Value: Real);
begin
   if (ViewYMin) >= (ViewYMax)
   then FViewYMin := 0
   else FViewYMin := Value;
   invalidate;
end;

procedure THixHistoGraph.SetViewXCurrentMax(const Value: Real);
begin
   if (ViewXCurrentMax) <= (ViewXCurrentMin)
   then FViewXCurrentMax := 10
   else FViewXCurrentMax := Value;
   invalidate;
end;

procedure THixHistoGraph.SetViewYMax(const Value: Real);
begin
   if (ViewYMax) <= (ViewYMin)
   then FViewYMax := 10
   else FViewYMax := Value;
   invalidate;
end;


procedure THixHistoGraph.SetBounds(Left, Top, Width, Height: Integer);
begin
  inherited;
   invalidate;
end;

procedure THixHistoGraph.SetValue(const Value: Real);
begin
   FValue := Value;
   invalidate;
end;

procedure THixHistoGraph.SetXScale(const Value: THorScale);
begin
   FXScale.Create(self);
   FXScale.Parent.Create(self);
   FXScale.Owner.Create(self);
   FXScale.Width := 100;
   FXScale.Height := 10;
   FXScale.Left := 0;
   FXScale.Top := 0;
   FXScale.c
   invalidate;

end;

procedure THixHistoGraph.SetYScale(const Value: TVertScale);
begin
   FYScale := Value;
   invalidate;
end;



function THixHistograph.getAParent :TWinControl;
begin
   Result := inherited Parent;
end;

procedure THixHistograph.SetAParent( AParent: TWinControl);

var
lastParent : TWinControl;

begin
   lastParent := inherited Parent;
   inherited Parent := AParent;
   if (lastParent = nil) or not visible then Exit;

end;

end.

P.S. kann grad nichts hochladen, Screenshot kommt nach !

[Dejan Vu]

Delphi-Quellcode:

procedure THixHistograph.SetAParent( AParent: TWinControl);

var
lastParent : TWinControl;

begin
   lastParent := inherited Parent;
   inherited Parent := AParent;
   if (lastParent = nil) or not visible then Exit;

end;

Kannst Du mir sagen, was die letzte Zeile bedeutet/machen soll?

[Chris211183]

Wenn der letzte Parent unbekann ist, abbrechen...

Damit keine Exeptions auftreten, oder habe ich da einen Denkfehler drin ?

[Chris211183]

Hier noch der fehlende Screenshot

Links wie es mal werden soll, rechts, wie es ist, wenn ich jetzt z.B. im OI bei XScale den Grid ändere, zeigt er mir an, dass er kein übergeordnetes Fenster hat (also hat er keinen Parent ?) den sollte er doch aber haben, laut Quelltext ?

[DeddyH]

Wozu das LastParent-Geraffel? Entscheidend ist doch der aktuelle Parent und nicht der, der es einmal war.

[Chris211183]

Da hast du Recht, bloß, meine Überlegung war, dass es ja von TWinControl sein muss, da sonst wieder Inkompatible Typen sind, die sind alle von TGraphicControl abgeleitet, die Skalen werden auch in einem Bitmap gespeichert....(war auch eine Überlegung, dass das daran liegen könnte)

[DeddyH]

Versteh ich gerade nicht, der Parent muss ja sowieso von TWinControl abstammen, sonst kann er gar nicht als Parent fungieren. IMHO kannst Du die Parent-Property mit Getter und Setter wieder löschen, wird ja sowieso schon von TControl geerbt.