Mega Code Archive
Progress LED
<![CDATA[
Title: Progress LED
Question: A nice alternative to TProgressbar
Answer:
There is a ressourcefile necessary for this component. You can download all needed files from http://wolfgang.lotz.cc/downloads/ProgressLED.zip
-----------------------------------------------------------------
unit ProgLED;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const
LEDsMax = 50;
type
TLEDSize = (lsSmall, lsMedium, lsLarge);
TLEDDirection = (ldVertical, ldHorizontal);
TLEDOrder = (loRYG, loGYR);
TLEDLabelStyle = (llsValue, llsPercent);
TProgressLED = class(TCustomControl)
private
{ Private-Deklarationen }
FLEDSize : TLEDSize;
FLEDs : Word;
FPRY,
FPYG : Byte;
FValue,
FMin,
FMax : Integer;
FDirection : TLEDDirection;
FOrder : TLEDOrder;
FColor : TColor;
FInvert : Boolean;
FLabel : TLabel;
FLabelStyle : TLEDLabelStyle;
FBWidth : Byte;
FEnabled : Boolean;
PRY,
PYG : Byte;
RotEin,
RotAus,
RotDis,
GruenEin,
GruenAus,
GruenDis,
GelbEin,
GelbAus,
GelbDis : TBitmap;
procedure LoadLEDs;
procedure CalcRanges;
function GetLED (Value : Integer) : Word;
procedure SetSize;
procedure ShowValue;
procedure SetLEDs (Count : Word);
procedure SetLEDSize (S : TLEDSize);
procedure SetPRY (Prozent : Byte);
procedure SetPYG (Prozent : Byte);
procedure SetMin (Wert : Integer);
procedure SetMax (Wert : Integer);
procedure SetValue (Wert : Integer);
procedure SetDirection (Dir : TLEDDirection);
procedure SetColor (C : TColor);
procedure SetInvert (I : Boolean);
procedure SetLabel (L : TLabel);
procedure SetLabelStyle (S : TLEDLabelStyle);
procedure SetBorderWidth (W : Byte);
procedure SetEnabled (E : Boolean);
protected
{ Protected-Deklarationen }
public
{ Public-Deklarationen }
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
procedure Paint; override;
published
{ Published-Deklarationen }
property LEDs : Word read FLEDs write SetLEDs;
property LEDSize : TLEDSize read FLEDSize write SetLEDSize;
property WrapPR2Y : Byte read FPRY write SetPRY;
property WrapPY2G : Byte read FPYG write SetPYG;
property MinValue : Integer read FMin write SetMin;
property MaxValue : Integer read FMax write SetMax;
property Value : Integer read FValue write SetValue;
property Direction : TLEDDirection read FDirection write SetDirection;
property Color : TColor read FColor write SetColor;
property Invert : Boolean read FInvert write SetInvert;
property ValueLabel : TLabel read FLabel write SetLabel;
property LabelStyle : TLEDLabelStyle read FLabelStyle write SetLabelStyle;
property BorderWidth : Byte read FBWidth write SetBorderWidth;
property Enabled : Boolean read FEnabled write SetEnabled;
end;
procedure Register;
implementation
{$R ProgLED.res}
procedure Register;
begin
RegisterComponents('GBit', [TProgressLED]);
end;
constructor TProgressLED.Create;
begin
inherited;
ControlStyle := [csSetCaption, csOpaque, csFixedWidth,
csFixedHeight, csNoStdEvents];
Color := clBlack;
FLEDSize := lsMedium;
FOrder := loRYG;
FDirection := ldHorizontal;
FLabelStyle := llsValue;
FBWidth := 1;
FEnabled := True;
RotEin := TBitmap.Create;
RotAus := TBitmap.Create;
RotDis := TBitmap.Create;
GruenEin := TBitmap.Create;
GruenAus := TBitmap.Create;
GruenDis := TBitmap.Create;
GelbEin := TBitmap.Create;
GelbAus := TBitmap.Create;
GelbDis := TBitmap.Create;
FMin := 0;
FMax := 100;
FValue := 0;
FPRY := 50;
FPYG := 75;
LoadLEDs;
LEDs := 10;
CalcRanges;
end;
destructor TProgressLED.Destroy;
begin
RotEin.Destroy;
RotAus.Destroy;
RotDis.Destroy;
GruenEin.Destroy;
GruenAus.Destroy;
GruenDis.Destroy;
GelbEin.Destroy;
GelbAus.Destroy;
GelbDis.Destroy;
inherited;
end;
procedure TProgressLED.LoadLEDs;
var
Prefix : String;
begin
case FLEDSize of
lsSmall : Prefix := 'S';
lsMedium : Prefix := 'M';
lsLarge : Prefix := 'L';
end;
RotEin.LoadFromResourceName (HInstance, Prefix + 'REin');
RotAus.LoadFromResourceName (HInstance, Prefix + 'RAus');
RotDis.LoadFromResourceName (HInstance, Prefix + 'RDis');
GruenEin.LoadFromResourceName (HInstance, Prefix + 'GEin');
GruenAus.LoadFromResourceName (HInstance, Prefix + 'GAus');
GruenDis.LoadFromResourceName (HInstance, Prefix + 'GDis');
GelbEin.LoadFromResourceName (HInstance, Prefix + 'YEin');
GelbAus.LoadFromResourceName (HInstance, Prefix + 'YAus');
GelbDis.LoadFromResourceName (HInstance, Prefix + 'YDis');
end;
procedure TProgressLED.Paint;
var
i : Word;
LED : TBitmap;
begin
with Canvas do begin
Brush.Color := Color;
for i := 0 to FBWidth-1 do
FrameRect (Rect (i, i, Width-i, Height-i));
for i := 1 to LEDs do begin
// Berechnung der Farbe
if i if GetLED (FValue) if FInvert then
if FEnabled then
LED := GruenAus
else
LED := GruenDis
else
if FEnabled then
LED := RotAus
else
LED := RotDis
else
if FInvert then
if FEnabled then
LED := GruenEin
else
LED := GruenDis
else
if FEnabled then
LED := RotEin
else
LED := RotDis
end else
if i if GetLED (FValue) if FEnabled then
LED := GelbAus
else
LED := GelbDis
else
if FEnabled then
LED := GelbEin
else
LED := GelbDis
end else begin
if GetLED (FValue) if FInvert then
if FEnabled then
LED := RotAus
else
LED := RotDis
else
if FEnabled then
LED := GruenAus
else
LED := GruenDis
else
if FInvert then
if FEnabled then
LED := RotEin
else
LED := RotDis
else
if FEnabled then
LED := GruenEin
else
LED := GruenDis
end;
case FDirection of
ldVertical :
Draw (FBWidth, FBWidth + (LEDs-i)*LED.Height, LED);
ldHorizontal :
Draw (FBWidth + (i-1)*LED.Width, FBWidth, LED);
end;
end;
end;
ShowValue;
end;
procedure TProgressLED.SetLEDs;
begin
if count = FLEDs then
exit;
if count LEDsMax then
count := LEDsMax;
if count count := 1;
FLEDs := count;
CalcRanges;
SetSize;
end;
procedure TProgressLED.SetSize;
begin
case FDirection of
ldHorizontal :
SetBounds (Left, Top, FLEDs*RotEin.Width + 2*FBWidth,
RotEin.Height + 2 * FBWidth);
ldVertical :
SetBounds (Left, Top, RotEin.Width + 2*FBWidth,
FLEDs*RotEin.Height + 2 * FBWidth);
end;
end;
procedure TProgressLED.SetPRY;
begin
if Prozent = FPRY then
exit;
if Prozent 100 then
exit;
FPRY := Prozent;
CalcRanges;
Invalidate;
end;
procedure TProgressLED.SetPYG;
begin
if Prozent = FPYG then
exit;
if Prozent 100 then
exit;
FPYG := Prozent;
CalcRanges;
Invalidate;
end;
procedure TProgressLED.SetMin;
begin
if Wert = FMin then
exit;
FMin := Wert;
if Wert = MaxValue then
MaxValue := Wert+1;
if FValue FValue := Wert;
CalcRanges;
Invalidate;
end;
procedure TProgressLED.SetMax;
begin
if Wert = FMax then
exit;
FMax := Wert;
if Wert MinValue := Wert-1;
if FValue Wert then
FValue := Wert;
CalcRanges;
Invalidate;
end;
procedure TProgressLED.SetValue;
begin
if Wert = FValue then
exit;
if (Wert MaxValue) then
exit;
FValue := Wert;
Invalidate;
end;
procedure TProgressLED.CalcRanges;
var
Range : Integer;
begin
Range := Abs (FMax - FMin);
PRY := GetLED (Round (FMin + (Range / 100 * FPRY)));
PYG := GetLED (Round (FMin + (Range / 100 * FPYG)));
end;
procedure TProgressLED.SetDirection;
begin
if Dir = FDirection then
exit;
FDirection := Dir;
SetSize;
end;
procedure TProgressLED.SetColor;
begin
if C = FColor then
exit;
FColor := C;
Refresh;
end;
function TProgressLED.GetLED;
var
Range : Integer;
begin
Range := ABS (FMax - FMin);
Value := Value - FMin;
Result := Round ((FLEDs / Range) * Value);
end;
procedure TProgressLED.SetInvert;
begin
if I = FInvert then
exit;
FInvert := I;
Invalidate;
end;
procedure TProgressLED.SetLEDSize;
begin
if S = FLEDSize then
exit;
FLEDSize := S;
LoadLEDs;
SetSize;
end;
procedure TProgressLED.SetLabel;
begin
if Assigned (FLabel) then
FLabel.Caption := '';
FLabel := L;
ShowValue;
end;
procedure TProgressLED.ShowValue;
var
Range : Integer;
Valu : Integer;
begin
Range := ABS (FMax - FMin);
Valu := FValue - FMin;
if Assigned (FLabel) then begin
case FLabelStyle of
llsValue : FLabel.Caption := IntToStr (FValue);
llsPercent : FLabel.Caption := IntToStr (Round (100/Range*Valu))+'%';
end;
end;
end;
procedure TProgressLED.SetLabelStyle;
begin
if S = FLabelStyle then
exit;
FLabelStyle := S;
ShowValue;
end;
procedure TProgressLED.SetBorderWidth;
begin
if W = FBWidth then
exit;
FBWidth := W;
SetSize;
end;
procedure TProgressLED.SetEnabled;
begin
if E = FEnabled then
exit;
FEnabled := E;
Invalidate;
end;
end.
]]>