560a1e5ba2
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5565 8e941d3f-bd1b-0410-a28a-d453659cc2b4
458 lines
12 KiB
ObjectPascal
458 lines
12 KiB
ObjectPascal
{**********************************************************************
|
|
GnouMeter is a meter which can display an integer or a float value (Single).
|
|
Just like a progress bar or a gauge, all you have do do is to define
|
|
the Minimum and maximum values as well as the actual value.
|
|
|
|
Above the meter, one can display the name of the data being measured (optional)
|
|
and its actual value with its corresponding unit.
|
|
The minimum and maximum values are respectively shown at the bottom and the
|
|
top of the meter with their corresponding units.
|
|
The meter is filled with the color ColorFore and its background color
|
|
is defined by the ColorBack Property.
|
|
|
|
THIS COMPONENT IS ENTIRELY FREEWARE
|
|
|
|
Author: Jérôme Hersant
|
|
jhersant@post4.tele.dk
|
|
***********************************************************************}
|
|
|
|
unit indGnouMeter;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, Controls, Graphics, SysUtils, Messages, LMessages, Types, LCLType, LCLIntf;
|
|
|
|
type
|
|
TindGnouMeter = class(TGraphicControl)
|
|
private
|
|
fValue: Double;
|
|
fColorFore: TColor;
|
|
fColorBack: TColor;
|
|
fSignalUnit: ShortString;
|
|
fValueMax: Double;
|
|
fValueMin: Double;
|
|
fDigits: Byte;
|
|
fIncrement: Double;
|
|
fShowIncrements: Boolean;
|
|
fGapTop: Word;
|
|
fGapBottom: Word;
|
|
fBarThickness: Word;
|
|
fMarkerColor: TColor;
|
|
fShowMarker: Boolean;
|
|
//Variables used internally
|
|
TopTextHeight: Word;
|
|
LeftMeter: Word;
|
|
DisplayValue: String;
|
|
DrawStyle: integer;
|
|
TheRect: TRect;
|
|
//End of variables used internally
|
|
procedure SetValue(val: Double);
|
|
procedure SetColorBack(val: TColor);
|
|
procedure SetColorFore(val: TColor);
|
|
procedure SetSignalUnit(val: ShortString);
|
|
procedure SetValueMin(val: Double);
|
|
procedure SetValueMax(val: Double);
|
|
procedure SetDigits(val: Byte);
|
|
procedure SetTransparent(val: Boolean);
|
|
function GetTransparent: Boolean;
|
|
procedure SetIncrement(val: Double);
|
|
procedure SetShowIncrements(val: Boolean);
|
|
procedure SetGapTop(val: Word);
|
|
procedure SetGapBottom(val: Word);
|
|
procedure SetBarThickness(val: Word);
|
|
procedure SetMarkerColor(val: TColor);
|
|
procedure SetShowMarker(val: Boolean);
|
|
procedure DrawTopText;
|
|
procedure DrawMeterBar;
|
|
procedure DrawIncrements;
|
|
function ValueToPixels(val: Double): integer;
|
|
procedure DrawValueMax;
|
|
procedure DrawValueMin;
|
|
procedure DrawMarker;
|
|
protected
|
|
procedure Paint; override;
|
|
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property Align;
|
|
property Caption;
|
|
property Visible;
|
|
property ShowHint;
|
|
property Value: Double read fValue write SetValue;
|
|
property Color;
|
|
property Font;
|
|
property ParentColor;
|
|
property ColorFore: Tcolor read fColorFore write SetColorFore;
|
|
property ColorBack: Tcolor read fColorBack write SetColorBack;
|
|
property SignalUnit: ShortString read fSignalUnit write SetSignalUnit;
|
|
property ValueMin: Double read fValueMin write SetValueMin;
|
|
property ValueMax: Double read fValueMax write SetValueMax;
|
|
property Digits: Byte read fDigits write SetDigits;
|
|
property Increment: Double read fIncrement write SetIncrement;
|
|
property ShowIncrements: Boolean read fShowIncrements write SetShowIncrements;
|
|
property Transparent: Boolean read GetTransparent write SetTransparent;
|
|
property GapTop: Word read fGapTop write SetGapTop;
|
|
property GapBottom: Word read fGapBottom write SetGapBottom;
|
|
property BarThickness: Word read fBarThickness write SetBarThickness;
|
|
property MarkerColor: TColor read fMarkerColor write SetMarkerColor;
|
|
property ShowMarker: Boolean read fShowMarker write SetShowMarker;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
constructor TindGnouMeter.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csReplicatable, csSetCaption];
|
|
Width := 100;
|
|
Height := 200;
|
|
fColorFore := clRed;
|
|
fColorBack := clBtnFace;
|
|
fMarkerColor := clBlue;
|
|
fValueMin := 0;
|
|
fValueMax := 100;
|
|
fIncrement := 10;
|
|
fShowIncrements := True;
|
|
fShowMarker := True;
|
|
fValue := 0;
|
|
fGapTop := 20;
|
|
fGapBottom := 10;
|
|
fBarThickness := 5;
|
|
fSignalUnit := 'Units';
|
|
end;
|
|
|
|
destructor TindGnouMeter.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TindGnouMeter.CMTextChanged(var Message: TMessage);
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetValue(val: Double);
|
|
begin
|
|
if (val <> fValue) and (val >= fValueMin) and (val <= fValueMax) then
|
|
begin
|
|
fValue := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetColorFore(val: TColor);
|
|
begin
|
|
if val <> fColorFore then
|
|
begin
|
|
fColorFore := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetColorBack(val: TColor);
|
|
begin
|
|
if val <> fColorBack then
|
|
begin
|
|
fColorBack := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetSignalUnit(val: ShortString);
|
|
begin
|
|
if val <> fSignalUnit then
|
|
begin
|
|
fSignalUnit := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetValueMin(val: Double);
|
|
begin
|
|
if (val <> fValueMin) and (val <= fValue) then
|
|
begin
|
|
fValueMin := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetValueMax(val: Double);
|
|
begin
|
|
if (val <> fValueMax) and (val >= fValue) then
|
|
begin
|
|
fValueMax := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetDigits(val: Byte);
|
|
begin
|
|
if (val <> fDigits) then
|
|
begin
|
|
fDigits := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetIncrement(val: Double);
|
|
begin
|
|
if (val <> fIncrement) and (val > 0) then
|
|
begin
|
|
fIncrement := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetShowIncrements(val: Boolean);
|
|
begin
|
|
if (val <> fShowIncrements) then
|
|
begin
|
|
fShowIncrements := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TindGnouMeter.GetTransparent: Boolean;
|
|
begin
|
|
Result := not (csOpaque in ControlStyle);
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetTransparent(Val: Boolean);
|
|
begin
|
|
if Val <> Transparent then
|
|
begin
|
|
if Val then
|
|
ControlStyle := ControlStyle - [csOpaque]
|
|
else
|
|
ControlStyle := ControlStyle + [csOpaque];
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetGapTop(val: Word);
|
|
begin
|
|
if (val <> fGapTop) then
|
|
begin
|
|
fGapTop := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetGapBottom(val: Word);
|
|
begin
|
|
if (val <> fGapBottom) then
|
|
begin
|
|
fGapBottom := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetBarThickness(val: Word);
|
|
begin
|
|
if (val <> fBarThickness) and (val > 0) then
|
|
begin
|
|
fBarThickness := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetMarkerColor(val: TColor);
|
|
begin
|
|
if (val <> fMarkerColor) then
|
|
begin
|
|
fMarkerColor := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.SetShowMarker(val: Boolean);
|
|
begin
|
|
if (val <> fShowMarker) then
|
|
begin
|
|
fShowMarker := val;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.DrawIncrements;
|
|
var
|
|
i: Double;
|
|
PosPixels: Word;
|
|
begin
|
|
if fShowIncrements then
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
i := fValueMin;
|
|
while i <= fValueMax do
|
|
begin
|
|
PosPixels := ValueToPixels(i);
|
|
pen.color := clGray;
|
|
MoveTo(LeftMeter + BarThickness + 3, PosPixels - 1);
|
|
LineTo(LeftMeter + BarThickness + 7, PosPixels - 1);
|
|
pen.color := clWhite;
|
|
MoveTo(LeftMeter + BarThickness + 3, PosPixels);
|
|
LineTo(LeftMeter + BarThickness + 7, PosPixels);
|
|
i := i + fIncrement;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.DrawMarker;
|
|
begin
|
|
if fShowMarker then
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
pen.color := clWhite;
|
|
Brush.Style := bsClear;
|
|
MoveTo(LeftMeter - 2, ValueToPixels(fValue));
|
|
LineTo(LeftMeter - 6, ValueToPixels(fValue) - 4);
|
|
LineTo(LeftMeter - 6, ValueToPixels(fValue) + 4);
|
|
pen.color := clGray;
|
|
LineTo(LeftMeter - 2, ValueToPixels(fValue));
|
|
|
|
pen.color := fMarkerColor;
|
|
Brush.color := fMarkerColor;
|
|
Brush.Style := bsSolid;
|
|
Polygon([Point(LeftMeter - 3, ValueToPixels(fValue)),
|
|
Point(LeftMeter - 5, ValueToPixels(fValue) - 2),
|
|
Point(LeftMeter - 5, ValueToPixels(fValue) + 2),
|
|
Point(LeftMeter - 3, ValueToPixels(fValue))]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.DrawTopText;
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
DisplayValue := Caption;
|
|
Brush.Style := bsClear;
|
|
TheRect := ClientRect;
|
|
DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_CENTER + DT_TOP;
|
|
Font.Style := [fsBold];
|
|
TopTextHeight := DrawText(Handle, PChar(DisplayValue),
|
|
Length(DisplayValue), TheRect, DrawStyle);
|
|
|
|
Font.Style := [];
|
|
TheRect.Top := TopTextHeight;
|
|
DisplayValue := FloatToStrF(Value, ffFixed, 8, fDigits) + ' ' + fSignalUnit;
|
|
TopTextHeight := TopTextHeight + DrawText(Handle, PChar(DisplayValue),
|
|
Length(DisplayValue), TheRect, DrawStyle);
|
|
TopTextHeight := TopTextHeight + fGapTop;
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.DrawValueMin;
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
TheRect := ClientRect;
|
|
TheRect.Left := LeftMeter + BarThickness + 10;
|
|
TheRect.Top := TopTextHeight;
|
|
TheRect.Bottom := Height - fGapBottom + 6;
|
|
Brush.Style := bsClear;
|
|
DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_LEFT + DT_BOTTOM;
|
|
DisplayValue := FloatToStrF(ValueMin, ffFixed, 8, fDigits) + ' ' + fSignalUnit;
|
|
DrawText(Handle, PChar(DisplayValue), Length(DisplayValue),
|
|
TheRect, DrawStyle);
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.DrawValueMax;
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
TheRect := ClientRect;
|
|
TheRect.Left := LeftMeter + BarThickness + 10;
|
|
TheRect.Top := TopTextHeight - 6;
|
|
Brush.Style := bsClear;
|
|
DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_LEFT + DT_TOP;
|
|
DisplayValue := FloatToStrF(ValueMax, ffFixed, 8, fDigits) + ' ' + fSignalUnit;
|
|
DrawText(Handle, PChar(DisplayValue), Length(DisplayValue),
|
|
TheRect, DrawStyle);
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.DrawMeterBar;
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
pen.Color := fColorBack;
|
|
Brush.Color := fColorBack;
|
|
Brush.Style := bsSolid;
|
|
Rectangle(LeftMeter, ValueToPixels(fValueMax), LeftMeter +
|
|
fBarThickness, ValueToPixels(fValueMin));
|
|
|
|
pen.Color := fColorFore;
|
|
Brush.Color := fColorFore;
|
|
Brush.Style := bsSolid;
|
|
Rectangle(LeftMeter + 1, ValueToPixels(fValue), LeftMeter +
|
|
fBarThickness, ValueToPixels(fValueMin));
|
|
|
|
pen.color := clWhite;
|
|
Brush.Style := bsClear;
|
|
MoveTo(LeftMeter + fBarThickness - 1, ValueToPixels(fValueMax));
|
|
LineTo(LeftMeter, ValueToPixels(fValueMax));
|
|
LineTo(LeftMeter, ValueToPixels(fValueMin) - 1);
|
|
|
|
pen.color := clGray;
|
|
LineTo(LeftMeter + fBarThickness, ValueToPixels(fValueMin) - 1);
|
|
LineTo(LeftMeter + fBarThickness, ValueToPixels(fValueMax));
|
|
|
|
if (fValue > fValueMin) and (fValue < fValueMax) then
|
|
begin
|
|
pen.color := clWhite;
|
|
MoveTo(LeftMeter + 1, ValueToPixels(fValue));
|
|
LineTo(LeftMeter + fBarThickness, ValueToPixels(fValue));
|
|
pen.color := clGray;
|
|
MoveTo(LeftMeter + 1, ValueToPixels(fValue) - 1);
|
|
LineTo(LeftMeter + fBarThickness, ValueToPixels(fValue) - 1);
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
function TindGnouMeter.ValueToPixels(val: Double): integer;
|
|
var
|
|
factor: Double;
|
|
begin
|
|
Result := 0;
|
|
if fValueMax > fValueMin then
|
|
begin
|
|
Factor := (Height - fGapBottom - TopTextHeight) / (fValueMin - fValueMax);
|
|
Result := Round(Factor * val - Factor * fValueMax + TopTextHeight);
|
|
end;
|
|
end;
|
|
|
|
procedure TindGnouMeter.Paint;
|
|
begin
|
|
LeftMeter := (Width div 2) - 10 - fBarThickness;
|
|
with Canvas do
|
|
begin
|
|
if not Transparent then
|
|
begin
|
|
Brush.Color := Self.Color;
|
|
Brush.Style := bsSolid;
|
|
FillRect(ClientRect);
|
|
end;
|
|
Brush.Style := bsClear;
|
|
DrawTopText;
|
|
DrawValueMin;
|
|
DrawValueMax;
|
|
DrawMeterBar;
|
|
DrawMarker;
|
|
DrawIncrements;
|
|
end;
|
|
end;
|
|
|
|
end.
|