Array Probleme

[Chris211183]

Hier mal der komplette Source und im Anhang, wie es aussieht....

Delphi-Quellcode:

unit HixHistograph;

interface

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

type




   TFxFunction = function(const x: Extended): Extended;
   TPointDynArray = Array of TPoint;

   THixHistoGraphGridVisible = (grdNone,                                        // kein Rastergitter
                                grdHor,                                         // horizontales Rastergitter
                                grdVer,                                         // vertikales Rastergitter
                                grdBoth);                                       // horizontales und vertikales Rastergitter


   THixHistoGraph = class(TCustomPanel)


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 Hintergrunds
   FVersion                 : String;
   FFont                    : TFont;
   FGridLineStyle           : TPenStyle;
   FViewXNominalMin         : Real;
   FViewXNominalMax         : Real;
   FXScale                  : THorScale;
   FYScale                  : TVertScale;
   FGridVisible             : THixHistoGraphGridVisible;                        // stellt Rastergitter in der Darstellungsfläche zur Verfügung
   FBKGridColor             : TColor;                                           // Farbe des Rastergitters
   FSeriesColor             : TColor;                                           // Farbe der Messkurven
   FSeriesNumber            : Integer;                                          // Anzahl der Messkurven
   FSeriesCurrent           : Integer;                                          // Wahl der Messkurve, die eingestellt werden soll
   FSeriesLineStyle         : TPenStyle;

   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 SetColor(const Value: TColor);
   procedure SetVersion(const Value: String);
   procedure SetFont(const Value: TFont);
   procedure SetValue(const Value: Real);
   procedure DrawComponent;                                                     // zeichnet Hintergrund und Darstellungsfläche
   procedure SetGridLineStyle(const Value: TPenStyle);
   procedure SetViewXNominalMin(const Value: Real);
   procedure SetViewXNominalMax(const Value: Real);
   procedure SetXScale(const Value: THorScale);
   procedure SetYScale(const Value: TVertScale);
   procedure SetGridVisible(const Value: THixHistoGraphGridVisible);
   procedure SetBKGridColor(const Value: TColor);
   procedure SetHistoBkColor(const Value: TColor);
   procedure SetSeriesColor(const Value: TColor);
   procedure SetSeriesNumber(const Value: Integer);
   procedure SetSeriesCurrent(const Value: Integer);
   procedure SetSeriesLineStyle(const Value: TPenStyle);
   procedure DrawGrid;                                                          // zeichnet Rastergitter
   procedure DrawPointView(ACanvas: TCanvas; const HistoBackround: TRect; const APoints : TPointDynArray);
   procedure DrawMeasureValue;
   procedure DrawValue; // Test
   function  CalculatePointView(AFunc: TFxFunction; const HistoBackround: TRect; x0, y0, dx, dy: Extended): TPointDynArray;
   { 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;
    procedure Resize; override;                                                 // damit lassen sich die geerbten Abmessungen neu setzen
    { Public-Deklarationen }

published
   Property Version            : String                    read  FVersion
                                                           write SetVersion;
   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 ViewXNominalMin    : Real                      read  FViewXNominalMin
                                                           write SetViewXNominalMin;
   Property ViewXNominalMax    : Real                      read  FViewXNominalMax
                                                           write SetViewXNominalMax;
   Property Value              : Real                      read  FValue
                                                           write SetValue;
   Property XScale             : THorScale                 read  FXScale
                                                           write SetXScale;
   Property YScale             : TVertScale                read  FYScale
                                                           write SetYScale;
   Property GridVisible        : THixHistoGraphGridVisible read  FGridVisible
                                                           write SetGridVisible;
   Property BKGridColor        : TColor                    read  FBKGridColor
                                                           write SetBKGridColor;
   Property SeriesColor        : TColor                    read  FSeriesColor
                                                           write SetSeriesColor;
   Property SeriesNumber       : Integer                   read  FSeriesNumber
                                                           write SetSeriesNumber;
   Property SeriesLineStyle    : TPenStyle                 read  FSeriesLineStyle
                                                           write SetSeriesLineStyle;
   Property SeriesCurrent      : Integer                   read  FSeriesCurrent
                                                           write SetSeriesCurrent;

   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}                                                          // CH-- 140401

procedure Register;
begin
   RegisterComponents('Histo',[THixHistoGraph]);                                // CH-- 140401, ToDO noch ändern, bei HixKomponenteneintrag ändern
end;

constructor THixHistoGraph.Create(AOwner: TComponent);
begin
  inherited;
  FVersion              := '2014.4';
  FColor                := clBtnFace;
  FHistoBkColor         := cl3DDkShadow;
  Width                 := 1100;
  Height                := 400;
  FGapTop               := 40;
  FGapBottom            := 60;
  FGapLeft              := 70;
  FGapRight             := 40;
  FBorderstyle          := bsSingle;
  FVisible              := true;
  FFont                 := TFont.Create;
  FGridLineStyle        := psSolid;
  FXScale               := THorScale.Create(Self);
  FXScale.Parent        := Self;
  FYScale               := TVertScale.Create(Self);
  FYScale.Parent        := Self;
  FBorderstyle          := bsSingle;
  FGridVisible          := grdNone;
  FBKGridColor          := clgray;
  FGridVisible          := grdBoth;
  FViewXNominalMin      := 0;
  FViewXNominalMax      := 100;
  FSeriesLineStyle      := psSolid;
  FSeriesCurrent        := 1;
  FSeriesNumber         := 1;
  FSeriesColor          := clLime;
end;

destructor THixHistoGraph.Destroy;
begin
   FFont.Free;
   inherited Destroy;
end;


////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//                          BERECHNUNG DER KOORDINATEN                        //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////



function mysin(const X: Extended):Extended;                                     // Wrapper-Funktion, benötigt für Delphi 6 um Sinus-Funktion implementieren zu können
begin
   Result := sin(x);
end;



function THixHistoGraph.CalculatePointView                                      // Berechnung der Punkte für die Funktionsdarstellung
(AFunc: TFxFunction; const HistoBackround: TRect; x0, y0, dx, dy: Extended): TPointDynArray;
var
  x, y: Extended;
  i : integer;
begin                                                                           // für jede Spalte einen Punkt
   SetLength(Result, HistoBackround.Right - HistoBackround.Left + 1);           // Punkte berechnen
   x := 0;
   for i := Low(Result) to High(Result) do
   begin
   y := AFunc(x);
   y := -y;                                                                     // Canvas Nullpunkt obere linke Ecke mit Y- Achse nach unten !!!
   y := y0 + y;                                                                 // oberen Rand Addieren
   y := y / dy;                                                                 // Skalieren
   Result[i].x := HistoBackround.Left + i;
   Result[i].Y := HistoBackround.Top + Round(y);                                // runden
   x := x + dx;
   end;                                                                         // nächster Punkt

end;


////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//                                Zeichnen                                    //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////

procedure THixHistoGraph.DrawComponent;
var
   ComponentBackround          : TRect;                                         // zeichnet Komponente
   HistoBackround              : TRect;                                         // zeichnet die Darstellungsfläche der Komponente
begin

 if FBorderstyle = bsSingle then                                                // mit 3D-Rahmen

   begin
   inherited;
   if (Parent = NIL) or not visible
   then Exit;
   begin
   ComponentBackround := Rect(0, 0, Width, Height);                             // Koponentenhintergrund
   Canvas.Brush.Color := FColor;
   Canvas.Pen.Color   := FColor;
   Canvas.Pen.Style   := psSolid;
   Canvas.FillRect(ComponentBackround);
   Frame3D(Canvas, ComponentBackround, clBtnHighlight, clBtnShadow, 1);         // 3D Rahmen mit der Breite von 1 für Komponentenhintergrund
   end;

      begin
      HistoBackround :=  Rect(FGapLeft,                                         // Hintergrund der Darstellungsfläche
                              FGapTop,
                              Width - FGapRight,
                              Height - FGapBottom + 2);

      Canvas.Brush.Color := FHistoBkColor;
      Canvas.Pen.Color   := FHistoBkColor;
      Canvas.FillRect(HistoBackround);
      Frame3D(Canvas, HistoBackround, clBtnShadow, clBtnHighlight, 1);
      DrawGrid;
      end;
   end;
end;

procedure THixHistoGraph.DrawMeasureValue;
var
  x0, y0, dy, dx : Real;
  i : Integer;
  P : TPointDynArray;
  HistoBackround : TRect;

begin
   HistoBackround :=  Rect(FGapLeft,                                            // Hintergrund der Darstellungsfläche
                           FGapTop,
                           Width - FGapRight,
                           Height - FGapBottom + 2);

   P:= Nil;
   InflateRect(HistoBackround, -1, -1);
   for i:= round(FViewXNominalMin) to round(FViewXNominalMax - 1) do
   begin
      x0 := FViewxNominalMin;
      y0 := (Height - FGapBottom - FGapTop) / FYScale.ValMax;
      dx := 0.5;
      dy := 0.02;
      P := CalculatePointView(mySin, HistoBackround, x0, y0, dx, dy);
      Canvas.Pen.Style := FSeriesLineStyle;
      Canvas.Brush.Color := FColor;
      Canvas.Pen.Color := FSeriesColor;
      DrawPointView(Canvas, HistoBackround, P);
   end;
end;


procedure THixHistoGraph.Resize;                                                // überschreibt die gesetzten Werte aus SubKomponenten, um die Skalen positionieren zu können
begin
  inherited;

   //FXScale.BkColor      := clyellow;                                            // zum Testen
   FXScale.Left         := 1;
   FXScale.Width        := Width - 2;
   FXScale.XGapLeft     := FGapLeft;
   FXScale.XGapRight    := FGapRight;
   FXScale.Top          := Height - FGapBottom + 2;

   //FYScale.BkColor      := clSkyBlue;                                           // zum Testen
   FYScale.Top          := 1;
   FYScale.YGapTop      := FGapTop;
   FYScale.YGapBottom   := FXScale.GridHeight;
   FYScale.Left         := 1;
   FYScale.Height       := Height - FGapBottom + FXScale.GridHeight;
   FYScale.Width        := FGapLeft - 1;
   paint;
end;

procedure THixHistoGraph.DrawGrid;                                              // zeichnet Hintergrundraster

var
   Value : Real;

begin
inherited;
   Canvas.Pen.Color      := FBKGridColor;
   Canvas.Brush.Color    := FColor;
   Canvas.Pen.Style      := FGridLineStyle;

  begin
   if FGridVisible = grdVer then                                                // Hintergrundraster in Y-Richtung
   begin
   inherited;
      Value := (FXScale.ValMin);
                  while (Value <= FXScale.ValMax) do
                  begin
                  inherited;
                  Canvas.MoveTo((FGapLeft + 1) +
                  round((Width - 2 - (FGapLeft + FGapRight))
                  * ((Value - FXScale.ValMin) / (FXScale.ValMax - FXScale.ValMin))),
                  (Height - FGapBottom));

                  Canvas.LineTo((FGapLeft + 1) +
                  round((ClientWidth - 2 - (FGapRight + FGapLeft))
                  * ((Value - FXScale.ValMin) / (FXScale.ValMax - FXScale.ValMin))),
                   FGapTop);
                  Value := (Value + FXScale.ValGap);
                  end;
   end;

   if FGridVisible = grdHor then                                                // Hintergrundraster  in X-Richtung
   begin
   inherited;
     Value := (FYScale.ValMin);
                  while (Value <= FYScale.ValMax) do
                  begin
                  inherited;
                  Canvas.MoveTo(FGapLeft,
                  FGapTop + 1 +
                  round((ClientHeight - (FGapBottom + FGapTop))
                  * ((Value - FYScale.ValMin) / (FYScale.ValMax - FYScale.ValMin))));


                  Canvas.LineTo(Width - FGapRight,
                  FGapTop + 1 +
                  round((ClientHeight - (FGapBottom + FGapTop))
                  * ((Value - FYScale.ValMin) / (FYScale.ValMax - FYScale.ValMin))));

                  Value := (Value + abs(FYScale.ValGap)) ;
                  end;
   end;

   if FGridVisible = grdBoth then                                               // Hintergrundraster in X und Y-Richtung
   begin
   inherited;
      Value := (FXScale.ValMin);
                  while (Value <= FXScale.ValMax) do
                  begin
                  inherited;
                  Canvas.MoveTo((FGapLeft + 1) +
                  round((Width - 2 - (FGapLeft + FGapRight))
                  * ((Value - FXScale.ValMin) / (FXScale.ValMax - FXScale.ValMin))),
                  (Height - FGapBottom));

                  Canvas.LineTo((FGapLeft + 1) +
                  round((ClientWidth - 2 - (FGapRight + FGapLeft))
                  * ((Value - FXScale.ValMin) / (FXScale.ValMax - FXScale.ValMin))),
                   FGapTop);
                  Value := (Value + FXScale.ValGap);
                  end;

       Value := (FYScale.ValMin);
                  while (Value <= FYScale.ValMax) do
                  begin
                  inherited;
                  Canvas.MoveTo(FGapLeft,
                  FGapTop + 1 +
                  round((ClientHeight - (FGapBottom + FGapTop))
                  * ((Value - FYScale.ValMin) / (FYScale.ValMax - FYScale.ValMin))));


                  Canvas.LineTo(Width - FGapRight,
                  FGapTop + 1 +
                  round((ClientHeight - (FGapBottom + FGapTop))
                  * ((Value - FYScale.ValMin) / (FYScale.ValMax - FYScale.ValMin))));

                  Value := (Value + abs(FYScale.ValGap)) ;
                  end;

      end;
  end;
end;

procedure THixHistoGraph.DrawPointView
(ACanvas: TCanvas; const HistoBackround: TRect; const APoints : TPointDynArray);
var
   h : Thandle;
   begin
   h:= SaveDC(ACanvas.Handle);
   try
   IntersectClipRect(ACanvas.Handle, HistoBackround.Left, HistoBackround.Top, HistoBackround.Right, HistoBackround.Bottom); // Zeichenfläche einschränken
   Polyline(ACanvas.Handle, APoints[0], Length(APoints));
   finally
      RestoreDC(ACanvas.Handle, h);
   end;
end;

procedure THixHistoGraph.Paint;
begin
  inherited;
  DrawComponent;
  DrawMeasureValue;
  DrawValue;
end;

procedure THixHistoGraph.SetHistoBkColor(const Value: TColor);                  // Farbe des Anzeigebereichs
begin
   inherited;
   FHistoBkColor := Value;
   invalidate;
end;

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

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

procedure THixHistoGraph.SetFont(const Value: TFont);
begin
   FFont.Assign(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.SetVersion(const Value: String);
begin
   FVersion := '2014.4';
end;


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


procedure THixHistoGraph.SetViewXNominalMin(const Value: Real);
begin
   begin
   if (FViewXNominalMin) >= (FViewXNominalMax)
   then FViewXNominalMin := 0
   else FViewXNominalMin := Value;

   if (FViewXNominalMin) < (FXScale.ValMin)
   then FViewXNominalMin := 0
   else FViewXNominalMin := Value;
   invalidate;
   end;
end;

procedure THixHistoGraph.SetViewXNominalMax(const Value: Real);
begin
   if (FViewXNominalMax) <= (FViewXNominalMin)
   then FViewXNominalMax := 100
   else FViewXNominalMax := Value;

   if (FViewXNominalMax) > (FXScale.ValMax)
   then FViewXNominalMax := 100
   else FViewXNominalMax := Value;
   invalidate;
end;

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

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

procedure THixHistoGraph.SetXScale(const Value: THorScale);
begin
   inherited;
   FXScale.Assign(Value);
   refresh;

end;

procedure THixHistoGraph.SetYScale(const Value: TVertScale);
begin
   inherited;
   FYScale.Assign(Value);
   refresh;
end;

procedure THixHistoGraph.SetGridVisible(const Value: THixHistoGraphGridVisible);
begin
   FGridVisible := Value;
   invalidate;
end;

procedure THixHistoGraph.SetBKGridColor(const Value: TColor);
begin
    FBKGridColor := Value;
    invalidate;
end;

procedure THixHistoGraph.SetGridLineStyle(const Value: TPenStyle);
begin
   FGridLineStyle := Value;
   invalidate;
end;

procedure THixHistoGraph.SetSeriesColor(const Value: TColor);
begin
inherited;
   FSeriesColor := Value;
   refresh;
end;

procedure THixHistoGraph.SetSeriesNumber(const Value: Integer);
begin
   FSeriesNumber := Value;
end;

procedure THixHistoGraph.SetSeriesCurrent(const Value: Integer);                // legt fest, welcher Kurve bzw Kanal eingestellt werden soll (SeriesNumber)
begin
    FSeriesCurrent := Value;
end;

procedure THixHistoGraph.SetSeriesLineStyle(const Value: TPenStyle);
begin
   FSeriesLineStyle := Value;
   refresh;
end;