lazarus.fresnel/demo/democomps/fresnel.demoslider.pas

unit Fresnel.DemoSlider;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, math, System.UITypes, Fresnel.DOM, Fresnel.Controls,
  Fresnel.Classes, FCL.Events, Fresnel.Events, fpCSSTree;

type

  { TDemoSlider }

  TDemoSlider = class(TDiv)
  private
    FMaxPosition: TFresnelLength;
    FMinPosition: TFresnelLength;
    FOnChange: TNotifyEvent;
    FSliderPosition: TFresnelLength;
    FValueFormat: string;
    function GetCaption: TFresnelCaption;
    procedure OnSliderDivMouse(Event: TAbstractEvent);
    procedure OnSliderPointMouse(Event: TAbstractEvent);
    procedure SetCaption(const AValue: TFresnelCaption);
    procedure SetMaxPosition(const AValue: TFresnelLength);
    procedure SetMinPosition(const AValue: TFresnelLength);
    procedure SetSliderPosition(AValue: TFresnelLength);
    procedure SetValueFormat(const AValue: string);
    procedure UpdateValueLabel;
    procedure UpdateSliderPosition;
  public
    const
      cStyle = ''
       +'.SliderCaptionDiv {'+LineEnding
       +'  margin-bottom: 0.3em;'+LineEnding
       +'  width: 100%;'+LineEnding
       +'}'+LineEnding
       +'.SliderLabel {'+LineEnding
       +'}'+LineEnding
       +'.SliderValue {'+LineEnding
       +'  margin-left: 0.4em;'+LineEnding
       +'  font-weight: 700;'+LineEnding
       +'  color: #f66020;'+LineEnding
       +'}'+LineEnding
       +'.SliderDiv {'+LineEnding
       +'  margin: 0.5em 0 0.4em;'+LineEnding
       +'  position: relative;'+LineEnding
       +'  border: 1px solid #5080e0;'+LineEnding
       +'  background-color: #b6d6f0;'+LineEnding
       +'  height: 0.8em;'+LineEnding
       +'  border-radius: 5px;'+LineEnding
       +'  width: 100%;'+LineEnding
       +'}'+LineEnding
       +'.SliderRange {'+LineEnding
       +'  display: block;'+LineEnding
       +'  position: absolute;'+LineEnding
       +'  z-index: 1;'+LineEnding
       +'  font-size: .7em;'+LineEnding
       +'  border: 0;'+LineEnding
       +'  background-color: #5ca0cc;'+LineEnding
       +'  top: 1px;'+LineEnding
       +'  left: 1px;'+LineEnding
       +'  height: 100%;'+LineEnding
       +'}'+LineEnding
       +'.SliderPoint {'+LineEnding
       +'  position: absolute;'+LineEnding
       +'  z-index: 2;'+LineEnding
       +'  width: 1.3em;'+LineEnding
       +'  height: 1.3em;'+LineEnding
       +'  border: 1px solid #385590;'+LineEnding
       +'  background-color: #fff;'+LineEnding
       +'  border-radius: 50%;'+LineEnding
       +'  cursor: pointer;'+LineEnding
       +'  top: -0.3em;'+LineEnding
       +'  margin-left: -0.5em;'+LineEnding
       +'}'+LineEnding;
    var
    CaptionDiv: TDiv;
    SliderLabel: TLabel; // inside CaptionDiv
    SliderValue: TLabel; // inside CaptionDiv
    SliderDiv: TDiv;
    SliderRange: TDiv; // inside SliderDiv
    SliderPoint: TDiv; // inside SliderDiv
    constructor Create(AOwner: TComponent); override;
    class function GetCSSTypeStyle: TCSSString; override;
    property MinPosition: TFresnelLength read FMinPosition write SetMinPosition;
    property MaxPosition: TFresnelLength read FMaxPosition write SetMaxPosition;
    property SliderPosition: TFresnelLength read FSliderPosition write SetSliderPosition;
    property Caption: TFresnelCaption read GetCaption write SetCaption;
    property ValueFormat: string read FValueFormat write SetValueFormat;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

implementation

{ TDemoSlider }

function TDemoSlider.GetCaption: TFresnelCaption;
begin
  Result:=SliderLabel.Caption;
end;

procedure TDemoSlider.OnSliderDivMouse(Event: TAbstractEvent);
var
  Evt: TFresnelMouseEvent;
  w: TFresnelLength;
begin
  if Event is TFresnelMouseEvent then
  begin
    Evt:=TFresnelMouseDownEvent(Event);
    if Evt.Buttons=[mbLeft] then
    begin
      w:=SliderDiv.UsedBorderBox.Width;
      if w<1 then exit;
      SliderPosition:=Evt.X/w * (MaxPosition-MinPosition) + MinPosition;
    end;
  end;
end;

procedure TDemoSlider.OnSliderPointMouse(Event: TAbstractEvent);
var
  Evt: TFresnelMouseEvent;
  w, x: TFresnelLength;
begin
  if Event is TFresnelMouseEvent then
  begin
    Evt:=TFresnelMouseEvent(Event);
    if Evt.Buttons=[mbLeft] then
    begin
      // compute X on SliderDiv
      w:=SliderDiv.UsedBorderBox.Width;
      if w<1 then exit;
      x:=Evt.X + SliderPoint.UsedContentBox.Left;
      SliderPosition:=x/w * (MaxPosition-MinPosition) + MinPosition;
    end;
  end;
end;

procedure TDemoSlider.SetCaption(const AValue: TFresnelCaption);
begin
  SliderLabel.Caption:=AValue;
end;

procedure TDemoSlider.SetMaxPosition(const AValue: TFresnelLength);
begin
  if FMaxPosition=AValue then Exit;
  FMaxPosition:=AValue;
  FMinPosition:=Min(MinPosition,MaxPosition);
  FSliderPosition:=Min(MaxPosition,Max(MinPosition,SliderPosition));
  UpdateSliderPosition;
end;

procedure TDemoSlider.SetMinPosition(const AValue: TFresnelLength);
begin
  if FMinPosition=AValue then Exit;
  FMinPosition:=AValue;
  FMaxPosition:=Max(MinPosition,MaxPosition);
  FSliderPosition:=Min(MaxPosition,Max(MinPosition,SliderPosition));
  UpdateSliderPosition;
end;

procedure TDemoSlider.SetSliderPosition(AValue: TFresnelLength);
begin
  AValue:=Min(MaxPosition,Max(MinPosition,AValue));
  if AValue=FSliderPosition then exit;
  FSliderPosition:=AValue;
  UpdateSliderPosition;
  if Assigned(OnChange) then OnChange(Self);
end;

procedure TDemoSlider.SetValueFormat(const AValue: string);
begin
  if FValueFormat=AValue then Exit;
  FValueFormat:=AValue;
  UpdateValueLabel;
end;

procedure TDemoSlider.UpdateValueLabel;
var
  s: String;
begin
  s:=Format(ValueFormat,[SliderPosition]);
  SliderValue.Caption:=s;
end;

procedure TDemoSlider.UpdateSliderPosition;
var
  p: TFresnelLength;
  s: String;
begin
  p:=(SliderPosition-MinPosition)/(MaxPosition-MinPosition);
  s:=FloatToCSSStr(p*100)+'%';
  SliderRange.Style:='width: '+s;
  SliderPoint.Style:='left: '+s;
  UpdateValueLabel;
end;

constructor TDemoSlider.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMinPosition:=0;
  FMaxPosition:=100;
  FValueFormat:='%fpx';

  CSSClasses.Add('Slider');

  CaptionDiv:=TDiv.Create(Self);
  with CaptionDiv do begin
    Name:='CaptionDiv';
    CSSClasses.Add('SliderCaptionDiv');
    Parent:=Self;
  end;
  SliderLabel:=TLabel.Create(Self);
  with SliderLabel do begin
    Name:='SliderLabel';
    CSSClasses.Add('SliderLabel');
    Caption:='Position';
    Parent:=CaptionDiv;
  end;
  SliderValue:=TLabel.Create(Self);
  with SliderValue do begin
    Name:='ValueLabel';
    CSSClasses.Add('SliderValue');
    Parent:=CaptionDiv;
  end;

  SliderDiv:=TDiv.Create(Self);
  with SliderDiv do begin
    Name:='SliderDiv';
    CSSClasses.Add('SliderDiv');
    Parent:=Self;
    AddEventListener(evtMouseDown,@OnSliderDivMouse);
    AddEventListener(evtMouseMove,@OnSliderDivMouse);
  end;
  SliderRange:=TDiv.Create(Self);
  with SliderRange do begin
    Name:='SliderRangeDiv';
    CSSClasses.Add('SliderRange');
    Parent:=SliderDiv;
    AddEventListener(evtMouseDown,@OnSliderDivMouse);
    AddEventListener(evtMouseMove,@OnSliderDivMouse);
  end;
  SliderPoint:=TDiv.Create(Self);
  with SliderPoint do begin
    Name:='SliderPointDiv';
    CSSClasses.Add('SliderPoint');
    AddEventListener(evtMouseDown,@OnSliderPointMouse);
    AddEventListener(evtMouseMove,@OnSliderPointMouse);
    Parent:=SliderDiv;
  end;
end;

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

end.