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;
Antwort
9. Apr 2015, 10:15
Zitat
Wenn du das Bild aufbauen möchtest muß man schon noch bissl mehr wissen: Bildgröße und die Max/Min-Werte von X und Y.
FDK das Firemonkey-Development-Kit • 
Linear-Darstellung
