ddhled.pas

Delphi高级开发指南是开发程序的好帮手

unit DdhLed;

interface

{$R *.DCR}

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

type
  TDdhLedStatus = (lsOn, lsOff);

  TDDHLed = class (TGraphicControl)
  private
    fStatus: TDdhLedStatus;
    fColor: TColor;
  protected
    procedure SetStatus (Value: TDdhLedStatus);
    procedure SetColor (Value: TColor);
  public
    constructor Create (Owner: TComponent); override;
    procedure Paint; override;
  published
    property Status: TDdhLedStatus
      read fStatus write SetStatus default lsOn;
    property Color: TColor
      read fColor write SetColor default clRed;
    property Width default 20;
    property Height Default 20;
    property OnClick;
    property OnDblClick;
  end;

procedure Register;

implementation

constructor TDDHLed.Create (Owner: TComponent);
begin
  inherited Create (Owner);
  // set default values
  fColor := clRed;
  fStatus := lsOn;
  Width := 20;
  Height := 20;
end;

procedure TDDHLed.Paint;
var
  Radius, XCenter, YCenter: Integer;
begin
  // get the minimum between width
  // and height
  if Height > Width then
    Radius := Width div 2 - 2
  else
    Radius := Height div 2 - 2;
  // get the center
  XCenter := Width div 2;
  YCenter := Height div 2;
  // led border color (fixed)
  Canvas.Brush.Color := clDkGray;
  Canvas.Ellipse (
    XCenter - Radius, YCenter - Radius,
    XCenter + Radius, YCenter + Radius);
  // led surface
  if fStatus = lsOn then
  begin
    Canvas.Brush.Color := fColor;
    Radius := Radius - 3;
    Canvas.Ellipse (
      XCenter - Radius, YCenter - Radius,
      XCenter + Radius, YCenter + Radius);
  end;
end;

procedure TDDHLed.SetStatus (Value: TDdhLedStatus);
begin
  if Value <> fStatus then
  begin
    fStatus := Value;
    Invalidate;
  end;
end;

procedure TDDHLed.SetColor (Value: TColor);
begin
  if Value <> fColor then
  begin
    fColor := Value;
    Invalidate;
  end;
end;

procedure Register;
begin
  RegisterComponents ('DDHB', [TDDHLed]);
end;

end.