You've already forked lazarus-ccr
industrial: Add MultiSlider component.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6850 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
218
components/industrialstuff/Example/MultiSliderSample/main.lfm
Normal file
218
components/industrialstuff/Example/MultiSliderSample/main.lfm
Normal file
@ -0,0 +1,218 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 326
|
||||||
|
Height = 396
|
||||||
|
Top = 127
|
||||||
|
Width = 528
|
||||||
|
Caption = 'Form1'
|
||||||
|
ClientHeight = 396
|
||||||
|
ClientWidth = 528
|
||||||
|
OnCreate = FormCreate
|
||||||
|
LCLVersion = '2.1.0.0'
|
||||||
|
object cbVertical: TCheckBox
|
||||||
|
Left = 110
|
||||||
|
Height = 19
|
||||||
|
Top = 154
|
||||||
|
Width = 59
|
||||||
|
Caption = 'Vertical'
|
||||||
|
OnChange = cbVerticalChange
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object cbAutoRotate: TCheckBox
|
||||||
|
Left = 110
|
||||||
|
Height = 19
|
||||||
|
Top = 177
|
||||||
|
Width = 80
|
||||||
|
Caption = 'AutoRotate'
|
||||||
|
Checked = True
|
||||||
|
OnChange = cbAutoRotateChange
|
||||||
|
State = cbChecked
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 104
|
||||||
|
Height = 15
|
||||||
|
Top = 64
|
||||||
|
Width = 47
|
||||||
|
Caption = 'Min = 20'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label2: TLabel
|
||||||
|
Left = 176
|
||||||
|
Height = 15
|
||||||
|
Top = 64
|
||||||
|
Width = 54
|
||||||
|
Caption = 'Value = 50'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 252
|
||||||
|
Height = 15
|
||||||
|
Top = 64
|
||||||
|
Width = 48
|
||||||
|
Caption = 'Max = 80'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object cbColorBelow: TColorButton
|
||||||
|
Left = 104
|
||||||
|
Height = 25
|
||||||
|
Top = 82
|
||||||
|
Width = 56
|
||||||
|
BorderWidth = 2
|
||||||
|
ButtonColorSize = 16
|
||||||
|
ButtonColor = clBlack
|
||||||
|
OnColorChanged = cbColorBelowColorChanged
|
||||||
|
end
|
||||||
|
object cbColorBetween: TColorButton
|
||||||
|
Left = 174
|
||||||
|
Height = 25
|
||||||
|
Top = 82
|
||||||
|
Width = 56
|
||||||
|
BorderWidth = 2
|
||||||
|
ButtonColorSize = 16
|
||||||
|
ButtonColor = clBlack
|
||||||
|
OnColorChanged = cbColorBetweenColorChanged
|
||||||
|
end
|
||||||
|
object cbColorAbove: TColorButton
|
||||||
|
Left = 248
|
||||||
|
Height = 25
|
||||||
|
Top = 82
|
||||||
|
Width = 56
|
||||||
|
BorderWidth = 2
|
||||||
|
ButtonColorSize = 16
|
||||||
|
ButtonColor = clBlack
|
||||||
|
OnColorChanged = cbColorAboveColorChanged
|
||||||
|
end
|
||||||
|
object cbFormColor: TColorButton
|
||||||
|
Left = 328
|
||||||
|
Height = 25
|
||||||
|
Top = 82
|
||||||
|
Width = 120
|
||||||
|
BorderWidth = 2
|
||||||
|
ButtonColorSize = 16
|
||||||
|
ButtonColor = clBlack
|
||||||
|
Caption = 'Form'
|
||||||
|
OnColorChanged = cbFormColorColorChanged
|
||||||
|
end
|
||||||
|
object cmbThumbStyle: TComboBox
|
||||||
|
Left = 110
|
||||||
|
Height = 23
|
||||||
|
Top = 203
|
||||||
|
Width = 132
|
||||||
|
ItemHeight = 15
|
||||||
|
ItemIndex = 0
|
||||||
|
Items.Strings = (
|
||||||
|
'Grip'
|
||||||
|
'Circle'
|
||||||
|
'Rectangle'
|
||||||
|
'Rounded Rectangle'
|
||||||
|
'Triangles'
|
||||||
|
'Triangles (on other side)'
|
||||||
|
)
|
||||||
|
OnChange = cmbThumbStyleChange
|
||||||
|
Style = csDropDownList
|
||||||
|
TabOrder = 2
|
||||||
|
Text = 'Grip'
|
||||||
|
end
|
||||||
|
object cbColorThumb: TColorButton
|
||||||
|
Left = 328
|
||||||
|
Height = 25
|
||||||
|
Top = 112
|
||||||
|
Width = 120
|
||||||
|
BorderWidth = 2
|
||||||
|
ButtonColorSize = 16
|
||||||
|
ButtonColor = clBlack
|
||||||
|
Caption = 'Thumb'
|
||||||
|
OnColorChanged = cbColorThumbColorChanged
|
||||||
|
end
|
||||||
|
object cbFlat: TCheckBox
|
||||||
|
Left = 200
|
||||||
|
Height = 19
|
||||||
|
Top = 154
|
||||||
|
Width = 39
|
||||||
|
Caption = 'Flat'
|
||||||
|
OnChange = cbFlatChange
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object seTrackThickness: TSpinEdit
|
||||||
|
Left = 280
|
||||||
|
Height = 23
|
||||||
|
Top = 203
|
||||||
|
Width = 82
|
||||||
|
OnChange = seTrackThicknessChange
|
||||||
|
TabOrder = 4
|
||||||
|
end
|
||||||
|
object Label4: TLabel
|
||||||
|
Left = 280
|
||||||
|
Height = 15
|
||||||
|
Top = 181
|
||||||
|
Width = 80
|
||||||
|
Caption = 'Track thickness'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label5: TLabel
|
||||||
|
Left = 376
|
||||||
|
Height = 15
|
||||||
|
Top = 181
|
||||||
|
Width = 60
|
||||||
|
Caption = 'Default size'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object seDefaultSize: TSpinEdit
|
||||||
|
Left = 376
|
||||||
|
Height = 23
|
||||||
|
Top = 203
|
||||||
|
Width = 82
|
||||||
|
OnChange = seDefaultSizeChange
|
||||||
|
TabOrder = 5
|
||||||
|
end
|
||||||
|
object cbEnabled: TCheckBox
|
||||||
|
Left = 110
|
||||||
|
Height = 19
|
||||||
|
Top = 128
|
||||||
|
Width = 62
|
||||||
|
Caption = 'Enabled'
|
||||||
|
Checked = True
|
||||||
|
OnChange = cbEnabledChange
|
||||||
|
State = cbChecked
|
||||||
|
TabOrder = 6
|
||||||
|
end
|
||||||
|
object cbSliderColor: TColorButton
|
||||||
|
Left = 328
|
||||||
|
Height = 25
|
||||||
|
Top = 140
|
||||||
|
Width = 120
|
||||||
|
BorderWidth = 2
|
||||||
|
ButtonColorSize = 16
|
||||||
|
ButtonColor = clBlack
|
||||||
|
Caption = 'Control'
|
||||||
|
OnColorChanged = cbSliderColorColorChanged
|
||||||
|
end
|
||||||
|
object cbTransparent: TCheckBox
|
||||||
|
Left = 200
|
||||||
|
Height = 19
|
||||||
|
Top = 128
|
||||||
|
Width = 83
|
||||||
|
Caption = 'Transparent'
|
||||||
|
Checked = True
|
||||||
|
OnChange = cbTransparentChange
|
||||||
|
State = cbChecked
|
||||||
|
TabOrder = 7
|
||||||
|
end
|
||||||
|
object cmbSliderMode: TComboBox
|
||||||
|
Left = 110
|
||||||
|
Height = 23
|
||||||
|
Top = 235
|
||||||
|
Width = 132
|
||||||
|
ItemHeight = 15
|
||||||
|
ItemIndex = 0
|
||||||
|
Items.Strings = (
|
||||||
|
'single'
|
||||||
|
'min ... max'
|
||||||
|
'min ... value ... max'
|
||||||
|
)
|
||||||
|
OnChange = cmbSliderModeChange
|
||||||
|
Style = csDropDownList
|
||||||
|
TabOrder = 8
|
||||||
|
Text = 'single'
|
||||||
|
end
|
||||||
|
end
|
||||||
180
components/industrialstuff/Example/MultiSliderSample/main.pas
Normal file
180
components/industrialstuff/Example/MultiSliderSample/main.pas
Normal file
@ -0,0 +1,180 @@
|
|||||||
|
unit main;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ColorBox,
|
||||||
|
Spin, ExtCtrls, switches, indSliders;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
cbSliderColor: TColorButton;
|
||||||
|
cbVertical: TCheckBox;
|
||||||
|
cbAutoRotate: TCheckBox;
|
||||||
|
cbColorBelow: TColorButton;
|
||||||
|
cbColorBetween: TColorButton;
|
||||||
|
cbColorAbove: TColorButton;
|
||||||
|
cbFlat: TCheckBox;
|
||||||
|
cbEnabled: TCheckBox;
|
||||||
|
cbTransparent: TCheckBox;
|
||||||
|
cbFormColor: TColorButton;
|
||||||
|
cmbThumbStyle: TComboBox;
|
||||||
|
cbColorThumb: TColorButton;
|
||||||
|
cmbSliderMode: TComboBox;
|
||||||
|
Label1: TLabel;
|
||||||
|
Label2: TLabel;
|
||||||
|
Label3: TLabel;
|
||||||
|
Label4: TLabel;
|
||||||
|
Label5: TLabel;
|
||||||
|
seTrackThickness: TSpinEdit;
|
||||||
|
seDefaultSize: TSpinEdit;
|
||||||
|
procedure cbAutoRotateChange(Sender: TObject);
|
||||||
|
procedure cbColorAboveColorChanged(Sender: TObject);
|
||||||
|
procedure cbColorBelowColorChanged(Sender: TObject);
|
||||||
|
procedure cbColorBetweenColorChanged(Sender: TObject);
|
||||||
|
procedure cbColorThumbColorChanged(Sender: TObject);
|
||||||
|
procedure cbEnabledChange(Sender: TObject);
|
||||||
|
procedure cbFlatChange(Sender: TObject);
|
||||||
|
procedure cbSliderColorColorChanged(Sender: TObject);
|
||||||
|
procedure cmbSliderModeChange(Sender: TObject);
|
||||||
|
procedure cmbThumbStyleChange(Sender: TObject);
|
||||||
|
procedure cbTransparentChange(Sender: TObject);
|
||||||
|
procedure cbVerticalChange(Sender: TObject);
|
||||||
|
procedure cbFormColorColorChanged(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure seDefaultSizeChange(Sender: TObject);
|
||||||
|
procedure seTrackThicknessChange(Sender: TObject);
|
||||||
|
private
|
||||||
|
slider: TMultiSlider;
|
||||||
|
procedure PositionChangeHandler(Sender: TObject; AKind: TThumbKind; AValue: Integer);
|
||||||
|
|
||||||
|
public
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider := TMultiSlider.Create(self);
|
||||||
|
slider.Parent := self;
|
||||||
|
slider.Align := alTop;
|
||||||
|
slider.BorderSpacing.Around := 8;
|
||||||
|
// slider.Left := 8;
|
||||||
|
// slider.Top := 8;
|
||||||
|
slider.Vertical := false;
|
||||||
|
slider.OnPositionChange := @PositionChangeHandler;
|
||||||
|
|
||||||
|
cbColorBelow.ButtonColor := slider.ColorBelow;
|
||||||
|
cbColorAbove.ButtonColor := slider.ColorAbove;
|
||||||
|
cbColorBetween.ButtonColor := slider.ColorBetween;
|
||||||
|
cbColorThumb.ButtonColor := slider.ColorThumb;
|
||||||
|
cbSliderColor.ButtonColor := slider.Color;
|
||||||
|
cbFormColor.ButtonColor := Color;
|
||||||
|
cbTransparent.Checked := slider.Color = clNone;
|
||||||
|
seTrackThickness.Value := slider.TrackThickness;
|
||||||
|
seDefaultSize.Value := slider.DefaultSize;
|
||||||
|
cmbSliderMode.ItemIndex := ord(slider.SliderMode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.seDefaultSizeChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.DefaultSize := seDefaultSize.Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.seTrackThicknessChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.TrackThickness := seTrackThickness.Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbVerticalChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.Vertical := cbVertical.Checked;
|
||||||
|
if slider.Vertical then slider.Align := alLeft else slider.Align := alTop;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbFormColorColorChanged(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Color := cbFormColor.ButtonColor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbColorThumbColorChanged(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.ColorThumb := cbColorThumb.ButtonColor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbAutoRotateChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.AutoRotate := cbAutoRotate.Checked;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbColorAboveColorChanged(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.ColorAbove := cbColorAbove.ButtonColor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbColorBelowColorChanged(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.ColorBelow := cbColorBelow.ButtonColor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbColorBetweenColorChanged(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.ColorBetween := cbColorBetween.ButtonColor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbSliderColorColorChanged(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.Color := cbSliderColor.ButtonColor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cmbSliderModeChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.SliderMode := TSliderMode(cmbSliderMode.ItemIndex);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbEnabledChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.Enabled := cbEnabled.Checked;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbFlatChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.Flat := cbFlat.Checked;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cmbThumbStyleChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
slider.ThumbStyle := TThumbStyle(cmbThumbStyle.ItemIndex);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.cbTransparentChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if cbTransparent.Checked then
|
||||||
|
slider.Color := clNone;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.PositionChangeHandler(Sender: TObject; AKind: TThumbKind;
|
||||||
|
AValue: Integer);
|
||||||
|
begin
|
||||||
|
case AKind of
|
||||||
|
tkMin: Label1.Caption := 'Min = ' + intToStr(AValue);
|
||||||
|
tkValue: Label2.Caption := 'Value = ' + IntToStr(AValue);
|
||||||
|
tkMax: Label3.Caption := 'Max = ' + IntToStr(AValue);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
@ -0,0 +1,77 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="12"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<CompatibilityMode Value="True"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<Title Value="sliderdemo"/>
|
||||||
|
<Scaled Value="True"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
<XPManifest>
|
||||||
|
<DpiAware Value="True"/>
|
||||||
|
</XPManifest>
|
||||||
|
<Icon Value="0"/>
|
||||||
|
</General>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<UseFileFilters Value="True"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<FormatVersion Value="2"/>
|
||||||
|
<Modes Count="0"/>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="2">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="industrial"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item2>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="2">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="sliderdemo.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="main.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="Form1"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="sliderdemo"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
@ -0,0 +1,22 @@
|
|||||||
|
program sliderdemo;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
Interfaces, // this includes the LCL widgetset
|
||||||
|
Forms, main
|
||||||
|
{ you can add units after this };
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
RequireDerivedFormResource:=True;
|
||||||
|
Application.Scaled:=True;
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
||||||
@ -33,10 +33,11 @@
|
|||||||
- analog gauges
|
- analog gauges
|
||||||
- thermometer-like gauge
|
- thermometer-like gauge
|
||||||
- knob
|
- knob
|
||||||
- on/off switch"/>
|
- on/off switch
|
||||||
|
- multislider"/>
|
||||||
<License Value="MPL + GPL + modified LGPL (see unit headers)."/>
|
<License Value="MPL + GPL + modified LGPL (see unit headers)."/>
|
||||||
<Version Minor="3"/>
|
<Version Minor="4"/>
|
||||||
<Files Count="13">
|
<Files Count="14">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="source\indled.pas"/>
|
<Filename Value="source\indled.pas"/>
|
||||||
<UnitName Value="IndLed"/>
|
<UnitName Value="IndLed"/>
|
||||||
@ -90,7 +91,12 @@
|
|||||||
<Filename Value="source\switches.pas"/>
|
<Filename Value="source\switches.pas"/>
|
||||||
<UnitName Value="switches"/>
|
<UnitName Value="switches"/>
|
||||||
</Item13>
|
</Item13>
|
||||||
|
<Item14>
|
||||||
|
<Filename Value="source\indsliders.pas"/>
|
||||||
|
<UnitName Value="indsliders"/>
|
||||||
|
</Item14>
|
||||||
</Files>
|
</Files>
|
||||||
|
<LazDoc Paths="D:\Prog_Lazarus\svn\lazarus-ccr\components\industrialstuff\fpdoc"/>
|
||||||
<RequiredPkgs Count="1">
|
<RequiredPkgs Count="1">
|
||||||
<Item1>
|
<Item1>
|
||||||
<PackageName Value="IDEIntf"/>
|
<PackageName Value="IDEIntf"/>
|
||||||
|
|||||||
@ -10,7 +10,7 @@ interface
|
|||||||
uses
|
uses
|
||||||
IndLed, Sensors, AllIndustrialRegister, LedNumber, indGnouMeter, AdvLed,
|
IndLed, Sensors, AllIndustrialRegister, LedNumber, indGnouMeter, AdvLed,
|
||||||
indcyBaseLed, indcyClasses, indcyGraphics, indcyTypes, A3nalogGauge, MKnob,
|
indcyBaseLed, indcyClasses, indcyGraphics, indcyTypes, A3nalogGauge, MKnob,
|
||||||
switches, LazarusPackageIntf;
|
switches, indSliders, LazarusPackageIntf;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
|||||||
@ -13,3 +13,6 @@ tmknob_200.png
|
|||||||
tonoffswitch.png
|
tonoffswitch.png
|
||||||
tonoffswitch_150.png
|
tonoffswitch_150.png
|
||||||
tonoffswitch_200.png
|
tonoffswitch_200.png
|
||||||
|
tmultislider.png
|
||||||
|
tmultislider_150.png
|
||||||
|
tmultislider_200.png
|
||||||
|
|||||||
BIN
components/industrialstuff/resources/tmultislider.png
Normal file
BIN
components/industrialstuff/resources/tmultislider.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 534 B |
BIN
components/industrialstuff/resources/tmultislider_150.png
Normal file
BIN
components/industrialstuff/resources/tmultislider_150.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 778 B |
BIN
components/industrialstuff/resources/tmultislider_200.png
Normal file
BIN
components/industrialstuff/resources/tmultislider_200.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 935 B |
@ -12,7 +12,7 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, LResources, AdvLed, IndLed, LedNumber, Sensors, IndGnouMeter,
|
Classes, LResources, AdvLed, IndLed, LedNumber, Sensors, IndGnouMeter,
|
||||||
A3nalogGauge, MKnob, Switches;
|
A3nalogGauge, MKnob, Switches, indSliders;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
|
|
||||||
@ -25,7 +25,8 @@ procedure Register;
|
|||||||
begin
|
begin
|
||||||
RegisterComponents ('Industrial',[
|
RegisterComponents ('Industrial',[
|
||||||
TAdvLed, TIndLed, TLedNumber, TStopLightSensor,
|
TAdvLed, TIndLed, TLedNumber, TStopLightSensor,
|
||||||
TAnalogSensor, TA3nalogGauge, TindGnouMeter, TmKnob, TOnOffSwitch
|
TAnalogSensor, TA3nalogGauge, TindGnouMeter,
|
||||||
|
TmKnob, TOnOffSwitch, TMultiSlider
|
||||||
]);
|
]);
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|||||||
853
components/industrialstuff/source/indsliders.pas
Normal file
853
components/industrialstuff/source/indsliders.pas
Normal file
@ -0,0 +1,853 @@
|
|||||||
|
{
|
||||||
|
/***************************************************************************
|
||||||
|
indSliders
|
||||||
|
----------
|
||||||
|
sliders for the Industrial package
|
||||||
|
|
||||||
|
The initial version of this unit was published in the Lazarus forum
|
||||||
|
by user bylaardt
|
||||||
|
(https://forum.lazarus.freepascal.org/index.php/topic,45063.msg318180.html#msg318180)
|
||||||
|
and extended by wp.
|
||||||
|
|
||||||
|
License: modified LGPL like Lazarus LCL
|
||||||
|
*****************************************************************************
|
||||||
|
}
|
||||||
|
|
||||||
|
unit indSliders;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Graphics, Controls, Types;
|
||||||
|
|
||||||
|
const
|
||||||
|
DEFAULT_SIZE = 28;
|
||||||
|
DEFAULT_TRACK_THICKNESS = 7;
|
||||||
|
DEFAULT_MULTISLIDER_WIDTH = 250;
|
||||||
|
DEFAULT_MULTISLIDER_HEIGHT = DEFAULT_SIZE * 5 div 4;
|
||||||
|
|
||||||
|
Type
|
||||||
|
|
||||||
|
{ TMultiSlider }
|
||||||
|
|
||||||
|
TSliderMode = (smSingle, smMinMax, smMinValueMax);
|
||||||
|
|
||||||
|
TThumbKind = (tkMin, tkMax, tkValue);
|
||||||
|
|
||||||
|
TThumbstyle = (tsGrip, tsCircle, tsRect, tsRoundedRect,
|
||||||
|
tsTriangle, tsTriangleOtherSide);
|
||||||
|
|
||||||
|
TSliderPositionEvent = procedure (
|
||||||
|
Sender: TObject; AKind: TThumbKind; AValue: Integer) of object;
|
||||||
|
|
||||||
|
TMultiSlider = class(TCustomControl)
|
||||||
|
private
|
||||||
|
FAutoRotate: Boolean;
|
||||||
|
FTrackSize: TPoint;
|
||||||
|
FBtnSize: TPoint;
|
||||||
|
FCapture: ShortInt;
|
||||||
|
FCaptureOffset, FTrackStart: Integer;
|
||||||
|
FColorAbove: TColor;
|
||||||
|
FColorBelow: TColor;
|
||||||
|
FColorBetween: TColor;
|
||||||
|
FColorThumb: TColor;
|
||||||
|
FFlat: Boolean;
|
||||||
|
FVertical: boolean;
|
||||||
|
FMaxPosition, FMinPosition, FPosition: Integer;
|
||||||
|
FDefaultSize: Integer;
|
||||||
|
FSliderMode: TSliderMode;
|
||||||
|
FThumbStyle: TThumbstyle;
|
||||||
|
FTrackThickness: Integer;
|
||||||
|
FOnPositionChange: TSliderPositionEvent;
|
||||||
|
FRangeMax, FRangeMin: Integer;
|
||||||
|
function IsDefaultSizeStored: Boolean;
|
||||||
|
function IsTrackThicknessStored: Boolean;
|
||||||
|
procedure SetColorAbove(AValue: TColor);
|
||||||
|
procedure SetColorBelow(AValue: TColor);
|
||||||
|
procedure SetColorBetween(AValue: TColor);
|
||||||
|
procedure SetColorThumb(AValue: TColor);
|
||||||
|
procedure SetDefaultSize(AValue: Integer);
|
||||||
|
procedure SetFlat(AValue: Boolean);
|
||||||
|
procedure SetMaxPosition(AValue: Integer);
|
||||||
|
procedure SetMinPosition(AValue: Integer);
|
||||||
|
procedure SetPosition(AValue: Integer);
|
||||||
|
procedure SetRangeMax(AValue: Integer);
|
||||||
|
procedure SetRangeMin(AValue: Integer);
|
||||||
|
procedure SetSliderMode(AValue: TSliderMode);
|
||||||
|
procedure SetThumbStyle(AValue: TThumbStyle);
|
||||||
|
procedure SetTrackThickness(AValue: Integer);
|
||||||
|
procedure SetVertical(AValue: Boolean);
|
||||||
|
protected
|
||||||
|
function BtnLength: Integer;
|
||||||
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
||||||
|
const AXProportion, AYProportion: Double); override;
|
||||||
|
procedure DoPositionChange(AKind: TThumbKind; AValue: Integer);
|
||||||
|
function ExtendedThumbs: Boolean;
|
||||||
|
function GetRectFromPoint(APosition: Integer; Alignment: TAlignment): TRect;
|
||||||
|
function GetThumbCenter(ARect: TRect): TPoint;
|
||||||
|
function GetTrackLength: Integer;
|
||||||
|
function IsInFirstHalf(APoint: TPoint; ARect: TRect): Boolean;
|
||||||
|
procedure Loaded; override;
|
||||||
|
function PointToPosition(P: TPoint): Integer;
|
||||||
|
procedure UpdateBounds;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Paint; override;
|
||||||
|
procedure Resize; override;
|
||||||
|
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
||||||
|
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
|
||||||
|
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
||||||
|
procedure MouseLeave; override;
|
||||||
|
|
||||||
|
published
|
||||||
|
property AutoRotate: Boolean
|
||||||
|
read FAutoRotate write FAutoRotate default true;
|
||||||
|
property ColorAbove: TColor
|
||||||
|
read FColorAbove write SetColorAbove default clInactiveCaption;
|
||||||
|
property ColorBelow: TColor
|
||||||
|
read FColorBelow write SetColorBelow default clInactiveCaption;
|
||||||
|
property ColorBetween: TColor
|
||||||
|
read FColorBetween write SetColorBetween default clActiveCaption;
|
||||||
|
property ColorThumb: TColor
|
||||||
|
read FColorThumb write SetColorThumb default clBtnFace;
|
||||||
|
property DefaultSize: Integer
|
||||||
|
read FDefaultSize write SetDefaultSize stored IsDefaultSizeStored;
|
||||||
|
property Flat: Boolean
|
||||||
|
read FFlat write SetFlat default false;
|
||||||
|
property MaxPosition: Integer
|
||||||
|
read FMaxPosition write SetMaxPosition default 80;
|
||||||
|
property MinPosition: Integer
|
||||||
|
read FMinPosition write SetMinPosition default 20;
|
||||||
|
property Position: Integer
|
||||||
|
read FPosition write SetPosition default 50;
|
||||||
|
property RangeMax: Integer
|
||||||
|
read FRangeMax write SetRangeMax default 100;
|
||||||
|
property RangeMin: Integer
|
||||||
|
read FRangeMin write SetRangeMin default 0;
|
||||||
|
property SliderMode: TSliderMode
|
||||||
|
read FSliderMode write SetSliderMode default smMinMax;
|
||||||
|
property ThumbStyle: TThumbStyle
|
||||||
|
read FThumbStyle write SetThumbStyle default tsGrip;
|
||||||
|
property TrackThickness: integer
|
||||||
|
read FTrackThickness write SetTrackThickness stored IsTrackThicknessStored;
|
||||||
|
property Vertical: boolean
|
||||||
|
read FVertical write SetVertical default false;
|
||||||
|
|
||||||
|
property Height default DEFAULT_SIZE;
|
||||||
|
property Width default DEFAULT_MULTISLIDER_WIDTH;
|
||||||
|
property OnPositionChange: TSliderPositionEvent
|
||||||
|
read FOnPositionChange write FOnPositionChange;
|
||||||
|
|
||||||
|
property Align;
|
||||||
|
property BorderSpacing;
|
||||||
|
property Constraints;
|
||||||
|
property Enabled;
|
||||||
|
// property Font;
|
||||||
|
property HelpContext;
|
||||||
|
property HelpKeyword;
|
||||||
|
property HelpType;
|
||||||
|
property Left;
|
||||||
|
// property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property Tag;
|
||||||
|
property Top;
|
||||||
|
property Visible;
|
||||||
|
|
||||||
|
property OnChangeBounds;
|
||||||
|
property OnClick;
|
||||||
|
property OnContextPopup;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseEnter;
|
||||||
|
property OnMouseLeave;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnMouseWheel;
|
||||||
|
property OnMouseWheelDown;
|
||||||
|
property OnMouseWheelUp;
|
||||||
|
property OnMouseWheelHorz;
|
||||||
|
property OnMouseWheelLeft;
|
||||||
|
property OnMouseWheelRight;
|
||||||
|
property OnResize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Math;
|
||||||
|
|
||||||
|
constructor TMultiSlider.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
FAutoRotate := true;
|
||||||
|
FCapture := -1;
|
||||||
|
FColorAbove := clInactiveCaption;
|
||||||
|
FColorBelow := clInactiveCaption;
|
||||||
|
FColorBetween := clActiveCaption;
|
||||||
|
FColorThumb := clBtnFace;
|
||||||
|
FDefaultSize := Scale96ToFont(DEFAULT_SIZE);
|
||||||
|
FTrackThickness := Scale96ToFont(DEFAULT_TRACK_THICKNESS);
|
||||||
|
FTrackStart := FDefaultSize*9 div 16 + 2;
|
||||||
|
SetVertical(false);
|
||||||
|
FRangeMin := 0;
|
||||||
|
FRangeMax := 100;
|
||||||
|
FMinPosition := 20;
|
||||||
|
FMaxPosition := 80;
|
||||||
|
FPosition := 50;
|
||||||
|
FSliderMode := smMinMax;
|
||||||
|
|
||||||
|
Width := DEFAULT_MULTISLIDER_WIDTH;
|
||||||
|
Height := DEFAULT_MULTISLIDER_HEIGHT;
|
||||||
|
Enabled := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TMultiSlider.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiSlider.BtnLength: Integer;
|
||||||
|
begin
|
||||||
|
Result := IfThen(FVertical, FBtnSize.Y, FBtnSize.X) div 2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.DoAutoAdjustLayout(
|
||||||
|
const AMode: TLayoutAdjustmentPolicy;
|
||||||
|
const AXProportion, AYProportion: Double);
|
||||||
|
begin
|
||||||
|
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
|
||||||
|
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
|
||||||
|
begin
|
||||||
|
DisableAutosizing;
|
||||||
|
try
|
||||||
|
if IsTrackThicknessStored then
|
||||||
|
if FVertical then
|
||||||
|
FTrackThickness := Round(FTrackThickness * AXProportion)
|
||||||
|
else
|
||||||
|
FTrackThickness := Round(FTrackThickness * AYProportion);
|
||||||
|
finally
|
||||||
|
EnableAutoSizing;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.DoPositionChange(AKind: TThumbKind; AValue: Integer);
|
||||||
|
begin
|
||||||
|
if Assigned(FOnPositionChange) then FOnPositionChange(self, AKind, AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiSlider.ExtendedThumbs: Boolean;
|
||||||
|
begin
|
||||||
|
Result := not (FThumbStyle in [tsTriangle, tsTriangleOtherSide]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiSlider.GetRectFromPoint(APosition: Integer;
|
||||||
|
Alignment: TAlignment): TRect;
|
||||||
|
var
|
||||||
|
relPos: Double;
|
||||||
|
begin
|
||||||
|
relPos := (APosition - FRangeMin) / (FRangeMax - FRangeMin);
|
||||||
|
if FVertical then begin
|
||||||
|
if ExtendedThumbs then
|
||||||
|
case Alignment of
|
||||||
|
taLeftJustify:
|
||||||
|
Result.Top := FTrackStart + Round(FTrackSize.Y * relPos) - FBtnSize.Y;
|
||||||
|
taCenter:
|
||||||
|
if FSliderMode = smSingle then
|
||||||
|
Result.Top := FTrackStart + Round((FTrackSize.Y + FBtnSize.Y) * relPos) - FBtnSize.Y
|
||||||
|
else
|
||||||
|
Result.Top := FTrackStart + Round((FTrackSize.Y - FBtnSize.Y) * relPos);
|
||||||
|
taRightJustify:
|
||||||
|
Result.Top := FTrackStart + Round(FTrackSize.Y * relPos);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result.Top := FTrackStart + Round(FTrackSize.Y * relPos) - FBtnSize.Y div 2;
|
||||||
|
Result.Left := (Width - FBtnSize.X) div 2;
|
||||||
|
end else begin
|
||||||
|
if ExtendedThumbs then
|
||||||
|
case Alignment of
|
||||||
|
taLeftJustify:
|
||||||
|
Result.Left := FTrackStart + Round(FTrackSize.X * relpos) - FBtnSize.X;
|
||||||
|
taCenter:
|
||||||
|
if FSliderMode = smSingle then
|
||||||
|
Result.Left := FTrackStart + Round((FTrackSize.X + FBtnSize.X) * relPos) - FBtnSize.X
|
||||||
|
else
|
||||||
|
Result.Left := FTrackStart + Round((FTrackSize.X - FBtnSize.X) * relPos);
|
||||||
|
taRightJustify:
|
||||||
|
Result.Left := FTrackStart + Round(FTrackSize.X * relPos);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result.Left := FTrackStart + Round(FTrackSize.X * relPos) - FBtnSize.X div 2;
|
||||||
|
Result.Top := (Height - FBtnSize.Y) div 2;
|
||||||
|
end;
|
||||||
|
Result.Right := Result.Left + FBtnSize.X;
|
||||||
|
Result.Bottom := Result.Top + FBtnSize.Y;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiSlider.GetThumbCenter(ARect: TRect): TPoint;
|
||||||
|
begin
|
||||||
|
Result := Point((ARect.Left + ARect.Right) div 2, (ARect.Top + ARect.Bottom) div 2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiSlider.GetTrackLength: Integer;
|
||||||
|
begin
|
||||||
|
if FVertical then
|
||||||
|
Result := FTrackSize.Y
|
||||||
|
else
|
||||||
|
Result := FTrackSize.X;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiSlider.IsDefaultSizeStored: Boolean;
|
||||||
|
begin
|
||||||
|
Result := FDefaultSize <> Scale96ToFont(DEFAULT_SIZE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiSlider.IsInFirstHalf(APoint: TPoint; ARect: TRect): Boolean;
|
||||||
|
begin
|
||||||
|
if FVertical then begin
|
||||||
|
ARect.Right := GetThumbCenter(ARect).X;
|
||||||
|
Result := PtInRect(ARect, APoint);
|
||||||
|
end else begin
|
||||||
|
ARect.Bottom := GetThumbCenter(ARect).Y;
|
||||||
|
Result := PtInRect(ARect, APoint);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiSlider.IsTrackThicknessStored: Boolean;
|
||||||
|
begin
|
||||||
|
Result := FTrackThickness <> Scale96ToFont(DEFAULT_TRACK_THICKNESS);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.Loaded;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
exit;
|
||||||
|
if FAutoRotate then begin
|
||||||
|
if (FVertical and (Width > Height)) or ((not FVertical) and (Width < Height)) then
|
||||||
|
SetBounds(Left, Top, Height, Width);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||||
|
X,Y: Integer);
|
||||||
|
var
|
||||||
|
p: TPoint;
|
||||||
|
btn1, btn2, btn3: TRect;
|
||||||
|
inFirstHalf3: Boolean;
|
||||||
|
begin
|
||||||
|
if Enabled then begin
|
||||||
|
p := Point(x,y);
|
||||||
|
btn1 := GetRectFromPoint(FMinPosition, taLeftJustify);
|
||||||
|
btn2 := GetRectFromPoint(FMaxPosition, taRightJustify);
|
||||||
|
btn3 := GetRectFromPoint(FPosition, taCenter);
|
||||||
|
FCapture := -1;
|
||||||
|
if (FSliderMode <> smSingle) and PtInRect(btn1, p) then begin
|
||||||
|
FCapture := ord(tkMin);
|
||||||
|
if ExtendedThumbs then
|
||||||
|
FCaptureOffset := IfThen(FVertical, Y - btn1.Bottom, X - btn1.Right)
|
||||||
|
else
|
||||||
|
FCaptureOffset := IfThen(FVertical, Y - GetThumbCenter(btn1).Y, X - GetThumbCenter(btn1).X);
|
||||||
|
end else
|
||||||
|
if (FSliderMode <> smSingle) and PtInRect(btn2, p) then begin
|
||||||
|
FCapture := ord(tkMax);
|
||||||
|
if ExtendedThumbs then
|
||||||
|
FCaptureOffset := IfThen(FVertical, Y - btn2.Top, X - btn2.Left)
|
||||||
|
else
|
||||||
|
FCaptureOffset := IfThen(FVertical, Y - GetThumbCenter(btn2).Y, X - GetThumbCenter(btn2).X)
|
||||||
|
end else
|
||||||
|
if (FSliderMode <> smMinMax) and PtInRect(btn3, p) then begin
|
||||||
|
FCapture := ord(tkValue);
|
||||||
|
if ExtendedThumbs then
|
||||||
|
FCaptureOffset := IfThen(FVertical, Y - btn3.Top, X - btn3.Left)
|
||||||
|
else
|
||||||
|
FCaptureOffset := IfThen(FVertical, Y - GetThumbCenter(btn3).Y, X - GetThumbCenter(btn3).X);
|
||||||
|
end;
|
||||||
|
if (FCapture > -1) and (not ExtendedThumbs and PtInRect(btn3, p)) then begin
|
||||||
|
inFirstHalf3 := IsInFirstHalf(p, btn3);
|
||||||
|
if (TThumbKind(FCapture) in [tkMin, tkMax]) and (
|
||||||
|
(inFirstHalf3 and (FThumbStyle = tsTriangleOtherSide)) or
|
||||||
|
((not inFirstHalf3) and (FThumbStyle = tsTriangle))
|
||||||
|
) then
|
||||||
|
begin
|
||||||
|
FCapture := ord(tkValue);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
inherited MouseDown(Button, Shift, X, Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||||
|
var
|
||||||
|
p: TPoint;
|
||||||
|
btn: TRect;
|
||||||
|
pos: Integer;
|
||||||
|
begin
|
||||||
|
if Enabled then begin
|
||||||
|
p := Point(X, Y);
|
||||||
|
case FCapture of
|
||||||
|
-1: begin
|
||||||
|
btn := GetRectFromPoint(FMinPosition, taLeftJustify);
|
||||||
|
if PtInRect(btn, p) then begin
|
||||||
|
Cursor := crHandPoint;
|
||||||
|
end else begin
|
||||||
|
btn := GetRectFromPoint(FMaxPosition, taRightJustify);
|
||||||
|
if PtInRect(btn, p) then begin
|
||||||
|
Cursor := crHandPoint;
|
||||||
|
end else
|
||||||
|
Cursor := crDefault;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
pos := PointToPosition(p);
|
||||||
|
case TThumbKind(FCapture) of
|
||||||
|
tkMin: if FSliderMode <> smSingle then SetMinPosition(pos);
|
||||||
|
tkMax: if FSliderMode <> smSingle then SetMaxPosition(pos);
|
||||||
|
tkValue: if FSliderMode <> smMinMax then SetPosition(pos);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
inherited MouseMove(Shift,x,y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.MouseLeave;
|
||||||
|
begin
|
||||||
|
inherited MouseLeave;
|
||||||
|
FCapture := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||||
|
X, Y: Integer);
|
||||||
|
begin
|
||||||
|
FCapture := -1;
|
||||||
|
inherited MouseUp(Button,Shift,x,y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.Paint;
|
||||||
|
|
||||||
|
procedure DrawLine(ARect: TRect; AColor, AShadow, AHilight: TColor);
|
||||||
|
var
|
||||||
|
start, ending, distances, centerpoint, loop: Integer;
|
||||||
|
begin
|
||||||
|
distances := FDefaultSize div 8;
|
||||||
|
start := ARect.Left + FBtnSize.x div 2 - distances*8 div 5;
|
||||||
|
ending := start + distances*16 div 5;
|
||||||
|
centerPoint := (ARect.Bottom - ARect.Top) div 2 + ARect.Top;
|
||||||
|
for loop := -1 to 1 do begin
|
||||||
|
Canvas.Pen.Color := AHilight;
|
||||||
|
Canvas.MoveTo(start, centerPoint - 1 + loop * distances);
|
||||||
|
Canvas.LineTo(ending, centerPoint - 1 + loop * distances);
|
||||||
|
|
||||||
|
Canvas.Pen.Color := AColor;
|
||||||
|
Canvas.MoveTo(start, centerPoint + loop * distances);
|
||||||
|
Canvas.LineTo(ending, centerPoint + loop * distances);
|
||||||
|
|
||||||
|
Canvas.Pen.Color := AShadow;
|
||||||
|
Canvas.MoveTo(start, centerPoint + 1 + loop * distances);
|
||||||
|
Canvas.LineTo(ending, centerPoint + 1 + loop * distances);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure DrawRect(ARect: TRect; X1,Y1, X2,Y2, R: Integer; AColor: TColor);
|
||||||
|
begin
|
||||||
|
Canvas.Pen.Color := AColor;
|
||||||
|
Canvas.Pen.Width := 1;
|
||||||
|
Canvas.Brush.Color := Canvas.Pen.Color;
|
||||||
|
Canvas.RoundRect(
|
||||||
|
ARect.Left + X1,
|
||||||
|
ARect.Top + Y1,
|
||||||
|
ARect.Right + X2,
|
||||||
|
ARect.Bottom + Y2,
|
||||||
|
R, R);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure DrawThumb(ARect, ATrackRect: TRect; InFirstHalf: Boolean);
|
||||||
|
var
|
||||||
|
radius: Integer;
|
||||||
|
center: TPoint;
|
||||||
|
P: array[0..2] of TPoint;
|
||||||
|
begin
|
||||||
|
case FThumbStyle of
|
||||||
|
tsGrip, tsRoundedRect:
|
||||||
|
begin
|
||||||
|
radius := Min(FBtnSize.X, FBtnSize.Y) div 2;
|
||||||
|
if FFlat then
|
||||||
|
DrawRect(ARect, 0, 0, 0, 0, radius, FColorThumb)
|
||||||
|
else begin
|
||||||
|
DrawRect(ARect, 0, 0, -1, -1, radius, clBtnHighlight);
|
||||||
|
DrawRect(ARect, 1, 1, 0, 0, radius, clBtnShadow);
|
||||||
|
DrawRect(ARect, 1, 1, -1, -1, radius, FColorThumb);
|
||||||
|
end;
|
||||||
|
if FThumbStyle = tsGrip then
|
||||||
|
DrawLine(ARect, FColorThumb, clBtnShadow, clBtnHighlight);
|
||||||
|
end;
|
||||||
|
tsCircle:
|
||||||
|
begin
|
||||||
|
center := Point((ARect.Left + ARect.Right) div 2, (ARect.Top + ARect.Bottom) div 2);
|
||||||
|
radius := Min(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top) div 2;
|
||||||
|
if not FFlat then begin
|
||||||
|
Canvas.Brush.Style := bsClear;
|
||||||
|
Canvas.Pen.Color := clBtnHighlight;
|
||||||
|
Canvas.Ellipse(center.X - radius - 1, center.Y - radius - 1, center.X + radius - 1, center.Y + radius - 1);
|
||||||
|
Canvas.Pen.Color := clBtnShadow;
|
||||||
|
Canvas.Ellipse(center.X - radius + 1, center.Y - radius + 1, center.X + radius + 1, center.Y + radius + 1);
|
||||||
|
end;
|
||||||
|
Canvas.Brush.Style := bsSolid;
|
||||||
|
Canvas.Brush.Color := FColorThumb;
|
||||||
|
Canvas.Pen.Color := FColorThumb;
|
||||||
|
Canvas.Ellipse(center.X - radius, center.Y - radius, center.X + radius, center.Y + radius);
|
||||||
|
end;
|
||||||
|
tsRect:
|
||||||
|
begin
|
||||||
|
if not FFlat then begin
|
||||||
|
Canvas.Brush.Style := bsClear;
|
||||||
|
Canvas.Pen.Color := clBtnHighlight;
|
||||||
|
Canvas.Rectangle(ARect.Left - 1, ARect.Top - 1, ARect.Right - 1, ARect.Bottom - 1);
|
||||||
|
Canvas.Pen.Color := clBtnShadow;
|
||||||
|
Canvas.Rectangle(ARect.Left + 1, ARect.Top + 1, ARect.Right + 1, ARect.Bottom + 1);
|
||||||
|
end;
|
||||||
|
Canvas.Brush.Style := bsSolid;
|
||||||
|
Canvas.Brush.Color := FColorThumb;
|
||||||
|
Canvas.Pen.Color := FColorThumb;
|
||||||
|
Canvas.Rectangle(ARect);
|
||||||
|
end;
|
||||||
|
tsTriangle, tsTriangleOtherSide:
|
||||||
|
begin
|
||||||
|
if FVertical then begin
|
||||||
|
if InFirstHalf then begin
|
||||||
|
P[0] := Point(ARect.Left, ARect.Top);
|
||||||
|
P[1] := Point(ARect.Left, ARect.Bottom);
|
||||||
|
P[2] := Point(ATrackRect.Left, GetThumbCenter(ARect).Y);
|
||||||
|
end else begin
|
||||||
|
P[0] := Point(ARect.Right, ARect.Top);
|
||||||
|
P[1] := Point(ARect.Right, ARect.Bottom);
|
||||||
|
P[2] := Point(ATrackRect.Right, GetThumbCenter(ARect).Y);
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
if InFirstHalf then begin
|
||||||
|
P[0] := Point(ARect.Left, ARect.Bottom);
|
||||||
|
P[1] := Point(ARect.Right, ARect.Bottom);
|
||||||
|
P[2] := Point(GetThumbCenter(ARect).X, ATrackRect.Bottom);
|
||||||
|
end else begin
|
||||||
|
P[0] := Point(ARect.Left, ARect.Top);
|
||||||
|
P[1] := Point(ARect.Right, ARect.Top);
|
||||||
|
P[2] := Point(GetThumbCenter(ARect).X, ATrackRect.Top);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if not FFlat then begin
|
||||||
|
Canvas.Brush.Style := bsClear;
|
||||||
|
Canvas.Pen.Color := clBtnHighlight;
|
||||||
|
Canvas.Polygon([Point(P[0].X-1, P[0].Y-1), Point(P[1].X-1, P[1].Y-1), Point(P[2].X-1, P[2].Y-1)]);
|
||||||
|
Canvas.Pen.Color := clBtnShadow;
|
||||||
|
Canvas.Polygon([Point(P[0].X+1, P[0].Y+1), Point(P[1].X+1, P[1].Y+1), Point(P[2].X+1, P[2].Y+1)]);
|
||||||
|
end;
|
||||||
|
Canvas.Brush.Style := bsSolid;
|
||||||
|
Canvas.Brush.Color := FColorThumb;
|
||||||
|
Canvas.Pen.Color := FColorThumb;
|
||||||
|
Canvas.Polygon(P);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
R: Integer;
|
||||||
|
track, rang, btn1, btn2, btn: TRect;
|
||||||
|
rectBelow, rectAbove: TRect;
|
||||||
|
dx, dy: Integer;
|
||||||
|
begin
|
||||||
|
if FVertical then begin
|
||||||
|
track.Left := (Width - FTrackSize.X) div 2;
|
||||||
|
track.Top := FTrackStart;
|
||||||
|
end else begin
|
||||||
|
track.Left := FTrackStart;
|
||||||
|
track.Top := (Height - FTrackSize.Y) div 2;
|
||||||
|
end;
|
||||||
|
track.Right := track.Left + FTrackSize.x;
|
||||||
|
track.Bottom := track.Top + FTrackSize.y;
|
||||||
|
|
||||||
|
btn1 := GetRectFromPoint(FMinPosition, taLeftJustify);
|
||||||
|
btn2 := GetRectFromPoint(FMaxPosition, taRightJustify);
|
||||||
|
btn := GetRectFromPoint(FPosition, taCenter);
|
||||||
|
|
||||||
|
if FVertical then begin
|
||||||
|
dx := 0;
|
||||||
|
dy := IfThen(ExtendedThumbs, FBtnSize.Y, 0);
|
||||||
|
rang.Top := IfThen(ExtendedThumbs, btn1.Bottom, GetThumbCenter(btn1).Y);
|
||||||
|
rang.Bottom := IfThen(ExtendedThumbs, btn2.Top, GetThumbCenter(btn2).Y);
|
||||||
|
rang.Left := track.Left;
|
||||||
|
rang.Right := track.Right;
|
||||||
|
if FSliderMode = smSingle then begin
|
||||||
|
rectBelow := Rect(track.Left, track.Top, track.Right, IfThen(ExtendedThumbs, btn.Top, GetThumbCenter(btn).Y));
|
||||||
|
rectAbove := Rect(track.Left, IfThen(ExtendedThumbs, btn.Bottom, GetThumbCenter(btn).Y), track.Right, track.bottom);
|
||||||
|
end else begin
|
||||||
|
rectBelow := Rect(track.Left, track.Top, track.Right, rang.Top);
|
||||||
|
rectAbove := Rect(track.Left, rang.Bottom, track.Right, track.Bottom);
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
dx := IfThen(ExtendedThumbs, FBtnSize.X, 0);
|
||||||
|
dy := 0;
|
||||||
|
rang.Top := track.Top;
|
||||||
|
rang.Bottom := track.Bottom;
|
||||||
|
rang.Left := IfThen(ExtendedThumbs, btn1.Right, GetThumbCenter(btn1).X);
|
||||||
|
rang.Right := IfThen(ExtendedThumbs, btn2.Left, GetThumbCenter(btn2).X);
|
||||||
|
if FSliderMode = smSingle then begin
|
||||||
|
rectBelow := Rect(track.Left, track.Top, IfThen(ExtendedThumbs, btn.Left, GetThumbCenter(btn).X), track.Bottom);
|
||||||
|
rectAbove := Rect(IfThen(ExtendedThumbs, btn.Right, GetThumbCenter(btn).X), track.Top, track.Right, track.Bottom);
|
||||||
|
end else begin
|
||||||
|
rectBelow := Rect(track.Left, track.Top, rang.Left, track.Bottom);
|
||||||
|
rectAbove := Rect(rang.Right, track.Top, track.Right, track.Bottom)
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
R := IfThen(ExtendedThumbs, Min(FTrackSize.X, FTrackSize.Y), 0);
|
||||||
|
if not Flat then begin
|
||||||
|
DrawRect(track, -(dx+2), -(dy+2), dx, dy, R, clBtnShadow);
|
||||||
|
DrawRect(track, -dx, -dy, dx+2, dy+2, R, clBtnHighlight);
|
||||||
|
end;
|
||||||
|
DrawRect(rectBelow, -(dx+1), -(dy+1), dx+1, dy+1, R, FColorBelow);
|
||||||
|
DrawRect(rectAbove, -(dx+1), -(dy+1), dx+1, dy+1, R, FColorAbove);
|
||||||
|
if FSliderMode <> smSingle then
|
||||||
|
DrawRect(rang, -1, -1, 1, 1, 0, FColorBetween);
|
||||||
|
|
||||||
|
if (FSliderMode <> smSingle) then begin
|
||||||
|
DrawThumb(btn1, track, FThumbStyle = tsTriangleOtherSide);
|
||||||
|
DrawThumb(btn2, track, FThumbStyle = tsTriangleOtherSide);
|
||||||
|
end;
|
||||||
|
if (FSliderMode <> smMinMax) then
|
||||||
|
DrawThumb(btn, track, FThumbStyle <> tsTriangleOtherSide);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiSlider.PointToPosition(P: TPoint): Integer;
|
||||||
|
var
|
||||||
|
pos_start, pos_range: Integer;
|
||||||
|
coord: Integer;
|
||||||
|
coord_range: Integer;
|
||||||
|
coord_start: Integer;
|
||||||
|
btn1, btn2: TRect;
|
||||||
|
begin
|
||||||
|
if FVertical then
|
||||||
|
coord := P.Y
|
||||||
|
else
|
||||||
|
coord := P.X;
|
||||||
|
if (TThumbKind(FCapture) = tkValue) and (FSliderMode <> smSingle) then begin
|
||||||
|
btn1 := GetRectFromPoint(FMinPosition, taLeftJustify);
|
||||||
|
btn2 := GetRectFromPoint(FMaxPosition, taRightJustify);
|
||||||
|
pos_start := FMinPosition;
|
||||||
|
pos_range := FMaxPosition - FMinPosition;
|
||||||
|
if ExtendedThumbs then begin
|
||||||
|
if FVertical then begin
|
||||||
|
coord_start := btn1.Bottom + FCaptureOffset;
|
||||||
|
coord_range := btn2.Top - btn1.Bottom;
|
||||||
|
end else begin
|
||||||
|
coord_start := btn1.Right + FCaptureOffset;
|
||||||
|
coord_range := btn2.Left - btn1.Right;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
if FVertical then begin
|
||||||
|
coord_start := GetThumbCenter(btn1).Y + FCaptureOffset;
|
||||||
|
coord_range := btn2.Top - btn1.Top;
|
||||||
|
end else begin
|
||||||
|
coord_start := GetThumbCenter(btn1).X + FCaptureOffset;
|
||||||
|
coord_range := btn2.Left - btn1.Left;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{
|
||||||
|
if FThumbStyle = tsTriangle then begin
|
||||||
|
if FVertical then begin
|
||||||
|
end else begin
|
||||||
|
coord_start := (btn1.Left + btn1.Right) div 2 + FCaptureOffset;
|
||||||
|
coord_range := btn2.Left - btn1.Left;
|
||||||
|
end
|
||||||
|
end else begin
|
||||||
|
if FVertical then begin
|
||||||
|
coord_start := btn1.Top + FCaptureOffset;
|
||||||
|
coord_range := btn2.Top - btn1.Bottom;
|
||||||
|
end else begin
|
||||||
|
coord_start := btn1.Right + FCaptureOffset;
|
||||||
|
coord_range := btn2.Left - btn1.Right;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
}
|
||||||
|
end else begin
|
||||||
|
pos_start := FRangeMin;
|
||||||
|
pos_range := FRangeMax - FRangeMin;
|
||||||
|
coord_start := FTrackStart + FCaptureOffset;
|
||||||
|
coord_range := GetTracklength;
|
||||||
|
end;
|
||||||
|
Result := round(pos_start + pos_range * (coord - coord_start) / coord_range);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.Resize;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
UpdateBounds;
|
||||||
|
end;
|
||||||
|
{
|
||||||
|
procedure TMultiSlider.SetColor(AValue: TColor);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
if AValue = clNone then
|
||||||
|
ControlStyle := ControlStyle - [csOpaque]
|
||||||
|
else
|
||||||
|
ControlStyle := ControlStyle + [csOpaque];
|
||||||
|
end; }
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetColorAbove(AValue: TColor);
|
||||||
|
begin
|
||||||
|
if AValue = FColorAbove then exit;
|
||||||
|
FColorAbove := AValue;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetColorBelow(AValue: TColor);
|
||||||
|
begin
|
||||||
|
if AValue = FColorBelow then exit;
|
||||||
|
FColorBelow := AValue;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetColorBetween(AValue: TColor);
|
||||||
|
begin
|
||||||
|
if AValue = FColorBetween then exit;
|
||||||
|
FColorBetween := AValue;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetColorThumb(AValue: TColor);
|
||||||
|
begin
|
||||||
|
if AValue = FColorThumb then exit;
|
||||||
|
FColorThumb := AValue;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetDefaultSize(AValue: Integer);
|
||||||
|
begin
|
||||||
|
if FDefaultSize = AValue then exit;
|
||||||
|
FDefaultSize := AValue;
|
||||||
|
if AutoSize then begin
|
||||||
|
if FVertical then Width := FDefaultSize else Height := FDefaultSize;
|
||||||
|
end;
|
||||||
|
UpdateBounds;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetFlat(AValue: Boolean);
|
||||||
|
begin
|
||||||
|
if FFlat = AValue then exit;
|
||||||
|
FFlat := AValue;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetMaxPosition(AValue: Integer);
|
||||||
|
var
|
||||||
|
newPos: Integer;
|
||||||
|
begin
|
||||||
|
newPos := Min(Max(AValue, FRangeMin), FRangeMax);
|
||||||
|
if (newPos = FMaxPosition) then exit;
|
||||||
|
if (newPos < FMinPosition) and (FSliderMode <> smSingle) then newPos := FMinPosition;
|
||||||
|
if (newPos < FPosition) and (FSliderMode <> smMinMax) then newPos := FPosition;
|
||||||
|
FMaxPosition := newPos;
|
||||||
|
DoPositionChange(tkMax, FMaxPosition);
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetMinPosition(AValue: Integer);
|
||||||
|
var
|
||||||
|
newPos: Integer;
|
||||||
|
begin
|
||||||
|
newPos := Max(Min(AValue, FRangeMax), FRangeMin);
|
||||||
|
if (newPos = FMinPosition) then exit;
|
||||||
|
if (newPos > FMaxPosition) and (FSliderMode <> smSingle) then newPos := FMaxPosition;
|
||||||
|
if (newPos > FPosition) and (FSliderMode <> smMinMax) then newPos := FPosition;
|
||||||
|
FMinPosition := newPos;
|
||||||
|
DoPositionChange(tkMin, FMinPosition);
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetPosition(AValue: Integer);
|
||||||
|
var
|
||||||
|
newPos: Integer;
|
||||||
|
begin
|
||||||
|
newPos := Max(Min(AValue, FRangeMax), FRangeMin);
|
||||||
|
if (newPos = FPosition) then exit;
|
||||||
|
if (FSliderMode <> smSingle) then begin
|
||||||
|
if (newPos < FMinPosition) then newPos := FMinPosition;
|
||||||
|
if (newPos > FMaxPosition) then newPos := FMaxPosition;
|
||||||
|
end;
|
||||||
|
FPosition := newPos;
|
||||||
|
DoPositionChange(tkValue, FPosition);
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetRangeMax(AValue:Integer);
|
||||||
|
begin
|
||||||
|
if FRangeMax = AValue then exit;
|
||||||
|
FRangeMax := AValue;
|
||||||
|
DoPositionChange(tkMax, FRangeMax);
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetRangeMin(AValue: Integer);
|
||||||
|
begin
|
||||||
|
if FRangeMin = AValue then exit;
|
||||||
|
FRangeMin := AValue;
|
||||||
|
DoPositionChange(tkMin, FRangeMin);
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetThumbStyle(AValue: TThumbStyle);
|
||||||
|
begin
|
||||||
|
if FThumbStyle = AValue then exit;
|
||||||
|
FThumbStyle := AValue;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetTrackThickness(AValue: Integer);
|
||||||
|
begin
|
||||||
|
if FTrackThickness = AValue then exit;
|
||||||
|
FTrackThickness := AValue;
|
||||||
|
UpdateBounds;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetVertical(AValue: Boolean);
|
||||||
|
begin
|
||||||
|
if FVertical = AValue then exit;
|
||||||
|
FVertical := AValue;
|
||||||
|
//if not (csLoading in ComponentState) then begin
|
||||||
|
if FAutoRotate then begin
|
||||||
|
if (FVertical and (Width > Height)) or ((not FVertical) and (Width < Height)) then
|
||||||
|
SetBounds(Left, Top, Height, Width);
|
||||||
|
end;
|
||||||
|
UpdateBounds;
|
||||||
|
//end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.SetSliderMode(AValue: TSliderMode);
|
||||||
|
begin
|
||||||
|
if FSliderMode = AValue then exit;
|
||||||
|
FSliderMode := AValue;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiSlider.UpdateBounds;
|
||||||
|
var
|
||||||
|
buttonSize: Integer;
|
||||||
|
begin
|
||||||
|
buttonSize := FDefaultSize*5 div 8;
|
||||||
|
if FVertical then begin
|
||||||
|
FBtnSize := Point(FDefaultSize, buttonSize);
|
||||||
|
FTrackSize := Point(FTrackThickness, Height - FTrackStart * 2);
|
||||||
|
end else begin
|
||||||
|
FBtnSize:= Point(buttonSize, FDefaultSize);
|
||||||
|
FTrackSize := Point(Width - FTrackStart * 2, FTrackThickness);
|
||||||
|
end;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
Binary file not shown.
@ -52,7 +52,7 @@ uses
|
|||||||
Controls, Forms, Dialogs, ComCtrls;
|
Controls, Forms, Dialogs, ComCtrls;
|
||||||
|
|
||||||
const
|
const
|
||||||
DEFAULT_KNOB_FACE_COLOR = clSilver; //$00B5CCBD;
|
DEFAULT_KNOB_FACE_COLOR = clSilver;
|
||||||
DEFAULT_KNOB_MARK_SIZE = 6;
|
DEFAULT_KNOB_MARK_SIZE = 6;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|||||||
Reference in New Issue
Block a user