由于工作的关系,特开发了一个开关灯,现在拿出来给大家共享一下
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.