一個開關(燈)組件

由於工作的關係,特開發了一個開關燈,現在拿出來給大家共用一下

unit SwitchLight;

interface

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

type
  TSwitch= class(TCustomControl)
  private
    PFState: TCheckBoxState;
    FOnColor,
    FOffColor  : TColor;
    FLightRadius : integer;
    FEnabled   : Boolean;
    function GetChecked: Boolean;
    procedure SetChecked(Value: Boolean);
    procedure SetOnColor(Value: TColor);
    procedure SetOffColor(Value: TColor);
    procedure SetLightRadius(Value : integer);
  protected
    procedure Paint; override;
    procedure Click; override;
  public
    constructor Create(aOwner: TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
    property State: TCheckBoxState read PFState;                                   //儲存開關狀態
  published
    property Checked: Boolean read GetChecked write SetChecked;                    //開關選擇
    property Enabled: Boolean read FEnabled write FEnabled default True;           //是否啟用開關
    property OnColor: TColor read FOnColor write SetOnColor default clLime;        //開關燈開啟顏色
    property OffColor: TColor read FOffColor write SetOffColor default clRed;      //開關燈關閉顏色
    property LightRadius : integer read FLightRadius write SetLightRadius;         //開關燈半徑
    property Hint;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnEnter;
    property OnExit;
    property OnKeyPress;
    property OnKeyDown;
    property OnKeyUp;
  end;

procedure Register;

implementation

{$R *.DCR}

constructor TSwitch.Create;
begin
  inherited Create(aOwner);
  ControlStyle := [csCaptureMouse, csClickEvents, csDesignInteractive];
  FEnabled := True;
  FOnColor := clLime;
  FOffColor := clRed;
  FLightRadius := 5;
  Width := 20;
  Height := 20;
end;

procedure TSwitch.CreateParams(var Params: TCreateParams);
begin
  { call the create of the params }
  inherited CreateParams(Params);
  { and then add our twist, transparency }
  Params.ExStyle := Params.ExStyle + WS_EX_Transparent;
end;

procedure TSwitch.Paint;
var
   X,
   Y        : Integer;
   TheColor : TColor;
   Rect : TRect;
begin
  X := (Width div 2) - FLightRadius;
  Y := (Height div 2) - FLightRadius;

  if Checked then
    TheColor := FOnColor
  else
    TheColor := FOffColor;

  with Canvas do
  begin
    Rect := ClientRect;
    Brush.Color := Self.Color;
    Brush.Style := bsSolid;
    FillRect(Rect);
   
    //畫外面的陰影圓
    Pen.Color := clBtnHighLight;
    Arc(X - 1,
        Y - 1,
        X + 2 * FLightRadius,
        Y + 2 * FLightRadius,
        X + FLightRadius div 2,
        Y + FLightRadius * 4 div 3,
        X + FLightRadius * 4 div 3,
        Y + FLightRadius div 2);

    //畫外面的高亮圓
    Pen.Color := clBtnShadow;
    Arc(X,
        Y,
        X + 1 + 2 * FLightRadius,
        Y + 1 + 2 * FLightRadius,
        X + integer(FLightRadius * 4 div 3),
        Y + FLightRadius div 2,
        X + FLightRadius div 2,
        Y + integer(FLightRadius * 4 div 3));
    //畫中間的圓
    Brush.Color := TheColor;
    Ellipse(X, Y, X - 2 + 2 * FLightRadius, Y - 1 + 2 * FLightRadius);
    Pixels[X + 2, Y - 1 + FLightRadius] := clBtnHighLight;
    Pixels[X + 2, Y - 2 + FLightRadius] := clBtnHighLight;
    Pixels[X + 3, Y - 1 + FLightRadius] := clBtnHighLight;
  end;
end;

function TSwitch.GetChecked;
begin
  Result := not(State = cbUnChecked);
end;

procedure TSwitch.SetChecked;
begin
  if Value then
    PFState := cbChecked
  else
    PFState := cbUnChecked;

  Paint;
end;

procedure TSwitch.Click;
begin
  if FEnabled then Checked := not Checked;
end;

procedure TSwitch.SetOnColor;
begin
  FOnColor := Value;
  if Checked then
    Paint;
end;

procedure TSwitch.SetOffColor;
begin
  FOffColor := Value;
  if not Checked then
    Paint;
end;

procedure TSwitch.SetLightRadius(Value : integer);
begin
  if FLightRadius <> Value then
  begin
    FLightRadius := Value;
    Paint;
  end;
end;

procedure Register;
begin
  RegisterComponents('Standard', [TSwitch]);
end;

end.