lazarus.fresnel/demo/CheckBox/DemoCheckBox.pas

unit DemoCheckBox;

{$mode ObjFPC}{$H+}

interface

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

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: 2px;'+LineEnding
        +'  padding: 1px;'+LineEnding
        +'  width: 11px;'+LineEnding
        +'  height: 11px;'+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 2px 0 0;'+LineEnding
        +'}'+LineEnding
        +'.CheckBoxLabel {'+LineEnding
        +'  cursor: pointer;'+LineEnding
        +'  font-size: 12px;'+LineEnding
        +'  padding: 2px 3px;'+LineEnding
        +'  margin-bottom: 0;'+LineEnding
        +'}'+LineEnding;
  public
    Box: TDemoCheckBoxButton;
    CaptionLabel: TLabel;
    constructor Create(AOwner: TComponent); override;
    property Caption: TFresnelCaption read GetCaption write SetCaption;
    property Checked: boolean read GetChecked write SetChecked;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

implementation

{$R *.res}

{ 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: TResourceStream;
begin
  inherited Create(AOwner);

  CheckedStyle:=cCheckedStyle;
  UncheckedStyle:=cUncheckedStyle;

  Style:=UncheckedStyle;

  aStream := TResourceStream.Create(HINSTANCE, 'Check', RT_RCDATA);
  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;

end.