Einzelnen Beitrag anzeigen

Kellerassel

Registriert seit: 31. Aug 2003
Ort: NRW
24 Beiträge
 
Delphi 2010 Professional
 
#5

AW: Komponenten Erstellung

  Alt 28. Feb 2013, 10:50
So ich bin ein Stück weiter, aber jetzt hängt es an einer ähnlichen Stelle

ich bekomme von aussen (nachdem die komponente installiert ist und ich von einer form unit auf Visukurve zugreife keinen Zugriff auf die Attribute des records XAchse

Delphi-Quellcode:
unit Kurve;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

Type
TOrientierung = (Aleft,Aright,Acenter,Atop,Abottom);

Type TAxis=record
  Aktiv:boolean;
  Color:Tcolor;
  Position:TOrientierung;
  Text:String;
  Textpos:TPoint;
  Font:TFont;
end;

Type TKurve = class(TPersistent)
private
  Faktiv: Boolean;
  FFarbe: TColor;
  FZoom: Integer;
  FText: String;
  FText_Pos: TPoint;
  FWerte: Array of Integer;
  FSize: Integer;
  FX: TAxis;
  FY: TAxis;
  function GetWert(Index:integer):Integer;
  procedure WriteWert(Index,Value:integer);
  function GetSize:Integer;
  procedure WriteSize(value:Integer);
  function GetXAchse:TAxis;
  procedure WriteXAchse(value:TAxis);
  function GetYAchse:TAxis;
  procedure WriteYAchse(value:TAxis);
public
  procedure Assign(Source: TPersistent); override;
  property Wert[Index:integer] :Integer read GetWert write WriteWert;
  property XAchse :TAxis read GetXAchse write WriteXAchse;
  property YAchse :TAxis read GetXAchse write WriteXAchse;
  constructor Create(Text:String;size:Integer);
  destructor Destroy; override;
published
  property Aktiv     :Boolean read FAktiv    write FAktiv;
  property Zoom     :Integer read FZoom    write FZoom;
  property Text     :String read FText    write FText;
  property Size :Integer read GetSize write WriteSize;
  property Farbe     :TColor read FFarbe    write FFarbe;
end;
implementation


procedure TKurve.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TKurve then
  begin
  self.Faktiv :=TKurve(Source).Faktiv;
  self.FFarbe :=TKurve(Source).FFarbe;
  self.FZoom :=TKurve(Source).FZoom;
  self.FText :=TKurve(Source).FText;
  self.FSize :=TKurve(Source).FSize;

  for I := 0 to TKurve(Source).FSize -1 do
  self.Wert[i]:=TKurve(Source).Wert[i];
  end
  else
  inherited; // Klasse nicht bekannt, also inherited aufrufen;

end;

constructor TKurve.Create(Text:String;size:Integer);
var i:integer;
mypoint:tpoint;
begin
  inherited Create;
  SetLength(FWerte,size);
  mypoint.X:=0;mypoint.Y:=0;
  Faktiv:=true;
  FFarbe:=clyellow;
  FZoom:=0;
  FText:=Text;
  FText_Pos:=mypoint;
  for I := 0 to high(FWerte) do FWerte[i]:=i;//Random(100);

  // Axen init
  FX.Font:=TFont.Create;
  FX.Color:=clwhite;
  FX.Aktiv:=true;
  FX.Position:=Acenter;
  FX.Textpos.X:=0;
  FX.Textpos.Y:=0;
  FX.Text:='X-Achse';


end;

destructor TKurve.Destroy;
begin
  inherited Destroy;
end;


{ TKurve }

function TKurve.GetXAchse:TAxis;
begin
  with TAxis (fx) do begin
   result.Aktiv:=fx.Aktiv;
   result.Color:=fx.Color;
   result.Position:=fx.Position;
   result.Text:=fx.Text;
   result.Textpos:=fx.Textpos;
   //result.Font.Assign(fx.Font);
  end;
end;



function TKurve.GetYAchse: TAxis;
begin
   result.Aktiv:=FY.Aktiv;
   result.Color:=fy.Color;
   result.Position:=fy.Position;
   result.Text:=fy.Text;
   result.Textpos:=fy.Textpos;
   //result.Font.Assign(fy.Font);
end;

function TKurve.GetSize: Integer;
begin
result:=high(FWerte);
end;

procedure TKurve.WriteXAchse(value: TAxis);
begin
  with TAxis(FX) do begin
    Aktiv:=Value.Aktiv;
    Color:=Value.Color;
    Position:=Value.Position;
    Text:=Value.Text;
    Textpos:=Value.Textpos;
    Font.Assign(Value.Font);
  end;
end;

procedure TKurve.WriteYAchse(value: TAxis);
begin
    FY.Aktiv:=Value.Aktiv;
    FY.Color:=Value.Color;
    FY.Position:=Value.Position;
    FY.Text:=Value.Text;
    FY.Textpos:=Value.Textpos;
    FY.Font.Assign(Value.Font);
end;

procedure TKurve.WriteSize(value: Integer);
begin
SetLength(FWerte,value+1);
end;

function TKurve.GetWert(Index: integer): Integer;
begin
result:=FWerte[index];
end;

procedure TKurve.WriteWert(Index, Value: integer);
begin
FWerte[Index]:=Value;
end;


end.

innerhalb der folgenden Komponenten Unit geht's noch


Delphi-Quellcode:
unit Visu_Kurvenunit1;


interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,kurve;

type
  TVisuKurve = class(TCustomControl)
  private
    FCanvas :TCanvas;
    FKurven :Array [1..10] of TKurve;
    FZoom :Real;
    FRun :Boolean;
    FTimer :TTimer;
    FTime :Integer;
    FKurvenCount :Integer ;
    function GetKurve (Index: Integer): TKurve;
    procedure WriteKurve (Index: Integer; Value:TKurve);
    function GetKurvenCount:Integer;
  protected
    procedure Paint; override;
    procedure TickEvent(Sender: TObject);
    procedure SaveKurveToFile(Filename:String);
  public
    property Kurve[Index:integer] :TKurve read GetKurve write WriteKurve;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property VisuRUN :Boolean read FRUN    write FRUN;
    property RefreshIntervall :Integer read FTime    write FTime;
    property KurvenCount :Integer read GetKurvenCount;
  end;

procedure Register;

implementation


procedure Register;
begin
  RegisterComponents('MiningComponents', [TVisuKurve]);
end;

constructor TVisuKurve.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;

  // Setting default Values
  FCanvas.Brush.Color :=clblack;
  Width :=220;
  Height :=100;

  // Create the Timer for painting
  FTimer := TTimer.Create(nil);
  FTimer.Interval := 100; // Konstant
  FTimer.OnTimer := TickEvent;

  FKurven[1]:=TKurve.Create('Kurve 1',width);
  for i := 2 to 10 do
  begin
   FKurven[i]:=TKurve.Create('Kurve ' + inttostr(i),0);
   FKurven[i].Aktiv:=false;
  end;
end;


destructor TVisuKurve.Destroy;
begin
  Ftimer.Free;
  FCanvas.Free;
  inherited Destroy;
end;


procedure TVisuKurve.Paint;
var Render:TBitmap;
  i,count:Integer;

begin
  Render:=Tbitmap.Create;
  Render.Width:=Width;Render.Height:=Height;
  Render.Canvas.Brush.Color:=FCanvas.Brush.Color;
  Render.Canvas.Rectangle(0,0,width,height);

  // Über alle instanzierten Objekte
  for Count:=1 to 10 do
  begin
          if FKurven[count].aktiv then
            begin

              if FKurven[count].XAchse.Aktiv then
              begin
                    render.Canvas.Pen.Color:=FKurven[count].XAchse.Color;
                    case FKurven[count].XAchse.Position of
                    Atop : begin
                              Render.Canvas.MoveTo(5,5);
                              render.Canvas.LineTo(width-5,5);
                             end;
                    Acenter: begin
                              Render.Canvas.MoveTo(5,height div 2);
                              render.Canvas.LineTo(width-5,height div 2);
                             end;
                    ABottom: begin
                              Render.Canvas.MoveTo(5,height -5);
                              render.Canvas.LineTo(width-5,height -5);
                             end;
                    end;
              end;

            // Werte auslesen, und als Kurve darstellen
             render.Canvas.Pen.Color:=FKurven[count].Farbe;

             if FKurven[count].XAchse.Position = Acenter then
              begin
                Render.Canvas.MoveTo(5,height div 2);
                  for i:= 0 to FKurven[count].Size -1 do
                    begin
                      Render.Canvas.LineTo(6+i,height div 2 - FKurven[count].Wert[i] );
                    end;
              end;

            if FKurven[count].XAchse.Position = ABottom then
              begin
                Render.Canvas.MoveTo(5,height -5);
                  for i:= 0 to FKurven[count].Size -1 do
                    begin
                      Render.Canvas.LineTo(6+i,height-5 - FKurven[count].Wert[i] );
                    end;
              end;

            if FKurven[count].XAchse.Position = ATop then
              begin
                Render.Canvas.MoveTo(5,5);
                  for i:= 0 to FKurven[count].Size -1 do
                    begin
                      Render.Canvas.LineTo(6+i,5 + FKurven[count].Wert[i] );
                    end;
              end;

            end;
  end;

  Canvas.Draw(0,0,Render);
  Render.Free;
end;



function TVisuKurve.GetKurve(Index: Integer): TKurve;
begin
Result:=(FKurven[index]);
//with TAxis (FX) do begin
// result.XAchse.Aktiv:=FKurven[index].XAchse.Aktiv; Fehler linker Seite dar nichts zugewiesen werden.
//end;
end;

function TVisuKurve.GetKurvenCount: Integer;
var
  I,j: Integer;
begin
j:=0;
for I := 1 to 10 do
begin
     if FKurven[i].Aktiv then inc(j);
end;
result:=j;
end;

procedure TVisuKurve.WriteKurve(Index: Integer; Value: TKurve);
begin
FKurven[index].Assign(Value);
end;

procedure TVisuKurve.SaveKurveToFile(Filename: String);
begin
//
end;

procedure TVisuKurve.TickEvent(Sender: TObject);
begin
Paint;
end;

end.

was überseh ich ?

Ich weiß es ist etwas viel Quelltext, aber ich wollte nix vergessen


Thx
Auf jede komplizierte Frage gibt es eine kurze knappe Antwort, die falsch ist.
  Mit Zitat antworten Zitat