lazarus-ccr/components/jvcllaz/run/JvJans/jvjanled.pas

unit JvJanLED;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons;

type
  TLedColor = (lcRed, lcGreen, lcYellow, lcBlue, lcPurple);

  TJvJanLed = class(TGraphicControl)
  private
    { Private declarations }
    FLit: boolean;
    FLedColor: TLedColor;
    procedure SetLit(const AValue: boolean);
    procedure SetLedColor(const AValue: TLedColor);
    {
    procedure KeepSize(Sender: TObject; var ANewWidth, ANewHeight: Integer;
      var AResize: Boolean); }

  protected
    { Protected declarations }
    procedure Paint; override;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    { Published declarations }
    property Lit: boolean read FLit write SetLit default false;
    property LedColor: TLedColor read FLedColor write SetLedColor default lcRed;
  end;


implementation


{ TJvJanLed }

constructor TJvJanLed.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  Width := 12;
  Height := 13;
  FLit := false;
  FLedColor := lcRed;
  {OnCanResize := @KeepSize;}
end;

destructor TJvJanLed.Destroy;
begin
 //mycode
  inherited Destroy;
end;

procedure TJvJanLed.Paint;
var
  surfCol, litCol: TColor;
begin
  if Flit then begin
    case FLedColor of
      lcRed: begin surfCol := clRed; litCol := clWhite; end;
      lcGreen: begin surfCol := clLime; litCol := clWhite; end;
      lcYellow: begin surfCol := clYellow; litCol := clWhite; end;
      lcBlue: begin surfCol := clAqua; litCol := clWhite; end;
      lcPurple: begin surfCol:= clFuchsia; litCol := clWhite; end;
    end;
  end
  else begin
    case FLedColor of
      lcRed: begin surfCol := clMaroon; litCol := clred; end;
      lcGreen: begin surfCol := clGreen; litCol := clLime; end;
      lcYellow: begin surfCol := clOlive; litCol := clYellow; end;
      lcBlue: begin surfCol := clNavy; litCol := clAqua; end;
      lcPurple: begin surfCol := clPurple; litCol := clFuchsia; end;
    end;
  end;
  with Canvas do begin
    Brush.Color := clsilver;
    FillRect(0, 0, 12, 13);
    Brush.Style := bsClear;
    Pen.Color := clGray;
    Ellipse(0, 0, 12, 13);
    Pen.Color := clBlack;
    Brush.Color := surfCol;
    Ellipse(1, 1, 11, 12);
    Pen.Color := clWhite;
    Arc(1, 1, 11, 12, 0, 12, 12, 0);
    Pen.Color := litCol;
    Arc(3, 3, 8, 9, 5, 0, 0, 8);
  end;
end;
                           {
procedure TJvJanLed.KeepSize(Sender: TObject; var ANewWidth, ANewHeight: Integer;
  var AResize: Boolean);
begin
  AResize := True;
  ANewWidth := Width;
  ANewHeight := Height;
end;                        }

procedure TJvJanLed.SetLit(const AValue: boolean);
begin
  if AValue <> FLit then begin
    FLit := AValue;
    Refresh;
  end;
end;

procedure TJvJanLed.SetLedColor(const AValue: TLedColor);
begin
  if AValue <> FLedColor then begin
    FLedColor := AValue;
    Refresh;
  end;
end;

end.