lazarus.fresnel/demo/democomps/fresnel.democheckbox.pas

unit Fresnel.DemoCheckbox;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils,
  FPReadPNG, Fresnel.DOM, Fresnel.Controls, Fresnel.Classes,
  FCL.Events, Fresnel.Events, fpCSSTree;

type

  { TDemoCheckBoxButton }

  TDemoCheckBoxButton = class(TImage)
  private
    FChecked: boolean;
    procedure OnClickEvent(Event: TAbstractEvent);
  protected
    procedure SetChecked(const AValue: boolean); virtual;
  public
    const
      cStyle = ''
        +'.CheckBoxButton {'+LineEnding
        +'  cursor: pointer;'+LineEnding
        +'  border-radius: 0.2em;'+LineEnding
        +'  padding: 1px;'+LineEnding
        +'  width: 1em;'+LineEnding
        +'  height: 1em;'+LineEnding
        +'}'+LineEnding;
      cCheckedStyle = 'background: #68f; border: 2px solid #68f;';
      cUncheckedStyle = 'background: white; border: 2px solid #999;';
  public
    CheckedStyle: string;
    UncheckedStyle: string;
    constructor Create(AOwner: TComponent); override;
    property Checked: boolean read FChecked write SetChecked;
  end;

  { TDemoCheckBox }

  TDemoCheckBox = class(TDiv)
  private
    FOnChange: TNotifyEvent;
    function GetCaption: TFresnelCaption;
    function GetChecked: boolean;
    procedure OnBoxClickEvent(Event: TAbstractEvent);
    procedure SetCaption(const AValue: TFresnelCaption);
    procedure SetChecked(const AValue: boolean);
  public
    // default styles
    const
      cStyle = ''
        +'.CheckBox {'+LineEnding
        +'}'+LineEnding
        +TDemoCheckBoxButton.cStyle
        +'.CheckBoxButton {'+LineEnding
        +'  margin: 0 0.2em 0 0;'+LineEnding
        +'}'+LineEnding
        +'.CheckBoxLabel {'+LineEnding
        +'  cursor: pointer;'+LineEnding
        +'  padding: 0.2em 0.3em;'+LineEnding
        +'  margin-bottom: 0;'+LineEnding
        +'}'+LineEnding;
  public
    Box: TDemoCheckBoxButton;
    CaptionLabel: TLabel;
    constructor Create(AOwner: TComponent); override;
    class function GetCSSTypeStyle: TCSSString; override;
  published
    property Caption: TFresnelCaption read GetCaption write SetCaption;
    property Checked: boolean read GetChecked write SetChecked;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

implementation

{$I fresnel.democheckbox.inc}

{ TDemoCheckBoxButton }

procedure TDemoCheckBoxButton.OnClickEvent(Event: TAbstractEvent);
begin
  if Event is TFresnelMouseClickEvent then ;
  Checked:=not Checked;
end;

procedure TDemoCheckBoxButton.SetChecked(const AValue: boolean);
begin
  if FChecked=AValue then Exit;
  FChecked:=AValue;
  if Checked then
  begin
    Style:=CheckedStyle;
  end else begin
    Style:=UncheckedStyle;
  end;
end;

constructor TDemoCheckBoxButton.Create(AOwner: TComponent);
var
  aStream: TStream;
begin
  inherited Create(AOwner);

  CheckedStyle:=cCheckedStyle;
  UncheckedStyle:=cUncheckedStyle;

  Style:=UncheckedStyle;
  aStream:=TMemoryStream.Create;
  aStream.WriteBuffer(CheckBoxImage[0],length(CheckBoxImage));
  aStream.Position:=0;
  try
    Image.LoadFromStream(aStream);
  finally
    aStream.Free;
  end;

  AddEventListener(evtClick,@OnClickEvent);
end;

{ TDemoCheckBox }

function TDemoCheckBox.GetCaption: TFresnelCaption;
begin
  Result:=CaptionLabel.Caption;
end;

function TDemoCheckBox.GetChecked: boolean;
begin
  Result:=Box.Checked;
end;

procedure TDemoCheckBox.OnBoxClickEvent(Event: TAbstractEvent);
begin
  if Event=nil then ;
  if Assigned(OnChange) then OnChange(Self);
end;

procedure TDemoCheckBox.SetCaption(const AValue: TFresnelCaption);
begin
  CaptionLabel.Caption:=AValue;
end;

procedure TDemoCheckBox.SetChecked(const AValue: boolean);
begin
  Box.Checked:=AValue;
end;

constructor TDemoCheckBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  CSSClasses.Add('CheckBox');

  Box:=TDemoCheckBoxButton.Create(Self);
  with Box do begin
    Name:='Box';
    CSSClasses.Add('CheckBoxButton');
    Parent:=Self;
    AddEventListener(evtClick,@OnBoxClickEvent);
  end;

  CaptionLabel:=TLabel.Create(Self);
  with CaptionLabel do begin
    Name:='CaptionLabel';
    CSSClasses.Add('CheckBoxLabel');
    Parent:=Self;
  end;
end;

class function TDemoCheckBox.GetCSSTypeStyle: TCSSString;
begin
  Result:=cStyle;
end;

end.