Due to the relationship between the work, I developed a switch light. Now I will share it for everyone.
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; // save switch status published property Checked: Boolean read GetChecked write setChecked; // switch to select the property enabled: Boolean read FEnabled write FEnabled default True; // property OnColor whether the switch is enabled: TColor read FOnColor write SetOnColor default clLime; / / Switch light open color Property Offline: Tcolor Read FoffColor Write SetOffColor DEF ault clRed; // switch off the lamp color property LightRadius: integer read FLightRadius write SetLightRadius; // switch lights radius property Hint; property OnClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnMouseDown; property OnMouseMove; property OnMouseUp; property Onnter; Property OnkeyPress; Property onkeyDown; Property onkeyDown;
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 ;
Procedure tswitch.paint; var x, y: integer; Thecilor: tcolor; rect: TRECT; begin x: = (Width Div 2) - FlightRadius; Y: = (Height Div 2) - Flightradius;
IF Checked THECOLOR: = FONCOLOR ELSE TheColor: = FOFFCOLOR;
WITH CANVAS DO BEGIN RECT: = ClientRect; brush.color: = self.color; brush.style: = bssolid; FillRect (Rect); // Draw the outer shadow circle 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);
// Painted high bright round 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)))))); // Draw in the middle of the round 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);
Procedure tswitch.setChecked; begin if value the pfstate: = cbChecked else PfState: = cbunchecked;
Paint;
Procedure tswitch.click; begin if ferged dam;
Procedure tswitch.setoncolor; begin foncolor: = value; if checked kiln;
Procedure Tswitch.SetoffColor; Begin FoffColor: = Value; if not checked.
Procedure tswitch.setlightradius (value: integer); Begin if Flightradius <> value dam flightradius: = value;
Procedure Register; Begin RegisterComponents ('Standard', [TSWITCH]); END;
End.
