Chip 2002 December/Chip_2002-12_cd1.bin/zkuste/delphi/kompon/d5/DDLEDBAR.ZIP/DDLedBar/DDLedBar.pas

Pascal/Delphi Source File | 2002-09-22 | 7.1 KB | 244 lines

//------------------------------------------------------------------------------
//
//    TDDLedBar v1.0  ( FREEWARE Component)
//    Copyright 2002 Dobrin Dobrev, e-mail:[e-mail]
//    http://elektronika.vega.bg
//
//------------------------------------------------------------------------------
//
// This is a simple 3 color LED bar component for Delphi
//
// ColorLow, ColorMid, ColorHi - Used colors to render bars
// Orientation - Orientation of the component
// BarSize - Size of each bar in LED
// Position - Current position
// LowToMidPos, MidToHiPos - Break between low, middle and high color
//
//------------------------------------------------------------------------------

unit DDLedBar;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls;

type
  TDDLedBar = class(TGraphicControl)
  private
    FColorLow : TColor;
    FColorMid : TColor;
    FColorHi : TColor;
    FOrientation : TTrackBarOrientation;
    FMaxValue : Longint;
    FBackColor : TColor;
    FBarSize : Word;
//    FBarOrientation : TTrackBarOrientation;
    FPosition : Longint;
    FLowToMidPos : Byte;
    FMidToHiPos : Byte;
    procedure SetColorLow(const Value: TColor);
    procedure SetColorMid(const Value: TColor);
    procedure SetColorHi(const Value: TColor);
    procedure SetOrientation(const Value: TTrackBarOrientation);
    procedure SetMaxValue(const Value: Longint);
    procedure SetBackColor(const Value: TColor);
    procedure SetBarSize(const Value: Word);
//    procedure SetBarOrientation(const Value: TTrackBarOrientation);
    procedure SetPosition(const Value: Longint);
    procedure SetLowToMidPos(const Value: Byte);
    procedure SetMidToHiPos(const Value: Byte);
    { Private declarations }
  protected
    { Protected declarations }
    BarCount: Longint;
    procedure Paint; override;
    procedure CalculateBarCount;
  public
    { Public declarations }
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property ColorLow: TColor read FColorLow write SetColorLow;
    property ColorMid: TColor read FColorMid write SetColorMid;
    property ColorHi: TColor read FColorHi write SetColorHi;
    property Orientation: TTrackBarOrientation read FOrientation write SetOrientation default trVertical;
    property MaxValue: Longint read FMaxValue write SetMaxValue;
    property BackColor: TColor read FBackColor write SetBackColor;
    property BarSize: Word read FBarSize write SetBarSize;
//    property BarOrientation: TTrackBarOrientation read FBarOrientation write SetBarOrientation default trVertical;
    property Position: Longint read FPosition write SetPosition;
    property LowToMidPos: Byte read FLowToMidPos write SetLowToMidPos;
    property MidToHiPos: Byte read FMidToHiPos write SetMidToHiPos;
    property Constraints;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property Align;
    property Anchors;
    property OnClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Dobrin Dobrev', [TDDLedBar]);
end;

{ DDLedBar }

constructor TDDLedBar.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  Width := 25;
  Height := 147;
  FBackColor := clBlack;
  FColorLow := clLime;
  FColorMid := clYellow;
  FColorHi := clRed;
  FOrientation := trVertical;
  FMaxValue := 100 ;
  FBarSize := 5;
  RGB(255,0,0);
//  FBarOrientation := trVertical;
  FPosition := 0;
  FLowToMidPos := 32;
  FMidToHiPos := 16;
  CalculateBarCount;
end;

destructor TDDLedBar.Destroy;
begin
  inherited Destroy;
end;

// Draw DDLedBar
procedure TDDLedBar.Paint;
var Bar: TBitmap;
    I: Integer;
begin
  Bar := TBitmap.Create;
  Bar.Width := Width;
  Bar.Height := Height;
  Bar.Canvas.Brush.Color := FBackColor;
  Bar.Canvas.FillRect(Rect(0, 0, Width, Height));
  CalculateBarCount;
  for I := 1 to BarCount do
    begin
      if (((I*100) div BarCount) < (100-FLowToMidPos)) then Bar.Canvas.Brush.Color := FColorLow;
      if (((I*100) div BarCount) >= (100-FLowToMidPos)) and ((((I*100) div BarCount)) < (100-FMidToHiPos)) then Bar.Canvas.Brush.Color := FColorMid;
      if (((I*100) div BarCount) >= (100-FMidToHiPos)) then Bar.Canvas.Brush.Color := FColorHi;
      if (((FMaxValue > FPosition) and (((I*100) div BarCount) > ((FPosition*100) div MaxValue)))
      or ((((I*100) div BarCount) > FPosition))) or (FPosition = 0) then
        Bar.Canvas.Brush.Color := RGB(GetRValue(Bar.Canvas.Brush.Color) div 2,GetGValue(Bar.Canvas.Brush.Color)div 2,GetGValue(Bar.Canvas.Brush.Color)div 2);
      if FOrientation = trVertical then
        Bar.Canvas.FillRect(Rect(2, ((Height-2)-FBarSize*I+2), Width-2, ((Height-2)-FBarSize*I+FBarSize)))
      else
        Bar.canvas.FillRect(Rect(2+FBarSize*(I-1), 2, (2+FBarSize*(I-1))+FBarSize-2, Height-2));
    end;
   Canvas.CopyRect(Rect(0,0,Width,Height),Bar.Canvas,Rect(0,0,Width,Height));
   Bar.Free;
end;

procedure TDDLedBar.CalculateBarCount;
begin
  if (FOrientation = trVertical) then
    BarCount := (Height - 2) div (FBarSize)
  else
    BarCount := (Width - 2) div (FBarSize);
end;

procedure TDDLedBar.SetColorLow(const Value: TColor);
begin
  FColorLow := Value;
  Paint
end;

procedure TDDLedBar.SetColorMid(const Value: TColor);
begin
  FColorMid := Value;
  Paint
end;

procedure TDDLedBar.SetColorHi(const Value: TColor);
begin
  FColorHi := Value;
  Paint
end;

procedure TDDLedBar.SetBackColor(const Value: TColor);
begin
  FBackColor := Value;
  Paint;
end;

procedure TDDLedBar.SetOrientation(const Value: TTrackBarOrientation);
begin
  if FOrientation <> Value then
  begin
  FOrientation := Value;
   //Change Orientation
    if ComponentState * [csLoading, csUpdating] = [] then
      SetBounds(Left, Top, Height, Width);
  CalculateBarCount;
  Paint;
  end;
end;

procedure TDDLedBar.SetMaxValue(const Value: Longint);
begin
  if FMaxValue <> Value then
    begin
      FMaxValue := Value;
      Paint;
    end;
end;

procedure TDDLedBar.SetBarSize(const Value: Word);
begin
  if ((FOrientation = trVertical) and (Value<(Height-4)) and (Value >2))
    or ((FOrientation = trHorizontal) and (Value<(Width-4)) and (Value>2)) then
      begin
        FBarSize := Value;
        CalculateBarCount;
        Paint;
      end;
end;

//procedure SetBarOrientation(const Value: TTrackBarOrientation);

procedure TDDLedBar.SetPosition(const Value: Longint);
begin
  FPosition := Value;
  Paint;
end;

procedure TDDLedBar.SetLowToMidPos(const Value: Byte);
begin
  if (Value < 100) and (Value > FMidToHiPos) then
    begin
      FLowToMidPos := Value;
      Paint;
    end;
end;

procedure TDDLedBar.SetMidToHiPos(const Value: Byte);
begin
  if (Value <= 100) and (Value < FLowToMidPos) then
    begin
      FMidToHiPos := Value;
      Paint;
    end;
end;

end.