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.