LazControls: New files for CheckboxThemed.

git-svn-id: trunk@47029 -

.gitattributes

@@ -2025,6 +2025,7 @@ components/jcf2/readme.txt svneol=native#text/plain
 components/lazcontrols/Makefile svneol=native#text/plain
 components/lazcontrols/Makefile.compiled svneol=native#text/plain
 components/lazcontrols/Makefile.fpc svneol=native#text/plain
+components/lazcontrols/checkboxthemed.pas svneol=native#text/pascal
 components/lazcontrols/design/lazcontroldsgn.lpk svneol=native#text/pascal
 components/lazcontrols/design/lazcontroldsgn.pas svneol=native#text/pascal
 components/lazcontrols/design/registerlazcontrols.pas svneol=native#text/pascal
@@ -2032,6 +2033,7 @@ components/lazcontrols/dividerbevel.pas svneol=native#text/pascal
 components/lazcontrols/extendednotebook.pas svneol=native#text/pascal
 components/lazcontrols/extendedtabcontrols.pas svneol=native#text/pascal
 components/lazcontrols/fpmake.pp svneol=native#text/plain
+components/lazcontrols/images/checkboxthemed.png -text svneol=unset#image/png
 components/lazcontrols/images/dividerbevel.png -text
 components/lazcontrols/images/listfilteredit.png -text
 components/lazcontrols/images/shortpathedit.png -text svneol=unset#image/png

components/lazcontrols/checkboxthemed.pas

@@ -0,0 +1,488 @@
+{
+ *****************************************************************************
+  This file is part of the Lazarus Component Library (LCL)
+
+  See the file COPYING.modifiedLGPL.txt, included in this distribution,
+  for details about the license.
+ *****************************************************************************
+}
+
+unit CheckBoxThemed;
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, StdCtrls, Graphics, Math, ActnList, Forms, Menus,
+  LCLIntf, LMessages, LCLProc, LResources, LCLType, Themes, Types; //PropEdits,
+
+type
+  TCustomCheckBoxThemed = class;
+
+  { TCheckBoxThemedActionLink }
+  TCheckBoxThemedActionLink = class(TWinControlActionLink)
+  protected
+    FClientCheckBoxThemed: TCustomCheckBoxThemed;
+    procedure AssignClient(AClient: TObject); override;
+    procedure SetChecked(Value: Boolean); override;
+  public
+    function IsCheckedLinked: Boolean; override;
+  end;
+
+  TCheckBoxThemedActionLinkClass = class of TCheckBoxThemedActionLink;
+
+  { TCustomCheckBoxThemed }
+  TCustomCheckBoxThemed = class(TCustomControl)
+  private
+    FAlignment: TLeftRight;
+    FAllowGrayed: Boolean;
+    FCheckBoxHovered: Boolean;
+    FCheckFromAction: Boolean;
+    FOnChange: TNotifyEvent;
+    FState: TCheckBoxState;
+    function GetChecked: Boolean;
+    procedure SetAlignment(AValue: TLeftRight);
+    procedure SetCheckBoxHovered(AValue: Boolean);
+    procedure SetChecked(AValue: Boolean);
+    procedure SetState(AValue: TCheckBoxState);
+  protected
+    class var CheckBoxSize: TSize;
+  protected
+    CheckBoxPressed: Boolean;
+    KnobPosUnchecked, KnobPosChecked, KnobPosGrayed: Integer;
+    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
+                                     {%H-}WithThemeSpace: Boolean); override;
+    procedure CMBiDiModeChanged(var {%H-}Message: TLMessage); message CM_BIDIMODECHANGED;
+    procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
+    class constructor InitCheckBoxSize;
+    function DialogChar(var Message: TLMKey): Boolean; override;
+    procedure DoClick;
+    procedure DoEnter; override;
+    procedure DoExit; override;
+    function GetActionLinkClass: TControlActionLinkClass; override;
+    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+    procedure MouseEnter; override;
+    procedure MouseLeave; override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+    class procedure PaintSelf(ACanvas: TCanvas; ACaption: string; ARect: TRect;
+      AState: TCheckBoxState; ARightToLeft, AHovered, APressed, AFocused: Boolean;
+      AAlignment: TLeftRight; AEnabled: Boolean = True);
+    procedure Paint; override;
+    procedure TextChanged; override;
+    procedure WMSize(var Message: TLMSize); message LM_SIZE;
+    property CheckBoxHovered: Boolean read FCheckBoxHovered write SetCheckBoxHovered;
+    property CheckFromAction: Boolean read FCheckFromAction write FCheckFromAction;
+  protected const
+    cFocusBorder: SmallInt = 2;
+    cIndent: SmallInt = 5;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify;
+    property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
+    property Checked: Boolean read GetChecked write SetChecked default False;
+    property State: TCheckBoxState read FState write SetState default cbUnchecked;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+  end;
+
+  { TCheckBoxThemed }
+  TCheckBoxThemed = class(TCustomCheckBoxThemed)
+  published
+    property Action;
+    property Align;
+    property Alignment;
+    property AllowGrayed;
+    property Anchors;
+    property AutoSize default True;
+    property BiDiMode;
+    property BorderSpacing;
+    property Caption;
+    property Checked;
+    property Color;
+    property Constraints;
+    property Cursor;
+    property DragCursor;
+    property DragKind;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property Height;
+    property HelpContext;
+    property HelpKeyword;
+    property HelpType;
+    property Hint;
+    property Left;
+    property ParentBiDiMode;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowHint;
+    property State;
+    property TabOrder;
+    property TabStop default True;
+    property Top;
+    property Visible;
+    property Width;
+    property OnChangeBounds;
+    property OnChange;
+    property OnClick;
+    property OnContextPopup;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEditingDone;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnResize;
+    property OnStartDrag;
+    property OnUTF8KeyPress;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('LazControls', [TCheckBoxThemed]);
+  //RegisterPropertyEditor(TypeInfo(TCaption), TCheckBoxThemed, 'Caption', TStringMultilinePropertyEditor);
+end;
+
+{ TCheckBoxThemedActionLink }
+
+procedure TCheckBoxThemedActionLink.AssignClient(AClient: TObject);
+begin
+  inherited AssignClient(AClient);
+  FClientCheckBoxThemed := AClient as TCustomCheckBoxThemed;
+end;
+
+function TCheckBoxThemedActionLink.IsCheckedLinked: Boolean;
+begin
+  Result := inherited IsCheckedLinked and
+            (FClientCheckBoxThemed.Checked = (Action as TCustomAction).Checked);
+end;
+
+procedure TCheckBoxThemedActionLink.SetChecked(Value: Boolean);
+begin
+  if IsCheckedLinked then begin
+    FClientCheckBoxThemed.CheckFromAction := True;
+    try
+      FClientCheckBoxThemed.Checked := Value;
+    finally
+      FClientCheckBoxThemed.CheckFromAction := False;
+    end;
+  end;
+end;
+
+{ TCustomCheckBoxThemed }
+
+constructor TCustomCheckBoxThemed.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  AccessibleRole := larCheckBox;
+  ControlStyle := ControlStyle  + [csParentBackground, csReplicatable] - [csOpaque]
+               - csMultiClicks - [csClickEvents, csNoStdEvents];  { inherited Click not used }
+  FAlignment := taRightJustify;
+  FAllowGrayed := False;
+  AutoSize := True;
+  TabStop := True;
+end;
+
+procedure TCustomCheckBoxThemed.CalculatePreferredSize(var PreferredWidth,
+            PreferredHeight: Integer; WithThemeSpace: Boolean);
+var aDetails: TThemedElementDetails;
+    aFlags: Cardinal;
+    aTextSize: TSize;
+begin
+  if Caption <> '' then begin
+    aDetails := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal);
+    aFlags := DT_CENTER + DT_VCENTER;
+    if IsRightToLeft then inc(aFlags, DT_RTLREADING);
+    with ThemeServices.GetTextExtent(Canvas.Handle, aDetails, Caption, aFlags, nil) do begin
+      aTextSize.cx := Right;
+      aTextSize.cy := Bottom;
+    end;
+    PreferredWidth := CheckBoxSize.cx + cIndent + aTextSize.cx + cFocusBorder;
+    PreferredHeight := Math.max(CheckBoxSize.cy, aTextSize.cy + 2 * cFocusBorder);
+  end else begin
+    PreferredWidth := CheckBoxSize.cx;
+    PreferredHeight := CheckBoxSize.cy;
+  end;
+end;
+
+procedure TCustomCheckBoxThemed.CMBiDiModeChanged(var Message: TLMessage);
+begin
+  Invalidate;
+end;
+
+procedure TCustomCheckBoxThemed.CMEnabledChanged(var Message: TLMessage);
+begin
+  if IsEnabled then FCheckBoxHovered := False;
+  inherited CMEnabledChanged(Message);
+end;
+
+class constructor TCustomCheckBoxThemed.InitCheckBoxSize;
+begin
+  with ThemeServices do
+    CheckBoxSize := GetDetailSize(GetElementDetails(tbCheckBoxCheckedNormal));
+end;
+
+function TCustomCheckBoxThemed.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 TCustomCheckBoxThemed.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 TCustomCheckBoxThemed.DoEnter;
+begin
+  inherited DoEnter;
+  Invalidate;
+end;
+
+procedure TCustomCheckBoxThemed.DoExit;
+begin
+  inherited DoExit;
+  Invalidate;
+end;
+
+function TCustomCheckBoxThemed.GetActionLinkClass: TControlActionLinkClass;
+begin
+  Result := TCheckBoxThemedActionLink;
+end;
+
+procedure TCustomCheckBoxThemed.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+  inherited KeyDown(Key, Shift);
+  if (Key in [VK_RETURN, VK_SPACE]) and not (ssCtrl in Shift) then begin
+    CheckBoxPressed := True;
+    Invalidate;
+  end;
+end;
+
+procedure TCustomCheckBoxThemed.KeyUp(var Key: Word; Shift: TShiftState);
+begin
+  inherited KeyDown(Key, Shift);
+  if (Key in [VK_RETURN, VK_SPACE]) and not (ssCtrl in Shift) then begin
+    CheckBoxPressed :=  False;
+    DoClick;
+  end;
+end;
+
+procedure TCustomCheckBoxThemed.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  inherited MouseDown(Button, Shift, X, Y);
+  if (Button = mbLeft) and CheckBoxHovered then begin
+    CheckBoxPressed := True;
+    Invalidate;
+  end;
+  SetFocus;
+end;
+
+procedure TCustomCheckBoxThemed.MouseEnter;
+begin
+  inherited MouseEnter;
+  CheckBoxHovered := True;
+end;
+
+procedure TCustomCheckBoxThemed.MouseLeave;
+begin
+  inherited MouseLeave;
+  CheckBoxHovered := False;
+end;
+
+procedure TCustomCheckBoxThemed.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  inherited MouseUp(Button, Shift, X, Y);
+  if Button = mbLeft then begin
+    if PtInRect(ClientRect, Point(X, Y)) then DoClick;
+    CheckBoxPressed := False;
+  end;
+end;
+
+class procedure TCustomCheckBoxThemed.PaintSelf(ACanvas: TCanvas;
+  ACaption: string; ARect: TRect; AState: TCheckBoxState; ARightToLeft,
+  AHovered, APressed, AFocused: Boolean; AAlignment: TLeftRight;
+  AEnabled: Boolean);
+var aCaptionPoint, aCheckBoxPoint: TPoint;
+    aDetails: TThemedElementDetails;
+    aFlags: Cardinal;
+    aHelpRect: TRect;
+    aTextSize: TSize;         { Hovered,     Pressed,     State }
+const caEnabledDetails: array [False..True, False..True, cbUnchecked..cbGrayed] of TThemedButton =
+  (((tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal, tbCheckBoxMixedNormal),
+    (tbCheckBoxUncheckedPressed, tbCheckBoxCheckedPressed, tbCheckBoxMixedPressed)),
+   ((tbCheckBoxUncheckedHot, tbCheckBoxCheckedHot, tbCheckBoxMixedHot),
+    (tbCheckBoxUncheckedPressed, tbCheckBoxCheckedPressed, tbCheckBoxMixedPressed)));
+const caDisabledDetails: array [cbUnchecked..cbGrayed] of TThemedButton =
+  (tbCheckBoxUncheckedDisabled, tbCheckBoxCheckedDisabled, tbCheckBoxMixedDisabled);
+begin
+  { Calculate }
+  if AEnabled then
+    aDetails := ThemeServices.GetElementDetails(caEnabledDetails[AHovered, False, AState])
+  else
+    aDetails := ThemeServices.GetElementDetails(caDisabledDetails[AState]);
+  if ACaption <> '' then begin
+    aFlags := DT_CENTER + DT_VCENTER;
+    if ARightToLeft then inc(aFlags, DT_RTLREADING);
+    with ThemeServices.GetTextExtent(ACanvas.Handle, aDetails, ACaption, aFlags, nil) do begin
+      aTextSize.cx := Right;
+      aTextSize.cy := Bottom + 2 * cFocusBorder;
+    end;
+    aCaptionPoint.Y := (ARect.Bottom - aTextSize.cy) div 2;
+    aCheckBoxPoint.Y := (ARect.Bottom - CheckBoxSize.cy) div 2;
+    case AAlignment of
+      taLeftJustify: begin
+        if not ARightToLeft then begin  { Caption is on the Left, aligned to the Left }
+          aCaptionPoint.X := cFocusBorder;
+          aCheckBoxPoint.X := cFocusBorder + aTextSize.cx + cIndent;
+        end else begin  { Caption is on the Right, aligned to the Right }
+          aCaptionPoint.X := ARect.Right - aTextSize.cx - cFocusBorder;
+          aCheckBoxPoint.X := aCaptionPoint.X - cIndent - CheckBoxSize.cx;
+        end;
+      end;
+      taRightJustify: begin
+        if not ARightToLeft then begin  { Caption is on the Right, aligned to the Left }
+          aCaptionPoint.X := CheckBoxSize.cx + cIndent;
+          aCheckBoxPoint.X := 0;
+        end else begin  { Caption is on the Left, aligned to the Right }
+          aCheckBoxPoint.X := ARect.Right - CheckBoxSize.cx;
+          aCaptionPoint.X := aCheckBoxPoint.X - cIndent - aTextSize.cx;
+        end;
+      end;
+    end;
+  end else begin
+    if not ARightToLeft then
+      aCheckBoxPoint.X := 0
+    else
+      aCheckBoxPoint.X := ARect.Right - CheckBoxSize.cx;
+    aCheckBoxPoint.Y := (ARect.Bottom - CheckBoxSize.cy) div 2;
+  end;
+  { Paint Caption }
+  if ACaption <> '' then begin
+    aHelpRect := Rect(aCaptionPoint.X, aCaptionPoint.Y,
+      aCaptionPoint.X + aTextSize.cx, aCaptionPoint.Y + aTextSize.cy);
+    ThemeServices.DrawText(ACanvas, aDetails, ACaption, aHelpRect, aFlags, 0);
+    { Paint FocusRect around Caption }
+    if AFocused then begin
+      dec(aHelpRect.Left, cFocusBorder);
+      inc(aHelpRect.Right, cFocusBorder);
+      LCLIntf.SetBkColor(ACanvas.Handle, ColorToRGB(clBtnFace));
+      LCLIntf.DrawFocusRect(ACanvas.Handle, aHelpRect);
+    end;
+  end;
+  { Paint CheckBox }
+  if AEnabled then
+    aDetails := ThemeServices.GetElementDetails(caEnabledDetails[AHovered, APressed, AState])
+  else
+    aDetails := ThemeServices.GetElementDetails(caDisabledDetails[AState]);
+  aHelpRect := Rect(aCheckBoxPoint.X, aCheckBoxPoint.Y,
+    aCheckBoxPoint.X + CheckBoxSize.cx, aCheckBoxPoint.Y + CheckBoxSize.cy);
+  ThemeServices.DrawElement(ACanvas.Handle, aDetails, aHelpRect);
+end;
+
+procedure TCustomCheckBoxThemed.Paint;
+begin
+  inherited Paint;
+  PaintSelf(Canvas, Caption, ClientRect, State, IsRightToLeft, CheckBoxHovered,
+    CheckBoxPressed, Focused, Alignment, IsEnabled);
+end;
+
+procedure TCustomCheckBoxThemed.TextChanged;
+begin
+  inherited TextChanged;
+  Invalidate;
+end;
+
+procedure TCustomCheckBoxThemed.WMSize(var Message: TLMSize);
+begin
+  inherited WMSize(Message);
+  Invalidate;
+end;
+
+{ Setters }
+
+function TCustomCheckBoxThemed.GetChecked: Boolean;
+begin
+  Result := (FState = cbChecked);
+end;
+
+procedure TCustomCheckBoxThemed.SetAlignment(AValue: TLeftRight);
+begin
+  if FAlignment = AValue then exit;
+  FAlignment := AValue;
+  Invalidate;
+end;
+
+procedure TCustomCheckBoxThemed.SetCheckBoxHovered(AValue: Boolean);
+begin
+  if FCheckBoxHovered = AValue then exit;
+  FCheckBoxHovered := AValue;
+  Invalidate;
+end;
+
+procedure TCustomCheckBoxThemed.SetChecked(AValue: Boolean);
+begin
+  if AValue then
+    State := cbChecked
+  else
+    State := cbUnChecked;
+end;
+
+procedure TCustomCheckBoxThemed.SetState(AValue: TCheckBoxState);
+begin
+  if FState = AValue then exit;
+  FState := AValue;
+  if [csLoading, csDestroying, csDesigning]*ComponentState = [] then begin
+    if Assigned(OnEditingDone) then OnEditingDone(self);
+    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;
+  Invalidate;
+end;
+
+end.
+
+