{ Component(s): TindLed ---> old cindy name tcyled Description: A simple led with Group feature depending on the state: ON/OFF/DISABLE * ***** BEGIN LICENSE BLOCK ***** * * Version: MPL 1.1 * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with the * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for * the specific language governing rights and limitations under the License. * * The Initial Developer of the Original Code is Mauricio * (https://sourceforge.net/projects/tcycomponents/). * * No contributors for now ... * * Alternatively, the contents of this file may be used under the terms of * either the GNU General Public License Version 2 or later (the "GPL"), or the * GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which * case the provisions of the GPL or the LGPL are applicable instead of those * above. If you wish to allow use of your version of this file only under the * terms of either the GPL or the LGPL, and not to allow others to use your * version of this file under the terms of the MPL, indicate your decision by * deleting the provisions above and replace them with the notice and other * provisions required by the LGPL or the GPL. If you do not delete the * provisions above, a recipient may use your version of this file under the * terms of any one of the MPL, the GPL or the LGPL. * * ***** END LICENSE BLOCK ***** Modified by Jurassic Pork 2013 for package Industrial of Lazarus} unit IndLed; {$mode objfpc}{$H+} interface uses Classes, Types, Controls, Graphics, indcyBaseLed, indcyTypes, indcyClasses, indcyGraphics; type TShapeType = (stRectangle, stRoundRect, stEllipse); TcyCustomLed = class(TcyBaseLed) private FLedColorOn: TColor; FLedColorOff: TColor; FLedColorDisabled: TColor; FShapeRoundRectX: Integer; FShapeRoundRectY: Integer; FShapeLedColorOn: TColor; FShapeLedColorOff: TColor; FShapeLedColorDisabled: TColor; FBevels: TcyBevels; FShapeType: TShapeType; FShapePenWidth: Word; FTransparent: boolean; procedure SetShapeLedColorOn(Value: TColor); procedure SetShapePenWidth(Value: Word); procedure SetShapeType(Value: TShapeType); procedure SetShapeRoundRectX(Value: Integer); procedure SetShapeRoundRectY(Value: Integer); procedure SetBevels(const Value: TcyBevels); procedure SetLedColorDisabled(Value: TColor); procedure SetLedColorOff(Value: TColor); procedure SetLedColorOn(Value: TColor); procedure SetTransparent(const Value: boolean); procedure SetShapeLedColorDisabled(const Value: TColor); procedure SetShapeLedColorOff(const Value: TColor); protected procedure Paint; override; function TransparentColorAtPos(Point: TPoint): boolean; override; property Transparent: boolean read FTransparent write SetTransparent default false; property LedColorOn: TColor read FLedColorOn write SetLedColorOn; property LedColorOff: TColor read FLedColorOff write SetLedColorOff; property LedColorDisabled: TColor read FLedColorDisabled write SetLedColorDisabled; property ShapeLedColorOn: TColor read FShapeLedColorOn write SetShapeLedColorOn; property ShapeLedColorOff: TColor read FShapeLedColorOff write SetShapeLedColorOff; property ShapeLedColorDisabled: TColor read FShapeLedColorDisabled write SetShapeLedColorDisabled; property ShapePenWidth: Word read FShapePenWidth write SetShapePenWidth default 1; property ShapeType: TShapeType read FShapeType write SetShapeType default stRectangle; property ShapeRoundRectX: Integer read FShapeRoundRectX write SetShapeRoundRectX default 10; property ShapeRoundRectY: Integer read FShapeRoundRectY write SetShapeRoundRectY default 10; property Bevels: TcyBevels read FBevels write SetBevels; property Height default 25; property Width default 25; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published end; TindLed = class(TcyCustomLed) private protected public published property Align; property Anchors; property Color; property Constraints; property Enabled; property Visible; property OnClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property ShowHint; // Herited from TcyBaseLed : property AllowAllOff; property GroupIndex; property LedValue; property ReadOnly; // Herited from TcyCustomLed : property Bevels; property LedColorOn; property LedColorOff; property LedColorDisabled; property ShapeLedColorOn; property ShapeLedColorOff; property ShapeLedColorDisabled; property ShapePenWidth; property ShapeType; property ShapeRoundRectX; property ShapeRoundRectY; property Transparent; end; implementation constructor TcyCustomLed.Create(AOwner: TComponent); begin inherited Create(AOwner); FBevels := TcyBevels.Create(self, TcyBevel); // Determine at design time if // the form is loading or if we have just added the component at design time : if csDesigning in ComponentState then if Owner <> nil then if not (csLoading in Owner.ComponentState) // we have just added the component at design time then begin with FBevels.Add do // Frame begin HighlightColor := clBlack; ShadowColor := clBlack; end; with FBevels.Add do // Inner 3D frame Width := 3; with FBevels.Add do // Contrast Frame Style := bcLowered; with FBevels.Add do // Border between Bevels and Shape begin HighlightColor := clBlack; ShadowColor := clBlack; Width := 1; end; end; FTransparent := false; FShapeType := stRectangle; FShapePenWidth:= 1; FShapeRoundRectX := 10; FShapeRoundRectY := 10; FShapeLedColorOn := clGreen; FShapeLedColorOff := $00004000; // Dark green FShapeLedColorDisabled := $00003468; // Dark maroon FLedColorOn:= clLime; FLedColorOff:= clGreen; FLedColorDisabled:= $000059B3; // Maroon Height := 25; Width := 25; end; destructor TcyCustomLed.Destroy; begin FBevels.Free; FBevels := Nil; inherited Destroy; end; procedure TcyCustomLed.Paint; var Rect: TRect; begin Rect := ClientRect; // Draw background : if not FTransparent then begin Canvas.Brush.Color := Color; Canvas.FillRect(Rect); end; Bevels.DrawBevels(Canvas, Rect, false); case ledStatus of lsOn: Canvas.Brush.Color := FLedColorOn; lsOff: Canvas.Brush.Color := FLedColorOff; lsDisabled: Canvas.Brush.Color := FLedColorDisabled; end; if FShapePenWidth > 0 then begin Rect := classes.Rect(Rect.Left + FShapePenWidth div 2, Rect.Top + FShapePenWidth div 2, Rect.Right - (FShapePenWidth-1) div 2, Rect.Bottom - (FShapePenWidth-1) div 2); case ledStatus of lsOn: Canvas.Pen.Color := FShapeLedColorOn; lsOff: Canvas.Pen.Color := FShapeLedColorOff; lsDisabled: Canvas.Pen.Color := FShapeLedColorDisabled; end; Canvas.Pen.Width := FShapePenWidth; end else begin Canvas.Pen.Color := Canvas.Brush.Color; Canvas.Pen.Width := 1; end; case FShapeType of stRectangle: canvas.Rectangle(Rect); stRoundRect: canvas.RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, ShapeRoundRectX, ShapeRoundRectY); stEllipse : canvas.Ellipse(Rect); end; end; function TcyCustomLed.TransparentColorAtPos(Point: TPoint): boolean; begin RESULT := false; if FTransparent and (Bevels.Count = 0) and (FShapeType = stEllipse) then RESULT := not PointInEllipse(Point, ClientRect); end; procedure TcyCustomLed.SetTransparent(const Value: boolean); begin if value <> FTransparent then begin FTransparent := Value; Invalidate; end; end; procedure TcyCustomLed.SetShapeLedColorOn(Value: TColor); begin if value <> FShapeLedColorOn then begin FShapeLedColorOn := Value; if GetLedStatus = lsOn then Invalidate; end; end; procedure TcyCustomLed.SetShapeLedColorOff(const Value: TColor); begin if value <> FShapeLedColorOff then begin FShapeLedColorOff := Value; if GetLedStatus = lsOff then Invalidate; end; end; procedure TcyCustomLed.SetShapeLedColorDisabled(const Value: TColor); begin if value <> FShapeLedColorDisabled then begin FShapeLedColorDisabled := Value; if GetLedStatus = lsDisabled then Invalidate; end; end; procedure TcyCustomLed.SetShapePenWidth(Value: Word); begin if value <> FShapePenWidth then begin FShapePenWidth := Value; Invalidate; end; end; procedure TcyCustomLed.SetShapeRoundRectX(Value: Integer); begin if Value <> FShapeRoundRectX then begin FShapeRoundRectX := value; if FShapeType = stRoundRect then Invalidate; end; end; procedure TcyCustomLed.SetShapeRoundRectY(Value: Integer); begin if Value <> FShapeRoundRectY then begin FShapeRoundRectY := value; if FShapeType = stRoundRect then Invalidate; end; end; procedure TcyCustomLed.SetShapeType(Value: TShapeType); begin if value <> FShapeType then begin FShapeType := Value; Invalidate; end; end; procedure TcyCustomLed.SetLedColorOn(Value: TColor); begin if value <> FLedColorOn then begin FLedColorOn := Value; if GetLedStatus = lsOn then Invalidate; end; end; procedure TcyCustomLed.SetLedColorOff(Value: TColor); begin if value <> FLedColorOff then begin FLedColorOff := Value; if GetLedStatus = lsOff then Invalidate; end; end; procedure TcyCustomLed.SetLedColorDisabled(Value: TColor); begin if value <> FLedColorDisabled then begin FLedColorDisabled := Value; if GetLedStatus = lsDisabled then Invalidate; end; end; procedure TcyCustomLed.SetBevels(const Value: TcyBevels); begin FBevels := Value; end; end.