📄 islidingscale.pas
字号:
FPointerLineColor := clBlue;
FTitleMargin := 0.5;
FTickMajorLabelFont := TFont.Create; FTickMajorLabelFont.OnChange := InvalidateChangeEvent;
FTickMidLabelFont := TFont.Create; FTickMidLabelFont.OnChange := InvalidateChangeEvent;
FTitleFont := TFont.Create; FTitleFont.OnChange := BackGroundChangeEvent;
end;
//****************************************************************************************************************************************************
destructor TiSlidingScale.Destroy;
begin
FTickMajorLabelFont.Free;
FTickMidLabelFont.Free;
FTitleFont.Free;
inherited;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.SetPointerColor (const Value:TColor );begin SetColorProperty (Value,FPointerColor, irtBackGround);end;
procedure TiSlidingScale.SetPointerLineColor (const Value:TColor );begin SetColorProperty (Value,FPointerLineColor, irtBackGround);end;
procedure TiSlidingScale.SetPointerLineWidth (const Value:Integer);begin SetIntegerProperty(Value,FPointerLineWidth, irtBackGround);end;
procedure TiSlidingScale.SetPointerSize (const Value:Integer);begin SetIntegerProperty(Value,FPointerSize, irtBackGround);end;
procedure TiSlidingScale.SetScaleBackgroundColor (const Value:TColor );begin SetColorProperty (Value,FScaleBackgroundColor, irtBackGround);end;
procedure TiSlidingScale.SetTickMajorColor (const Value:TColor );begin SetColorProperty (Value,FTickMajorColor, irtBackGround);end;
procedure TiSlidingScale.SetTickMajorCount (const Value:Integer);begin SetIntegerProperty(Value,FTickMajorCount, irtBackGround);end;
procedure TiSlidingScale.SetTickMajorLabelMargin (const Value:Double );begin SetDoubleProperty (Value,FTickMajorLabelMargin, irtBackGround);end;
procedure TiSlidingScale.SetTickMajorLabelPrecision(const Value:Integer);begin SetIntegerProperty(Value,FTickMajorLabelPrecision,irtBackGround);end;
procedure TiSlidingScale.SetTickMajorLength (const Value:Integer);begin SetIntegerProperty(Value,FTickMajorLength, irtBackGround);end;
procedure TiSlidingScale.SetTickMajorWidth (const Value:Integer);begin SetIntegerProperty(Value,FTickMajorWidth, irtBackGround);end;
procedure TiSlidingScale.SetTickMidColor (const Value:TColor );begin SetColorProperty (Value,FTickMidColor, irtBackGround);end;
procedure TiSlidingScale.SetTickMidLabelMargin (const Value:Double );begin SetDoubleProperty (Value,FTickMidLabelMargin, irtBackGround);end;
procedure TiSlidingScale.SetTickMidLength (const Value:Integer);begin SetIntegerProperty(Value,FTickMidLength, irtBackGround);end;
procedure TiSlidingScale.SetTickMidWidth (const Value:Integer);begin SetIntegerProperty(Value,FTickMidWidth, irtBackGround);end;
procedure TiSlidingScale.SetTickMinorColor (const Value:TColor );begin SetColorProperty (Value,FTickMinorColor, irtBackGround);end;
procedure TiSlidingScale.SetTickMinorCount (const Value:Integer);begin SetIntegerProperty(Value,FTickMinorCount, irtBackGround);end;
procedure TiSlidingScale.SetTickMinorWidth (const Value:Integer);begin SetIntegerProperty(Value,FTickMinorWidth, irtBackGround);end;
procedure TiSlidingScale.SetTickMinorLength (const Value:Integer);begin SetIntegerProperty(Value,FTickMinorLength, irtBackGround);end;
procedure TiSlidingScale.SetTickMidLabelPrecision (const Value:Integer);begin SetIntegerProperty(Value,FTickMidLabelPrecision, irtBackGround);end;
procedure TiSlidingScale.SetShowMidTickLabels (const Value:Boolean);begin SetBooleanProperty(Value,FShowMidTickLabels, irtBackGround);end;
procedure TiSlidingScale.SetShowMidTicks (const Value:Boolean);begin SetBooleanProperty(Value,FShowMidTicks, irtBackGround);end;
procedure TiSlidingScale.SetReverseScale (const Value:Boolean);begin SetBooleanProperty(Value,FReverseScale, irtBackGround);end;
procedure TiSlidingScale.SetScaleAntiAliasEnabled (const Value:Boolean);begin SetBooleanProperty(Value,FScaleAntiAliasEnabled, irtBackGround);end;
procedure TiSlidingScale.SetScaleShadowEnabled (const Value:Boolean);begin SetBooleanProperty(Value,FScaleShadowEnabled, irtBackGround);end;
procedure TiSlidingScale.SetScaleShadowColor (const Value:TColor );begin SetColorProperty (Value,FScaleShadowColor, irtBackGround);end;
procedure TiSlidingScale.SetOuterMarginBottom (const Value:Integer);begin SetIntegerProperty(Value,FOuterMarginBottom, irtBackGround);end;
procedure TiSlidingScale.SetOuterMarginLeft (const Value:Integer);begin SetIntegerProperty(Value,FOuterMarginLeft, irtBackGround);end;
procedure TiSlidingScale.SetOuterMarginRight (const Value:Integer);begin SetIntegerProperty(Value,FOuterMarginRight, irtBackGround);end;
procedure TiSlidingScale.SetOuterMarginTop (const Value:Integer);begin SetIntegerProperty(Value,FOuterMarginTop, irtBackGround);end;
procedure TiSlidingScale.SetTitleText (const Value:String );begin SetStringProperty (Value,FTitleText, irtBackGround);end;
procedure TiSlidingScale.SetTitleMargin (const Value:Double );begin SetDoubleProperty (Value,FTitleMargin, irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.SetTickMajorLabelFont(const Value: TFont);begin FTickMajorLabelFont.Assign(Value);end;
procedure TiSlidingScale.SetTickMidLabelFont (const Value: TFont);begin FTickMidLabelFont.Assign(Value); end;
procedure TiSlidingScale.SetTitleFont (const Value: TFont);begin FTitleFont.Assign(Value); end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.SetScaleSpan(const Value:Double );
var
TempValue : Double;
begin
TempValue := Value;
if TempValue < 0.1 then TempValue := 0.1;
SetDoubleProperty (TempValue,FScaleSpan, irtBackGround);
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.SetPointerStyle(const Value: TiSlidingScalePointerStyle);
begin
if FPointerStyle <> Value then
begin
FPointerStyle := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.SetScaleAlignStyle(const Value: TiScaleAlignStyle);
begin
if FScaleAlignStyle <> Value then
begin
FScaleAlignStyle := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.SetOrientation(const Value: TiOrientation);
var
TempWidth : Integer;
begin
if FOrientation <> Value then
begin
FOrientation := Value;
if not Loading then
begin
TempWidth := Width;
Width := Height;
Height := TempWidth;
if Assigned(FOnAutoSize) then FOnAutoSize(Self);
end;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.SetScaleOrientation(const Value: TiOrientationSide);
begin
if FScaleOrientation <> Value then
begin
FScaleOrientation := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.SetPointerOrientation(const Value: TiOrientationSide);
begin
if FPointerOrientation <> Value then
begin
FPointerOrientation := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.SetTitleAlignment(const Value: TiAlignmentSideVertical);
begin
if FTitleAlignment <> Value then
begin
FTitleAlignment := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.SetPosition(const Value: Double);
var
CanEdit : Boolean;
begin
if FPosition <> Value then
begin
CanEdit := True;
if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Position', CanEdit);
if CanEdit then
begin
FPosition := Value;
InvalidateChange;
if Assigned(OnChangeProtected) then OnChangeProtected(Self, 'Position');
end;
end;
end;
//****************************************************************************************************************************************************
function TiSlidingScale.GetPositionToPixels(Value: Double): Integer;
var
Center : Integer;
begin
case FOrientation of
ioVertical : begin
Center := (FScaleRect.Bottom + FScaleRect.Top ) div 2;
if FScaleSpan = 0 then Result := Center
else if FReverseScale then Result := Center + Round((FPosition - Value)/FScaleSpan*FRangePixels)
else Result := Center - Round((FPosition - Value)/FScaleSpan*FRangePixels);
end;
else begin
Center := (FScaleRect.Left + FScaleRect.Right) div 2;
if FScaleSpan = 0 then Result := Center
else if FReverseScale then Result := Center + Round((FPosition - Value)/FScaleSpan*FRangePixels)
else Result := Center - Round((FPosition - Value)/FScaleSpan*FRangePixels);
end;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.CalcPoints(Canvas: TCanvas);
var
WidthStart : Integer;
WidthStop : Integer;
HeightStart : integer;
HeightStop : Integer;
ScaleWidthStart : Integer;
ScaleWidthStop : Integer;
TickCount : Integer;
DrawRect : TRect;
TitleTotalHeight : Integer;
begin
FCenterPoint := GetCenterPoint(Canvas);
if Length(Trim(FTitleText)) <> 0 then
begin
Canvas.Font.Assign(FTitleFont);
TitleTotalHeight := Round(Canvas.TextHeight(FTitleText) * (1 + FTitleMargin));
end
else TitleTotalHeight := 0;
case FTitleAlignment of
iasvTop : DrawRect := Rect(FOuterMarginLeft, FOuterMarginTop + TitleTotalHeight, Width - FOuterMarginRight, Height - FOuterMarginBottom);
else DrawRect := Rect(FOuterMarginLeft, FOuterMarginTop, Width - FOuterMarginRight, Height - FOuterMarginBottom - TitleTotalHeight);
end;
case FOrientation of
ioVertical : begin
WidthStart := DrawRect.Left;
WidthStop := DrawRect.Right;
HeightStart := DrawRect.Bottom;
HeightStop := DrawRect.Top;
end;
else begin
WidthStart := DrawRect.Top;
WidthStop := DrawRect.Bottom;
HeightStart := DrawRect.Left;
HeightStop := DrawRect.Right;
end;
end;
case FPointerStyle of
isspsDualArrow : begin
case FPointerOrientation of
iosBottomRight : begin
ScaleWidthStart := WidthStart + FPointerSize;
ScaleWidthStop := WidthStop - FPointerSize;
end;
else begin
ScaleWidthStart := WidthStart + FPointerSize;
ScaleWidthStop := WidthStop - FPointerSize;
end;
end;
end;
isspsArrow : begin
case FPointerOrientation of
iosBottomRight : begin
ScaleWidthStart := WidthStart;
ScaleWidthStop := WidthStop - FPointerSize;
end;
else begin
ScaleWidthStart := WidthStart + FPointerSize;
ScaleWidthStop := WidthStop;
end;
end;
end;
isspsPointer : begin
case FPointerOrientation of
iosBottomRight : begin
ScaleWidthStart := WidthStart;
ScaleWidthStop := WidthStop - 2*FPointerSize;
end;
else begin
ScaleWidthStart := WidthStart + 2*FPointerSize;
ScaleWidthStop := WidthStop;
end;
end;
end;
else begin
ScaleWidthStart := WidthStart;
ScaleWidthStop := WidthStop;
end;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -