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.