type
THixBargraphKind = (sbHorizontal,
sbVertical);
THixBarGraphLabelingOrientation = (lboAbove,
// Skalenwerte oberhalb der Komponente (bei sbHorizontal)
lboBelow,
// Skalenwerte unterhalb der Komponente (bei sbHorizontal)
lboLeft,
// Skalenwerte links neben der Komponente
lboRight);
// Skalenwerte rechts neben der Komponente
THixBarGraphLabelingStyle = (lbsNone,
// Graph ohne Skalierung
lbsLines,
// Skalierung am linken und rechten Seitenrand
lbsLabels,
// Wertebereich (Zahlen) am linken Rand
lbsSymmetric,
// Skalierung und Wertebereich an linken und rechten Rand
lbsBoth);
// Skalierung und Wertebereich an linken und rechten Rand
THixBarGraph =
class(TGraphicControl)
private
FFormatStr :
String;
FAutoConfig : Boolean;
FColor : TColor;
// Farbe des Hintergrundes der Komponente
FBarColor : TColor;
// Bargraphfarbe
FBevelColor1 : TColor;
// Farbe des rechten Rahmens
FBevelColor2 : TColor;
// Farbe des linken Rahmens
FBarwidth : Integer;
// Balkenbreite
FFont : TFont;
FKind : THixBarGraphKind;
FLabelingStyle : THixBarGraphLabelingStyle;
FLabelingFont : TFont;
// Änderungsmöglichkeit der Beschriftung
FValue : Double;
// Messbalkenanzeigewert
FValueMax : Double;
// Skalenendwert
FValueMin : Double;
// Skalenanfangswert
FRangeColor : TColor;
// Farbe des Messwertebereichs
FRangeCurrent : Integer;
// definiert den aktuell veränderbarer Bereich
FRangeLimit : Integer;
// definiert die Obergrenze des aktuellen Bereichs
FRangeNumber : Integer;
// Zahl der gefärbten Bargraphbereiche
FVisible : Boolean;
// Bestimmt, ob die Komponente sichtbar ist oder nicht
FOffsetLower : Integer;
// Balkenanzeige anpassen (von unten bzw von links, je nach Ausrichtung der Komponente)
FOffsetUpper : Integer;
// Balkenanzeige anpassen (von oben bzw von rechts, je nach Ausrichtung der Komponente)
FLabelingGap : Double;
// aufgespannter Wertebereich des Skalenrasters
FLabelingOrientation : THixBarGraphLabelingOrientation;
// Ausrichtung der Beschriftung am Messbereich
FLabelingDecimals : Integer;
// Zahl der Dezimalstellen der Skalenbeschriftung
function Dezimalstellen :
String;
// verändert die Dezimalstellen der Skalenanzeige
procedure SetColor(
const Value: TColor);
procedure SetBarColor(
const Value: TColor);
procedure SetBevelColor1(
const Value: TColor);
procedure SetBevelColor2(
const Value: TColor);
procedure SetFont(
const Value: TFont);
procedure SetKind(
const Value: THixBarGraphKind);
procedure SetLabelingStyle(
const Value: THixBarGraphLabelingStyle);
procedure SetLabelingFont(
const Value: TFont);
procedure SetLabelingGap(
const Value: double);
procedure SetLabelingDecimals(
const Value: Integer);
procedure SetRangeColor(
const Value: TColor);
procedure SetRangeCurrent(
const Value: Integer);
procedure SetRangeLimit(
const Value: Integer);
procedure SetRangeNumber(
const Value: Integer);
procedure SetValue(
const Value: Double);
procedure SetValueMax(
const Value: Double);
procedure SetValueMin(
const Value: Double);
procedure SetAutoConfig(
const Value: Boolean);
procedure SetVisible(
const Value: Boolean);
procedure SetBarwidth(
const Value: Integer);
procedure SetOffsetLower(
const Value: Integer);
procedure SetOffsetUpper(
const Value: Integer);
procedure SetLabelingOrientation(
const Value: THixBarGraphLabelingOrientation);
procedure DrawComponent;
// Zeichnet den Hintergrund und die Bargraphumrandung
procedure DrawScales;
// Zeichnet die Skalierung an die Komponente
procedure CorrectLabelingGap;
// korrigiert zu enge Skalierungsbereiche
{ Private-Deklarationen }
protected
procedure Paint;
override;
{ Protected-Deklarationen }
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure SetBounds (ALeft, ATop, AWidth, AHeight: Integer);
override;
{ Public-Deklarationen }
published
property Barwidth : Integer
read FBarwidth
write SetBarwidth;
Property Color : TColor
read FColor
write SetColor;
Property BarColor : TColor
read FBarColor
write SetBarColor;
Property BevelColor1 : TColor
read FBevelColor1
write SetBevelColor1;
Property BevelColor2 : TColor
read FBevelColor2
write SetBevelColor2;
Property Font : TFont
read FFont
write SetFont;
Property Kind : THixBarGraphKind
read FKind
write SetKind;
property LabelingStyle : THixBarGraphLabelingStyle
read FLabelingStyle
write SetLabelingStyle;
Property LabelingFont : TFont
read FLabelingFont
write SetLabelingFont;
Property AutoConfig : Boolean
read FAutoConfig
write SetAutoConfig;
Property Value : Double
read FValue
write SetValue;
Property ValueMax : Double
read FValueMax
write SetValueMax;
Property ValueMin : Double
read FValueMin
write SetValueMin;
Property RangeColor : TColor
read FRangeColor
write SetRangeColor;
Property RangeCurrent : Integer
read FRangeCurrent
write SetRangeCurrent;
Property RangeLimit : Integer
read FRangeLimit
write SetRangeLimit;
Property RangeNumber : Integer
read FRangeNumber
write SetRangeNumber;
property Visible : Boolean
read FVisible
write SetVisible;
property OffsetLower : Integer
read FOffsetLower
write SetOffsetLower;
property OffsetUpper : Integer
read FOffsetUpper
write SetOffsetUpper;
Property LabelingGap : double
read FLabelingGap
write SetLabelingGap;
Property LabelingDecimals : Integer
read FLabelingDecimals
write SetLabelingDecimals;
Property LabelingOrientation : THixBarGraphLabelingOrientation
read FLabelingOrientation
write SetLabelingOrientation;
Property Anz_Dezimalstellen :
String read Dezimalstellen;
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 HixBarGraph.dcr}
procedure Register;
begin
RegisterComponents('
Test',[THixBarGraph]);
end;
constructor THixBarGraph.Create(AOwner: TComponent);
begin
inherited;
FKind := sbVertical;
FColor := clBtnFace;
FBarColor := clBtnFace;
FBevelColor1 := clBtnShadow;
FBevelColor2 := clBtnHighlight;
FBarWidth := 10;
Width := 45;
Height := 145;
Caption := '
HixBarGraph';
FVisible := true;
OffsetUpper := 8;
OffsetLower := 8;
FValueMin := 0.0;
FValueMax := 100.0;
FValue := 0;
FRangeLimit := 100;
FLabelingGap := 5;
FLabelingStyle := lbsNone;
FRangeCurrent := 1;
FRangeLimit := 100;
FLabelingDecimals := 1;
FFont := TFont.Create;
FLabelingFont := TFont.Create;
FLabelingFont.
Name := '
Arial';
FLabelingFont.Size := 8;
end;
destructor THixBarGraph.Destroy;
begin
inherited Destroy;
FreeAndNil(FFont);
FreeAndNil(FLabelingFont);
end;
procedure THixBarGraph.DrawComponent;
var
BargraphBevel : TRect;
begin
inherited;
if (Parent =
NIL)
or not visible
then Exit;
Canvas.Brush.Color := FColor;
Canvas.FillRect(Rect(0, 0, Width, Height));
// Hintergrund des Objektes als Rechteck Zeichnen
Canvas.Pen.Color := clBlack;
case FKind
of
sbHorizontal :
begin // horizontale Ausrichtung der Komponente
BargraphBevel := Rect(OffsetLower,
(Height - Barwidth)
div 2,
Width - OffsetUpper,
(Height + Barwidth)
div 2);
end;
sbVertical :
begin // vertikale Ausrichtung der Komponente
BargraphBevel := Rect((Width - BARWIDTH)
div 2,
Height - (Height - OffsetUpper),
(Width + BARWIDTH)
div 2,
Height - OffsetLower);
end;
end;
Canvas.Brush.Color := FBarColor;
Canvas.FillRect(BargraphBevel);
Frame3D(Canvas, BargraphBevel, clBtnShadow, clBtnHighlight, 1);
end;
procedure THixBarGraph.DrawScales;
const
Formatierung = '
%%.%df';
var
Value : double;
Y : Integer;
begin
Canvas.Pen.Color := clBlack;
Canvas.Font.Assign(FLabelingFont);
FFormatStr := Format(Formatierung, [FLabelingDecimals]);
Canvas.Brush.Color := FColor;
if FKind = sbHorizontal
then
begin
case FLabelingStyle
of
lbsLabels :
begin
case FLabelingOrientation
of
lboAbove,
// Zahlen oberhalb des Anzeigebereichs
lboBelow :
// Zahlen unterhalb des Anzeigebereichs
begin
if FLabelingOrientation = lboAbove
then Y := 0
else Y := ClientHeight - canvas.TextHeight('
0');
Value := abs(ValueMin);
while Value <= ValueMax
do
begin
Canvas.TextOut(OffsetLower +
// linker OffsetWert
round((ClientWidth - (OffsetUpper + OffsetLower))
// BarGraphlänge
* (Value / (ValueMax - ValueMin))
// Abstand
-(canvas.TextWidth(Format(FFormatStr,[Value]))/2)),
// halbe Breite des Anzeigewerts
Y,
// Y- Koordinate des Startpunktes der Textausgabe
Format(FFormatStr, [Value]));
// Formatierung des Ausgabewertes
Value := Value + (LabelingGap);
end;
end;
end;
end;
end;
end;
end;
procedure THixBarGraph.Paint;
begin
inherited;
DrawComponent;
// Zeichnet Hintergrund und BarGraph(Messbalken)
DrawScales;
// Zeichnet Skalierungen an die Komponente
end;
.....
procedure THixBarGraph.SetValue(
const Value: Double);
begin
if (FValue = ValueMin)
and (FValue <= FValueMax)
then
begin
Canvas.Brush.Color := FRangeColor;
paint;
end;
end;
procedure THixBarGraph.SetValueMax(
const Value: Double);
begin
if FValueMax<FValueMin
// Maximalwert darf nicht kleiner als Minimalwert sein
then Exit;
FValueMax := Value;
invalidate;
end;
procedure THixBarGraph.SetValueMin(
const Value: Double);
begin
FValueMin := Value;
Invalidate;
end;
.....
end.