unit ULEDMeter;
interface
uses Windows, Classes, Controls, Graphics;
type
TLEDMeter =
class(TGraphicControl)
private
FPosition: integer;
FBarWidth: integer;
FZone1: integer;
FZone2: integer;
FZone1Color: integer;
FZone2Color: integer;
FZone3Color: integer;
procedure SetPosition(Value: integer);
protected
procedure Paint;
override;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
property Color;
property Position: integer
read FPosition
write SetPosition;
property BarWidth: integer
read FBarWidth
write FBarWidth;
property Zone1: integer
read FZone1
write FZone1;
property Zone2: integer
read FZone2
write FZone2;
property Zone1Color: integer
read FZone1Color
write FZone1Color;
property Zone2Color: integer
read FZone2Color
write FZone2Color;
property Zone3Color: integer
read FZone3Color
write FZone3Color;
end;
implementation
{ TLEDMeter }
constructor TLEDMeter.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 25;
Height := 150;
FPosition := 0;
FBarWidth := 5;
FZone1 := 70;
FZone2 := 90;
FZone1Color := clLime;
FZone2Color := clYellow;
FZone3Color := clRed;
end;
destructor TLEDMeter.Destroy;
begin
inherited Destroy;
end;
procedure TLEDMeter.SetPosition(Value: integer);
begin
if (FPosition <> Value)
and (FPosition
in [0..100])
then begin
FPosition := Value;
Paint;
end;
end;
procedure TLEDMeter.Paint;
var
i, Pos, BarCount: integer;
Bar: TBitmap;
begin
Bar := TBitmap.Create;
Bar.Width := Width;
Bar.Height := Height;
Bar.Canvas.Brush.Color := Color;
Bar.Canvas.FillRect(Rect(0, 0, Width, Height));
Bar.Canvas.Pen.Width := 1;
if Height > Width
then BarCount := Height
else BarCount := Width;
for i := 0
to BarCount
do
begin
Pos := (i * 100)
div BarCount;
if Pos < FPosition
then
begin
if i
mod (FBarWidth + 1) = FBarWidth
then Bar.Canvas.Pen.Color := Color
else begin
if Pos < FZone1
then Bar.Canvas.Pen.Color := FZone1Color;
if (Pos >= FZone1)
and (Pos < FZone2)
then Bar.Canvas.Pen.Color := FZone2Color;
if Pos >= FZone2
then Bar.Canvas.Pen.Color := FZone3Color;
end;
if Height > Width
then
begin
Bar.Canvas.PenPos := Point(0, Height-i);
Bar.Canvas.LineTo(Width, Height-i);
end else begin
Bar.Canvas.PenPos := Point(i, 0);
Bar.Canvas.LineTo(i, Height);
end;
end else break;
end;
Canvas.CopyRect(Rect(0, 0, Width,Height), Bar.Canvas,Rect(0, 0, Width, Height));
Bar.Free;
end;
end.