Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/roudled/roundled.pas

Pascal/Delphi Source File | 1995-12-22 | 6.4 KB | 216 lines

{---------------------------------------------------------------}
{             TRoundLed component copyright 1995                       }
{                Martyn Dowsett CIS 100676,1560                   }
{    Please feel free to use this component as you see fit.       }
{    This is my first contribution to Compuserve and hope         }
{    that you will be able to make some use of this component.    }
{    I would appreciate some feedback, positive or negative.      }
{                                                               }
{    NOTE: Please see roundled.txt for other information.         }
{---------------------------------------------------------------}


unit RoundLed;
{$R ROUNDLED.RES}
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls;

type
    TLedStatus    = (lsOff, lsOn, lsBlink);

    TLedOnColors  = (lcSilver, lcRed,    lcLime, lcYellow,
                     lcBlue,   lcFuchsia, lcAqua, lcWhite);

    TLedOffColors = (lcBlack, lcMaroon, lcGreen, lcOlive,
                     lcNavy,  lcPurple, lcTeal, lcGray);

    TActualColors = array[0..7] of TColor;

const
    ActualOnColors: TActualColors = (clSilver, clRed, clLime, clYellow,
                                     clBlue, clFuchsia, clAqua, clWhite);

    ActualOffColors: TActualColors = (clBlack, clMaroon, clGreen, clOlive,
                                      clNavy, clPurple, clTeal, clGray);
type
  TRoundLed = class(TCustomControl)
  private
     { Private declarations }
     FLedPiccy: TBitmap;
     FLedTimer: TTimer;
     FLedIsOn: boolean;
     FLedRect: TRect;
     FLedBulbRect: TRect;

     FAutoSelectColor: boolean;
     FLedOnColor: TLedOnColors;
     FLedOffColor: TLedOffColors;
     FBlinkRate: word;
     FLedStatus: TLedStatus;
     procedure SetLedOffColor(value: TLedOffColors);
     procedure SetLedOnColor(value: TLedOnColors);
     procedure SetLedStatus(value: TLedStatus);
     procedure SetBlinkRate(value: word);

  protected
     { Protected declarations }
     procedure Paint; override;
     procedure WMSize(var Message: TWMSize); message WM_SIZE;
     procedure BlinkTimeLimit(Sender: TObject);
  public
     { Public declarations }
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
  published
     { Published declarations }
     property AutoSelectColor: boolean read FAutoSelectColor write FAutoSelectColor default True;
     property LedOnColor: TLedOnColors read FLedOnColor write SetLedOnColor default lcRed;
     property LedOffColor: TLedOffColors read FLedOffColor write SetLedOffColor default lcMaroon;
     property BlinkRate: word read FBlinkRate write SetBlinkRate default 1000;
     property LedStatus: TLedStatus read FLedStatus write SetLedStatus default lsOff;
  end;

procedure Register;

implementation
{------------------------------------------------------------------------------}
constructor TRoundLed.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FLedPiccy := TBitmap.Create;
    FLedPiccy.Handle := LoadBitmap(hInstance, 'GENERICLED');
    with FLedRect do
    begin
        Top := 0;
        Left := 0;
        Right := FLedPiccy.Width;
        Bottom := FLedPiccy.Height;
    end;
    {This TRect stores dimensions for 'filament' of LED}
    with FLedBulbRect do
    begin
        Top := 5;
        Left := 5;
        Right := 10;
        Bottom := 10;
    end;
    {Set defaults}
    FAutoSelectColor := True;
    FBlinkRate :=1000;
    Width := FLedPiccy.Width;
    FLedOffColor := lcMaroon;
    FLedOnColor := lcRed;
    FLedStatus := lsOff;
    FLedIsOn := false;
    Height := FLedPiccy.Height;
end;
{------------------------------------------------------------------------------}
destructor TRoundLed.Destroy;
begin
    FLedPiccy.Free;
    if assigned(FLedTimer) then FLedTimer.Free;
    inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TRoundLed.Paint;
begin
    Canvas.Brush.Color := (Parent as TForm).Color;
    Canvas.BrushCopy(FLedRect,FLedPiccy, FLedRect, clOlive);
    with Canvas do
    begin
    {Draw colored section of led}
        if FLedIsOn then
            Brush.Color := ActualOnColors[ord(FLedOnColor)]
        else
            Brush.Color := ActualOffColors[ord(FLedOffColor)];

        BrushCopy(FLedBulbRect,FLedPiccy, FLedBulbRect, clMaroon);
    end;
end;
{------------------------------------------------------------------------------}
procedure TRoundLed.WMSize(var Message: TWMSize);
begin
    {Keep control the same size as the LED bitmap}
    inherited;
    Width := FLedPiccy.Width;
    Height := FLedPiccy.Height;
end;
{------------------------------------------------------------------------------}
procedure TRoundLed.SetLedOffColor(value: TLedOffColors);
begin
    FLedOffColor := value;
    if FAutoSelectColor then
        FLedOnColor := TLedOnColors(FLedOffColor);
    Invalidate;
end;
{------------------------------------------------------------------------------}
procedure TRoundLed.SetLedOnColor(value: TLedOnColors);
begin
    FLedOnColor := value;
    if FAutoSelectColor then
        FLedOffColor:= TLedOffColors(FLedOnColor);
    Invalidate;
end;
{------------------------------------------------------------------------------}
procedure TRoundLed.SetLedStatus(value: TLedStatus);
begin
    if value <> FLedStatus then
    begin
        if assigned(FLedTimer) then
        begin
            FLedTimer.Free;
            FLedTimer := nil;
        end;
        FLedStatus := value;
        case FLedStatus of
            lsOff:
                FLedIsOn := false;
            lsOn:
                FLedIsOn := true;
            lsBlink:
                begin
                    FLedTimer := TTimer.Create(Self);
                    FLedTimer.Interval := FBlinkRate;
                    FLedTimer.OnTimer := BlinkTimeLimit;
                end;
        end;
        Invalidate;
    end;
end;
{------------------------------------------------------------------------------}
procedure TRoundLed.BlinkTimeLimit(Sender: TObject);
begin
    {This routine is called when the BlinkTime counter has been reached}
    FLedIsOn := not FLedIsOn;
    with Self.Canvas do
    begin
    {Draw colored section of led}
        if FLedIsOn then
            Brush.Color := ActualOnColors[ord(FLedOnColor)]
        else
            Brush.Color := ActualOffColors[ord(FLedOffColor)];

{        Brush.Color := FColorToUse;}
        BrushCopy(FLedBulbRect,FLedPiccy, FLedBulbRect, clMaroon);
    end;
end;
{------------------------------------------------------------------------------}
procedure TRoundLed.SetBlinkRate(value: word);
begin
    if value <> FBlinkRate then
    begin
        FBlinkRate := value;
        if assigned(FLedTimer) then FLedTimer.Interval := FBlinkRate;
    end;
end;
{------------------------------------------------------------------------------}
procedure Register;
begin
  RegisterComponents('SimComponents', [TRoundLed]);
end;

end.