{**************************************************** This file is part of the Eye Candy Controls (EC-C) Copyright (C) 2013 Vojtěch Čihák, Czech Republic This library is free software. See the file COPYING.LGPL.txt, included in this distribution, for details about the license. ****************************************************} unit ECSwitch; {$mode objfpc}{$H+} //{$DEFINE DBGSWITCH} {don't remove, just comment} interface uses Classes, SysUtils, Controls, StdCtrls, Graphics, Math, ActnList, Forms, Menus, LCLIntf, LMessages, LCLProc, LResources, LCLType, Themes, Types, ECTypes; type {$PACKENUM 2} TGlyphStyle = (egsNone, egsOneZero, egsCircles, egsPlusMinus, egsDot); { TECSwitchKnob } TECSwitchKnob = class(TECCustomKnob) published property BevelWidth; property Color; property Style; property TickMarkCount; property TickMarkDesign; property TickMarkSpacing; property TickMarkStyle; end; TCustomECSwitch = class; { TECSwitchActionLink } TECSwitchActionLink = class(TWinControlActionLink) protected FClientSwitch: TCustomECSwitch; procedure AssignClient(AClient: TObject); override; procedure SetChecked(Value: Boolean); override; public function IsCheckedLinked: Boolean; override; end; TECSwitchActionLinkClass = class of TECSwitchActionLink; { TCustomECSwitch } TCustomECSwitch = class(TECBaseControl) private FAllowGrayed: Boolean; FCaptionPos: TObjectPos; FCheckFromAction: Boolean; FGlyphStyle: TGlyphStyle; FGrooveCheckedClr: TColor; FGrooveIndent: SmallInt; FGrooveUncheckedClr: TColor; FKnob: TECSwitchKnob; FKnobHovered: Boolean; FKnobIndent: SmallInt; FOnChange: TNotifyEvent; FState: TCheckBoxState; FSwitchColor: TColor; FSwitchHeight: Integer; FSwitchWidth: Integer; function GetChecked: Boolean; procedure SetCaptionPos(AValue: TObjectPos); procedure SetChecked(AValue: Boolean); procedure SetGlyphStyle(AValue: TGlyphStyle); procedure SetGrooveCheckedClr(AValue: TColor); procedure SetGrooveIndent(AValue: SmallInt); procedure SetGrooveUncheckedClr(AValue: TColor); procedure SetKnobHovered(AValue: Boolean); procedure SetKnobIndent(AValue: SmallInt); procedure SetState(AValue: TCheckBoxState); procedure SetSwitchColor(AValue: TColor); procedure SetSwitchHeight(AValue: Integer); procedure SetSwitchWidth(AValue: Integer); protected const caClrGlyph: array[False..True] of TColor = ($D8D8D8, $F4F4F4); cDefGlyphStyle = egsOneZero; cDefGrooveIndent = 7; cDefKnobIndent = 4; cDefSwitchHeight = 28; cDefSwitchWidth = 64; cIndent = 5; protected CaptionPoint, GlyphOnePoint, GlyphZeroPoint, SwitchPoint: TPoint; GlyphSize: SmallInt; {0 - No glyph; 4 - Small glyph; 8 - Normal glyph } InitMouseCoord: Integer; KnobCaptured: Boolean; KnobMouseDown: Boolean; KnobPosUnchecked, KnobPosChecked, KnobPosGrayed: Integer; NeedCalculate: Boolean; class var GlyphFullCircle8, GlyphZero8, GlyphDot4, GlyphZero4: TPortableNetworkGraphic; class constructor LoadGlyph; class destructor FreeGlyph; protected procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer; {%H-}WithThemeSpace: Boolean); override; procedure Calculate; procedure CMBiDiModeChanged({%H-}var Message: TLMessage); message CM_BIDIMODECHANGED; procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED; procedure CMParentColorChanged({%H-}var Message: TLMessage); message CM_PARENTCOLORCHANGED; function DialogChar(var Message: TLMKey): Boolean; override; procedure DoClick; procedure DoEnter; override; procedure DoExit; override; function GetActionLinkClass: TControlActionLinkClass; override; procedure InvalidateCustomRect({%H-}AMove: Boolean); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseLeave; override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure OrientationChanged(AValue: TObjectOrientation); override; procedure Paint; override; procedure RecalcInvalidate; procedure RecalcRedraw; override; procedure Redraw3DColorAreas; override; procedure ResizeKnob; procedure SetAutoSize(Value: Boolean); override; procedure SetKnobBackground; procedure StyleChanged(AValue: TObjectStyle); override; procedure TextChanged; override; procedure WMSize(var Message: TLMSize); message LM_SIZE; property CheckFromAction: Boolean read FCheckFromAction write FCheckFromAction; property KnobHovered: Boolean read FKnobHovered write SetKnobHovered; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure BeginUpdate; override; procedure EndUpdate(Recalculate: Boolean = True); override; procedure Redraw; override; property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False; property CaptionPos: TObjectPos read FCaptionPos write SetCaptionPos default eopRight; property Checked: Boolean read GetChecked write SetChecked default False; property GlyphStyle: TGlyphStyle read FGlyphStyle write SetGlyphStyle default cDefGlyphStyle; property GrooveCheckedClr: TColor read FGrooveCheckedClr write SetGrooveCheckedClr default clDefault; property GrooveUncheckedClr: TColor read FGrooveUncheckedClr write SetGrooveUncheckedClr default clDefault; property GrooveIndent: SmallInt read FGrooveIndent write SetGrooveIndent default cDefGrooveIndent; property Knob: TECSwitchKnob read FKnob write FKnob; property KnobIndent: SmallInt read FKnobIndent write SetKnobIndent default cDefKnobIndent; property State: TCheckBoxState read FState write SetState default cbUnchecked; property SwitchColor: TColor read FSwitchColor write SetSwitchColor default clDefault; property SwitchHeight: Integer read FSwitchHeight write SetSwitchHeight default cDefSwitchHeight; property SwitchWidth: Integer read FSwitchWidth write SetSwitchWidth default cDefSwitchWidth; property OnChange: TNotifyEvent read FOnChange write FOnChange; end; { TECSwitch } TECSwitch = class(TCustomECSwitch) published property Action; property Align; property AllowGrayed; property Anchors; property AutoSize default True; property BevelInner; property BevelOuter; property BevelSpace; property BevelWidth; property BiDiMode; property BorderSpacing; property Caption; property CaptionPos; property Checked; {property Color;} { not needed } property Color3DDark; property Color3DLight; property Constraints; property Cursor; property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property GlyphStyle; property GrooveCheckedClr; property GrooveIndent; property GrooveUncheckedClr; property Height; property HelpContext; property HelpKeyword; property HelpType; property Hint; property Knob; property KnobIndent; property Left; property Name; property Orientation default eooHorizontal; property ParentBiDiMode; {property ParentColor;} { not needed } property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property State; property Style default eosButton; property SwitchColor; property SwitchHeight; property SwitchWidth; property TabOrder; property TabStop default True; property Tag; property Top; property Visible; property Width; property OnChangeBounds; property OnChange; property OnClick; property OnContextPopup; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnResize; property OnStartDrag; property OnUTF8KeyPress; end; procedure Register; implementation { TECSwitchActionLink } procedure TECSwitchActionLink.AssignClient(AClient: TObject); begin inherited AssignClient(AClient); FClientSwitch := AClient as TCustomECSwitch; end; function TECSwitchActionLink.IsCheckedLinked: Boolean; begin Result := inherited IsCheckedLinked and (FClientSwitch.Checked = (Action as TCustomAction).Checked); end; procedure TECSwitchActionLink.SetChecked(Value: Boolean); begin if IsCheckedLinked then begin FClientSwitch.CheckFromAction := True; try FClientSwitch.Checked := Value; finally FClientSwitch.CheckFromAction := False; end; end; end; { TCustomECSwitch } constructor TCustomECSwitch.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle - csMultiClicks - [csClickEvents, csNoStdEvents]; { inherited Click not used } FAllowGrayed := False; FCaptionPos := eopRight; FGlyphStyle := egsOneZero; FGrooveCheckedClr := clDefault; FGrooveIndent := cDefGrooveIndent; FGrooveUncheckedClr := clDefault; FKnob := TECSwitchKnob.Create(self); FKnobIndent := cDefKnobIndent; FSwitchColor := clDefault; FSwitchHeight := cDefSwitchHeight; FSwitchWidth := cDefSwitchWidth; ResizeKnob; AutoSize := True; TabStop := True; end; destructor TCustomECSwitch.Destroy; begin FreeAndNil(FKnob); inherited Destroy; end; class constructor TCustomECSwitch.LoadGlyph; begin {$I ecswitch.lrs} GlyphFullCircle8 := TPortableNetworkGraphic.Create; GlyphFullCircle8.LoadFromLazarusResource('fullcircle8'); GlyphZero8 := TPortableNetworkGraphic.Create; GlyphZero8.LoadFromLazarusResource('zero8'); GlyphDot4 := TPortableNetworkGraphic.Create; GlyphDot4.LoadFromLazarusResource('fullcircle4'); GlyphZero4 := TPortableNetworkGraphic.Create; GlyphZero4.LoadFromLazarusResource('zero4'); end; class destructor TCustomECSwitch.FreeGlyph; begin FreeAndNil(GlyphFullCircle8); FreeAndNil(GlyphZero8); FreeAndNil(GlyphDot4); FreeAndNil(GlyphZero4); end; procedure TCustomECSwitch.CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer; WithThemeSpace: Boolean); var aCaption: string; aTextSize: TSize; begin aCaption := Caption; if aCaption <> '' then begin DeleteAmpersands(aCaption); aTextSize := Canvas.TextExtent(aCaption); if CaptionPos in [eopRight, eopLeft] then begin PreferredWidth := SwitchWidth + cIndent + aTextSize.cx; PreferredHeight := max(SwitchHeight, aTextSize.cy); end else begin PreferredHeight := aTextSize.cy + cIndent + SwitchHeight; PreferredWidth := max(SwitchWidth, aTextSize.cx); end; end else begin PreferredWidth := SwitchWidth; PreferredHeight := SwitchHeight; end; end; procedure TCustomECSwitch.BeginUpdate; begin inherited BeginUpdate; FKnob.BeginUpdate; end; procedure TCustomECSwitch.Calculate; var aHelp, aMax, aUnchecked, aChecked: Integer; aRealCaptionPos: TObjectPos; aCaption: string; aTextSize: TSize; bRightToLeft: Boolean; begin {$IFDEF DBGSWITCH} DebugLn('TCustomECSwitch.Calculate'); {$ENDIF} aRealCaptionPos := CaptionPos; bRightToLeft := IsRightToLeft; if bRightToLeft then case aRealCaptionPos of eopRight: aRealCaptionPos := eopLeft; eopLeft: aRealCaptionPos := eopRight; end; aCaption := Caption; if aCaption <> '' then begin DeleteAmpersands(aCaption); aTextSize := Canvas.TextExtent(aCaption); if aRealCaptionPos in [eopRight, eopLeft] then begin CaptionPoint.Y := (Height - aTextSize.cy) div 2; SwitchPoint.Y := (Height - SwitchHeight) div 2; end else begin aMax := Width - max(aTextSize.cx, SwitchWidth); aHelp := (aTextSize.cx - SwitchWidth) div 2; if bRightToLeft then begin if aHelp < 0 then begin CaptionPoint.X := aMax - aHelp; SwitchPoint.X := aMax; end else begin CaptionPoint.X := aMax; SwitchPoint.X := aMax + aHelp; end; end else begin if aHelp < 0 then begin CaptionPoint.X := -aHelp; SwitchPoint.X := 0; end else begin CaptionPoint.X := 0; SwitchPoint.X := aHelp; end; end; aHelp := aTextSize.cy + cIndent; end; case aRealCaptionPos of eopTop: begin if AutoSize then begin CaptionPoint.Y := 0; SwitchPoint.Y := Height - SwitchHeight; end else begin CaptionPoint.Y := (Height - aHelp - SwitchHeight) div 2; SwitchPoint.Y := CaptionPoint.Y + aHelp; end; end; eopRight: begin if AutoSize then begin CaptionPoint.X := Width - aTextSize.cx; SwitchPoint.X := 0; end else if bRightToLeft then begin CaptionPoint.X := Width - aTextSize.cx; SwitchPoint.X := CaptionPoint.X - cIndent - SwitchWidth; end else begin CaptionPoint.X := SwitchWidth + cIndent; SwitchPoint.X := 0; end; end; eopBottom: begin if AutoSize then begin CaptionPoint.Y := Height - aTextSize.cy - 1; { -1 'cause of underlined chars } SwitchPoint.Y := 0; end else begin SwitchPoint.Y := (Height - aHelp - SwitchHeight) div 2; CaptionPoint.Y := SwitchPoint.Y + SwitchHeight + cIndent; end; end; eopLeft: begin if AutoSize then begin CaptionPoint.X := 0; SwitchPoint.X := Width - SwitchWidth; end else if bRightToLeft then begin SwitchPoint.X := Width - SwitchWidth; CaptionPoint.X := SwitchPoint.X - cIndent - aTextSize.cx; end else begin CaptionPoint.X := 0; SwitchPoint.X := cIndent + aTextSize.cx; end; end; end; end else begin if bRightToLeft then SwitchPoint.X := Width - SwitchWidth else SwitchPoint.X := 0; SwitchPoint.Y := (Height - SwitchHeight) div 2; end; GlyphSize := 0; if Orientation = eooHorizontal then begin aUnchecked := SwitchPoint.X + KnobIndent; aChecked := SwitchPoint.X + SwitchWidth - KnobIndent - Knob.Width; Knob.Top := SwitchPoint.Y + (SwitchHeight - Knob.Height) div 2; aMax := SwitchHeight - 2*FGrooveIndent; if ((aMax > 12) and (SwitchWidth >= 48)) then GlyphSize := 8 else if ((aMax > 6) and (SwitchWidth >= 42)) then GlyphSize := 4; if GlyphSize > 0 then begin GlyphOnePoint.X := (SwitchPoint.X + FGrooveIndent + aChecked - GlyphSize) div 2; GlyphZeroPoint.X := (SwitchPoint.X + SwitchWidth - FGrooveIndent + aUnchecked + Knob.Width - GlyphSize) div 2; GlyphOnePoint.Y := (SwitchPoint.Y + SwitchPoint.Y + SwitchHeight - GlyphSize) div 2; GlyphZeroPoint.Y := GlyphOnePoint.Y; end; if bRightToLeft then begin aHelp := aUnchecked; aUnchecked := aChecked; aChecked := aHelp; aHelp := GlyphZeroPoint.X; GlyphZeroPoint.X := GlyphOnePoint.X; GlyphOnePoint.X := aHelp; end; end else begin aUnchecked := SwitchPoint.Y + SwitchHeight - KnobIndent - Knob.Height; aChecked := SwitchPoint.Y + KnobIndent; Knob.Left := SwitchPoint.X + (SwitchWidth - Knob.Width) div 2; aMax := SwitchWidth - 2*FGrooveIndent; if ((aMax > 12) and (SwitchHeight >= 48)) then GlyphSize := 8 else if ((aMax > 6) and (SwitchHeight >= 42)) then GlyphSize := 4; if GlyphSize > 0 then begin GlyphOnePoint.X := (2*SwitchPoint.X + SwitchWidth - GlyphSize) div 2; GlyphZeroPoint.X := GlyphOnePoint.X; GlyphOnePoint.Y := (SwitchPoint.Y + SwitchHeight - FGrooveIndent + aChecked + Knob.Height - GlyphSize) div 2; GlyphZeroPoint.Y := (SwitchPoint.Y + FGrooveIndent + aUnchecked - GlyphSize) div 2; end; end; KnobPosUnchecked := aUnchecked; KnobPosChecked := aChecked; KnobPosGrayed := (aUnchecked + aChecked) div 2; NeedCalculate := False; end; procedure TCustomECSwitch.CMBiDiModeChanged(var Message: TLMessage); begin RecalcInvalidate; end; procedure TCustomECSwitch.CMEnabledChanged(var Message: TLMessage); begin if IsEnabled then FKnobHovered:=False; inherited CMEnabledChanged(Message); end; procedure TCustomECSwitch.CMParentColorChanged(var Message: TLMessage); begin {$IFDEF DBGSWITCH} DebugLn('TCustomECSwitch.CMParentColorChanged'); {$ENDIF} inherited CMParentColorChanged(Message); if assigned(FKnob) and (SwitchColor = clDefault) then SetKnobBackground; end; function TCustomECSwitch.DialogChar(var Message: TLMKey): Boolean; begin Result:=False;; if Message.Msg=LM_SYSCHAR then begin if IsEnabled and IsVisible then begin if IsAccel(Message.CharCode, Caption) then begin DoClick; SetFocus; Result := True; end else Result := inherited DialogChar(Message); end; end; end; procedure TCustomECSwitch.DoClick; begin if AllowGrayed then begin case FState of cbUnchecked: State := cbGrayed; cbGrayed: State := cbChecked; cbChecked: State := cbUnchecked; end; end else Checked := not Checked; end; procedure TCustomECSwitch.DoEnter; begin inherited DoEnter; Invalidate; end; procedure TCustomECSwitch.DoExit; begin inherited DoExit; Invalidate; end; procedure TCustomECSwitch.EndUpdate(Recalculate: Boolean = True); begin FKnob.EndUpdate; inherited EndUpdate(Recalculate); end; function TCustomECSwitch.GetActionLinkClass: TControlActionLinkClass; begin Result := TECSwitchActionLink; end; procedure TCustomECSwitch.InvalidateCustomRect(AMove: Boolean); begin Invalidate; end; procedure TCustomECSwitch.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if (Key in [VK_RETURN, VK_SPACE]) and (Shift*[ssCtrl, ssAlt, ssShift] = []) then DoClick; end; procedure TCustomECSwitch.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if (Button = mbLeft) and KnobHovered then KnobMouseDown := True; SetFocus; end; procedure TCustomECSwitch.MouseLeave; begin inherited MouseLeave; KnobHovered := False; end; procedure TCustomECSwitch.MouseMove(Shift: TShiftState; X, Y: Integer); var aLeft, aTop: Integer; begin inherited MouseMove(Shift, X, Y); if KnobCaptured then begin if Orientation = eooHorizontal then begin if IsRightToLeft then aLeft := EnsureRange(InitMouseCoord + X, KnobPosChecked, KnobPosUnchecked) else aLeft := EnsureRange(InitMouseCoord + X, KnobPosUnchecked, KnobPosChecked); if Knob.Left <> aLeft then begin Knob.Left := aLeft; Invalidate; end; end else begin aTop := EnsureRange(InitMouseCoord + Y, KnobPosChecked, KnobPosUnchecked); if Knob.Top <> aTop then begin Knob.Top := aTop; Invalidate; end; end; end else begin if KnobMouseDown then begin KnobCaptured := True; if Orientation = eooHorizontal then InitMouseCoord := Knob.Left - X else InitMouseCoord := Knob.Top - Y; end else begin aLeft := Knob.Left; aTop := Knob.Top; KnobHovered := ((aLeft <= X) and (aTop <= Y) and (X < (aLeft + Knob.Width)) and (Y < (aTop + Knob.Height))); end; end; end; procedure TCustomECSwitch.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var aHelp, aPosition: Integer; aState: TCheckBoxState; b: Boolean; begin inherited MouseUp(Button, Shift, X, Y); if Button = mbLeft then begin if KnobCaptured then begin if Orientation = eooHorizontal then begin if AllowGrayed then begin aHelp := Math.Min(KnobPosUnchecked, KnobPosChecked); aPosition := (aHelp + 2*(KnobPosGrayed - aHelp) div 3); if aPosition > Knob.Left then aState := cbUnchecked else begin aHelp := Math.Max(KnobPosUnchecked, KnobPosChecked); aPosition := (KnobPosGrayed + (aHelp - KnobPosGrayed) div 3); if aPosition > Knob.Left then aState := cbGrayed else aState := cbChecked; end; if IsRightToLeft then case aState of cbUnchecked: aState := cbChecked; cbChecked: aState := cbUnchecked; end; State := aState; end else begin b := ((KnobPosUnchecked + KnobPosChecked) < 2*Knob.Left); if IsRightToLeft then b := not b; Checked := b; end; end else begin if AllowGrayed then begin aPosition := (KnobPosGrayed + (KnobPosUnchecked - KnobPosGrayed) div 3); if aPosition < Knob.Top then State := cbUnchecked else begin aPosition := (KnobPosChecked + 2*(KnobPosGrayed - KnobPosChecked) div 3); if aPosition < Knob.Top then State := cbGrayed else State := cbChecked; end; end else Checked := ((KnobPosUnchecked + KnobPosChecked) > 2*Knob.Top); end; { Knob remains hovered when mouse is over Switch but out of Knob; does not matter } if not PtInRect(ClientRect, Point(X, Y)) then FKnobHovered := False; Invalidate; KnobCaptured := False; end else if PtInRect(ClientRect, Point(X, Y)) then DoClick; KnobMouseDown := False; end; end; procedure TCustomECSwitch.OrientationChanged(AValue: TObjectOrientation); var aHelp: Integer; begin if not (csLoading in ComponentState) then begin aHelp := SwitchHeight; FSwitchHeight := SwitchWidth; SwitchWidth := aHelp; if aHelp = SwitchHeight then ResizeKnob; { when Switch is square } NeedCalculate := True; end; inherited OrientationChanged(AValue); end; procedure TCustomECSwitch.Paint; var aColor, aColor2: TColor; bEnabled: Boolean; aRect: TRect; x, y: Integer; begin {$IFDEF DBGSWITCH} DebugLn('TCustomECSwitch.Paint'); {$ENDIF} inherited Paint; if NeedCalculate then Calculate; bEnabled := IsEnabled; { Paint Switch Body } x := SwitchPoint.X; y := SwitchPoint.Y; aRect:=Rect(x, y, x + SwitchWidth, y + SwitchHeight); aColor := GetColorResolvingDefault(SwitchColor, Parent.Brush.Color); case Style of eosButton: Canvas.DrawButtonBackground(aRect, bEnabled); eosPanel: Canvas.DrawPanelBackGround(aRect, BevelInner, BevelOuter, BevelSpace, BevelWidth, Color3DDark, Color3DLight, aColor); end; { Paint Groove } InflateRect(aRect, -GrooveIndent, -GrooveIndent); Canvas.Frame3D(aRect, GetColorResolvingDefault(Color3DDark, clBtnShadow), GetColorResolvingDefault(Color3DLight, clBtnHilight), 1); if not KnobCaptured or AllowGrayed then case State of cbUnchecked: aColor := GetColorResolvingDefault(GrooveUncheckedClr, cl3DDkShadow); cbChecked: aColor := GetColorResolvingDefault(GrooveCheckedClr, clActiveCaption); end else begin aColor := GetColorResolvingDefault(GrooveCheckedClr, clActiveCaption); aColor2 := GetColorResolvingDefault(GrooveUncheckedClr, cl3DDkShadow); if Orientation = eooHorizontal then aColor := GetMergedColor(aColor, aColor2, (Knob.Left - KnobPosUnchecked)/(KnobPosChecked - KnobPosUnchecked)) else aColor := GetMergedColor(aColor, aColor2, (KnobPosUnChecked - Knob.Top)/(KnobPosUnchecked - KnobPosChecked)); end; if bEnabled then Canvas.Brush.Color := aColor else Canvas.Brush.Color := GetMonochromaticColor(aColor); if State <> cbGrayed then Canvas.FillRect(aRect); { Paint Glyphs } { impossible to draw directly from resources, class vars used instead } if (GlyphSize > 0) and (GlyphStyle <> egsNone) then with Canvas do begin if KnobCaptured or (State <> cbChecked) then begin x := GlyphZeroPoint.X; y := GlyphZeroPoint.Y; case GlyphStyle of egsOneZero, egsCircles: if GlyphSize = 8 then Draw(x, y, GlyphZero8) else Draw(x, y, GlyphZero4); egsPlusMinus: begin if GlyphSize = 8 then begin Brush.Color := caClrGlyph[bEnabled]; FillRect(x, y + 3, x + GlyphSize, y + 5); end else begin Pen.Color := caClrGlyph[bEnabled]; if (Orientation = eooHorizontal) and ((SwitchHeight and 1) = 0) then dec(y) else if (Orientation=eooVertical) and ((SwitchWidth and 1) = 0) then dec(x); Line(x, y + 2, x + GlyphSize + 1, y + 2); end; end; end; end; if KnobCaptured or (State <> cbUnchecked) then begin x := GlyphOnePoint.X; y := GlyphOnePoint.Y; case GlyphStyle of egsOneZero: begin if GlyphSize = 8 then begin Brush.Color := caClrGlyph[bEnabled]; FillRect(x + 3, y, x + 5, y + GlyphSize); end else begin Pen.Color := clWhite; if (Orientation=eooHorizontal) or ((SwitchWidth and 1) = 1) then inc(x, 2) else inc(x); Line(x, y, x, y + GlyphSize); end; end; egsCircles: if GlyphSize=8 then Draw(x, y, GlyphFullCircle8) else Draw(x, y, GlyphDot4); egsPlusMinus: begin if GlyphSize = 8 then begin Brush.Color := caClrGlyph[bEnabled]; FillRect(x, y + 3, x + GlyphSize, y + 5); FillRect(x + 3, y, x + 5, y + GlyphSize); end else begin Pen.Color := caClrGlyph[bEnabled]; if (Orientation = eooHorizontal) and ((SwitchHeight and 1) = 0) then dec(y) else if (Orientation=eooVertical) and ((SwitchWidth and 1) = 0) then dec(x); Line(x, y + 2, x + GlyphSize + 1, y + 2); inc(x, 2); Line(x, y, x, y + GlyphSize + 1); end; end; egsDot: if GlyphSize = 8 then Draw(x + 2, y + 2, GlyphDot4) else Draw(x, y, GlyphDot4); end; end; end; { Paint Knob } if not KnobCaptured then begin if Orientation = eooHorizontal then begin case State of cbUnchecked: x := KnobPosUnchecked; cbChecked: x := KnobPosChecked; cbGrayed: x := KnobPosGrayed; end; Knob.Left := x; y := Knob.Top; end else begin case State of cbUnchecked: y := KnobPosUnchecked; cbChecked: y := KnobPosChecked; cbGrayed: y := KnobPosGrayed; end; Knob.Top := y; x := Knob.Left; end; end else begin x := Knob.Left; y := Knob.Top; end; if not bEnabled then Canvas.Draw(x, y, Knob.KnobDisabled) else if KnobHovered then Canvas.Draw(x, y, Knob.KnobHighlighted) else Canvas.Draw(x, y, Knob.KnobNormal); { Paint FocusRect } if Focused then begin aRect := Rect(x + 3, y + 3, x + Knob.Width - 3, y + Knob.Height - 3); LCLIntf.SetBkColor(Canvas.Handle, ColorToRGB(clBtnFace)); LCLIntf.DrawFocusRect(Canvas.Handle, aRect); end; { Paint Caption } if Caption <> '' then begin aRect := Rect(CaptionPoint.X, CaptionPoint.Y, Width, Height); with ThemeServices do DrawText(Canvas, GetElementDetails(caThemedContent[caItemState[bEnabled]]), Caption, aRect, DT_SINGLELINE, 0); end; end; procedure TCustomECSwitch.RecalcInvalidate; begin if UpdateCount = 0 then begin if AutoSize then begin InvalidatePreferredSize; AdjustSize; end; NeedCalculate := True; Invalidate; end; end; procedure TCustomECSwitch.RecalcRedraw; begin if UpdateCount = 0 then Invalidate; end; procedure TCustomECSwitch.Redraw; begin if UpdateCount = 0 then Invalidate; end; procedure TCustomECSwitch.Redraw3DColorAreas; begin if assigned(Knob) and (Knob.Style = eosPanel) then Knob.DrawKnobs; if UpdateCount = 0 then Invalidate; end; procedure TCustomECSwitch.ResizeKnob; begin {$IFDEF DBGSWITCH} DebugLn('TCustomECSwitch.ResizeKnob'); {$ENDIF} if Orientation = eooHorizontal then FKnob.SetSize(SwitchWidth div 2, SwitchHeight - 2*KnobIndent) else FKnob.SetSize(SwitchWidth - 2*KnobIndent, SwitchHeight div 2); end; procedure TCustomECSwitch.SetAutoSize(Value: Boolean); begin inherited SetAutoSize(Value); if Value then NeedCalculate := True; end; procedure TCustomECSwitch.SetKnobBackground; var aColor: TColor; begin if Style = eosPanel then aColor := GetColorResolvingDefault(SwitchColor, Parent.Brush.Color) else aColor := clBtnFace; aColor := ColorToRGB(aColor); FKnob.BackgroundColor := aColor; end; procedure TCustomECSwitch.StyleChanged(AValue: TObjectStyle); begin SetKnobBackground; inherited StyleChanged(AValue); end; procedure TCustomECSwitch.TextChanged; begin inherited TextChanged; RecalcInvalidate; end; procedure TCustomECSwitch.WMSize(var Message: TLMSize); begin inherited WMSize(Message); NeedCalculate := True; Invalidate; end; { Setters } function TCustomECSwitch.GetChecked: Boolean; begin Result := (FState = cbChecked); end; procedure TCustomECSwitch.SetCaptionPos(AValue: TObjectPos); begin if FCaptionPos = AValue then exit; FCaptionPos := AValue; RecalcInvalidate; end; procedure TCustomECSwitch.SetChecked(AValue: Boolean); begin if AValue then State := cbChecked else State := cbUnChecked; end; procedure TCustomECSwitch.SetGlyphStyle(AValue: TGlyphStyle); begin if FGlyphStyle = AValue then exit; FGlyphStyle := AValue; Redraw; end; procedure TCustomECSwitch.SetGrooveCheckedClr(AValue: TColor); begin if FGrooveCheckedClr = AValue then exit; FGrooveCheckedClr := AValue; if Checked then Redraw; end; procedure TCustomECSwitch.SetGrooveIndent(AValue: SmallInt); begin if FGrooveIndent = AValue then exit; FGrooveIndent := AValue; NeedCalculate := True; Redraw; end; procedure TCustomECSwitch.SetGrooveUncheckedClr(AValue: TColor); begin if FGrooveUncheckedClr = AValue then exit; FGrooveUncheckedClr := AValue; if not Checked then Redraw; end; procedure TCustomECSwitch.SetKnobHovered(AValue: Boolean); begin if FKnobHovered = AValue then exit; FKnobHovered := AValue; Redraw; end; procedure TCustomECSwitch.SetKnobIndent(AValue: SmallInt); begin if FKnobIndent = AValue then exit; FKnobIndent := AValue; ResizeKnob; NeedCalculate := True; Redraw; end; procedure TCustomECSwitch.SetState(AValue: TCheckBoxState); begin if FState = AValue then exit; FState := AValue; if [csLoading, csDestroying, csDesigning]*ComponentState = [] then begin if assigned(OnChange) then OnChange(self); { Execute only when Action.Checked is changed } if not CheckFromAction then begin if assigned(OnClick) then if not (assigned(Action) and CompareMethods(TMethod(Action.OnExecute), TMethod(OnClick))) then OnClick(self); if assigned(Action) and (Action is TCustomAction) and (TCustomAction(Action).Checked <> (AValue = cbChecked)) then ActionLink.Execute(self); end; end; Redraw; end; procedure TCustomECSwitch.SetSwitchColor(AValue: TColor); begin if FSwitchColor = AValue then exit; FSwitchColor := AValue; if Style = eosPanel then begin SetKnobBackground; Redraw; end; end; procedure TCustomECSwitch.SetSwitchHeight(AValue: Integer); begin if FSwitchHeight = AValue then exit; FSwitchHeight := AValue; ResizeKnob; RecalcInvalidate; end; procedure TCustomECSwitch.SetSwitchWidth(AValue: Integer); begin if FSwitchWidth = AValue then exit; FSwitchWidth := AValue; ResizeKnob; RecalcInvalidate; end; procedure Register; begin RegisterComponents('EC-C', [TECSwitch]); end; end.