📄 islidingcompass.pas
字号:
FPointer2Style := isspsArrow;
FPointer2Size := 10;
FPointer2Color := clRed;
FPointer2LineWidth := 2;
FPointer2LineColor := clRed;
FTitleMargin := 0.5;
FTickMajorLabelFont := TFont.Create; FTickMajorLabelFont.OnChange := InvalidateChangeEvent;
FTickMidLabelFont := TFont.Create; FTickMidLabelFont.OnChange := InvalidateChangeEvent;
FTitleFont := TFont.Create; FTitleFont.OnChange := BackGroundChangeEvent;
end;
//****************************************************************************************************************************************************
destructor TiSlidingCompass.Destroy;
begin
FTickMajorLabelFont.Free;
FTickMidLabelFont.Free;
FTitleFont.Free;
inherited;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.SetPointer1Color (const Value:TColor );begin SetColorProperty (Value,FPointer1Color, irtBackGround);end;
procedure TiSlidingCompass.SetPointer1LineColor (const Value:TColor );begin SetColorProperty (Value,FPointer1LineColor, irtBackGround);end;
procedure TiSlidingCompass.SetPointer1LineWidth (const Value:Integer);begin SetIntegerProperty(Value,FPointer1LineWidth, irtBackGround);end;
procedure TiSlidingCompass.SetPointer1Size (const Value:Integer);begin SetIntegerProperty(Value,FPointer1Size, irtBackGround);end;
procedure TiSlidingCompass.SetPointer2Color (const Value:TColor); begin SetColorProperty (Value,FPointer2Color, irtBackGround);end;
procedure TiSlidingCompass.SetPointer2LineColor (const Value:TColor); begin SetColorProperty (Value,FPointer2LineColor, irtBackGround);end;
procedure TiSlidingCompass.SetPointer2LineWidth (const Value:Integer);begin SetIntegerProperty(Value,FPointer2LineWidth, irtBackGround);end;
procedure TiSlidingCompass.SetPointer2Size (const Value:Integer);begin SetIntegerProperty(Value,FPointer2Size, irtBackGround);end;
procedure TiSlidingCompass.SetScaleBackgroundColor (const Value:TColor );begin SetColorProperty (Value,FScaleBackgroundColor, irtBackGround);end;
procedure TiSlidingCompass.SetTickMajorColor (const Value:TColor );begin SetColorProperty (Value,FTickMajorColor, irtBackGround);end;
procedure TiSlidingCompass.SetTickMajorCount (const Value:Integer);begin SetIntegerProperty(Value,FTickMajorCount, irtBackGround);end;
procedure TiSlidingCompass.SetTickMajorLabelMargin (const Value:Double );begin SetDoubleProperty (Value,FTickMajorLabelMargin, irtBackGround);end;
procedure TiSlidingCompass.SetTickMajorLabelPrecision(const Value:Integer);begin SetIntegerProperty(Value,FTickMajorLabelPrecision,irtBackGround);end;
procedure TiSlidingCompass.SetTickMajorLength (const Value:Integer);begin SetIntegerProperty(Value,FTickMajorLength, irtBackGround);end;
procedure TiSlidingCompass.SetTickMajorWidth (const Value:Integer);begin SetIntegerProperty(Value,FTickMajorWidth, irtBackGround);end;
procedure TiSlidingCompass.SetTickMidColor (const Value:TColor );begin SetColorProperty (Value,FTickMidColor, irtBackGround);end;
procedure TiSlidingCompass.SetTickMidLabelMargin (const Value:Double );begin SetDoubleProperty (Value,FTickMidLabelMargin, irtBackGround);end;
procedure TiSlidingCompass.SetTickMidLength (const Value:Integer);begin SetIntegerProperty(Value,FTickMidLength, irtBackGround);end;
procedure TiSlidingCompass.SetTickMidWidth (const Value:Integer);begin SetIntegerProperty(Value,FTickMidWidth, irtBackGround);end;
procedure TiSlidingCompass.SetTickMinorColor (const Value:TColor );begin SetColorProperty (Value,FTickMinorColor, irtBackGround);end;
procedure TiSlidingCompass.SetTickMinorCount (const Value:Integer);begin SetIntegerProperty(Value,FTickMinorCount, irtBackGround);end;
procedure TiSlidingCompass.SetTickMinorWidth (const Value:Integer);begin SetIntegerProperty(Value,FTickMinorWidth, irtBackGround);end;
procedure TiSlidingCompass.SetTickMinorLength (const Value:Integer);begin SetIntegerProperty(Value,FTickMinorLength, irtBackGround);end;
procedure TiSlidingCompass.SetTickMidLabelPrecision (const Value:Integer);begin SetIntegerProperty(Value,FTickMidLabelPrecision, irtBackGround);end;
procedure TiSlidingCompass.SetShowMidTickLabels (const Value:Boolean);begin SetBooleanProperty(Value,FShowMidTickLabels, irtBackGround);end;
procedure TiSlidingCompass.SetShowMidTicks (const Value:Boolean);begin SetBooleanProperty(Value,FShowMidTicks, irtBackGround);end;
procedure TiSlidingCompass.SetReverseScale (const Value:Boolean);begin SetBooleanProperty(Value,FReverseScale, irtBackGround);end;
procedure TiSlidingCompass.SetScaleAntiAliasEnabled (const Value:Boolean);begin SetBooleanProperty(Value,FScaleAntiAliasEnabled, irtBackGround);end;
procedure TiSlidingCompass.SetScaleShadowEnabled (const Value:Boolean);begin SetBooleanProperty(Value,FScaleShadowEnabled, irtBackGround);end;
procedure TiSlidingCompass.SetScaleShadowColor (const Value:TColor );begin SetColorProperty (Value,FScaleShadowColor, irtBackGround);end;
procedure TiSlidingCompass.SetOuterMarginBottom (const Value:Integer);begin SetIntegerProperty(Value,FOuterMarginBottom, irtBackGround);end;
procedure TiSlidingCompass.SetOuterMarginLeft (const Value:Integer);begin SetIntegerProperty(Value,FOuterMarginLeft, irtBackGround);end;
procedure TiSlidingCompass.SetOuterMarginRight (const Value:Integer);begin SetIntegerProperty(Value,FOuterMarginRight, irtBackGround);end;
procedure TiSlidingCompass.SetOuterMarginTop (const Value:Integer);begin SetIntegerProperty(Value,FOuterMarginTop, irtBackGround);end;
procedure TiSlidingCompass.SetTitleText (const Value:String );begin SetStringProperty (Value,FTitleText, irtBackGround);end;
procedure TiSlidingCompass.SetTitleMargin (const Value:Double );begin SetDoubleProperty (Value,FTitleMargin, irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.SetTickMajorLabelFont(const Value: TFont);begin FTickMajorLabelFont.Assign(Value);end;
procedure TiSlidingCompass.SetTickMidLabelFont (const Value: TFont);begin FTickMidLabelFont.Assign(Value); end;
procedure TiSlidingCompass.SetTitleFont (const Value: TFont);begin FTitleFont.Assign(Value); end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.SetScaleSpan(const Value:Double );
var
TempValue : Double;
begin
TempValue := Value;
if TempValue < 0.1 then TempValue := 0.1;
SetDoubleProperty (TempValue,FScaleSpan, irtBackGround);
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.SetPointer1Style(const Value: TiSlidingScalePointerStyle);
begin
if FPointer1Style <> Value then
begin
FPointer1Style := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.SetPointer2Style(const Value: TiSlidingScalePointerStyle);
begin
if FPointer2Style <> Value then
begin
FPointer2Style := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.SetScaleAlignStyle(const Value: TiScaleAlignStyle);
begin
if FScaleAlignStyle <> Value then
begin
FScaleAlignStyle := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.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 TiSlidingCompass.SetScaleOrientation(const Value: TiOrientationSide);
begin
if FScaleOrientation <> Value then
begin
FScaleOrientation := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.SetPointerOrientation(const Value: TiOrientationSide);
begin
if FPointerOrientation <> Value then
begin
FPointerOrientation := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.SetTitleAlignment(const Value: TiAlignmentSideVertical);
begin
if FTitleAlignment <> Value then
begin
FTitleAlignment := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.SetPointer1Position(const Value: Double);
var
TempValue : Double;
CanEdit : Boolean;
begin
TempValue := Value;
while TempValue >= 360 do TempValue := TempValue - 360;
while TempValue < 0 do TempValue := TempValue + 360;
if FPointer1Position <> TempValue then
begin
CanEdit := True;
if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Pointer1Position', CanEdit);
if CanEdit then
begin
FPointer1Position := TempValue;
InvalidateChange;
if Assigned(OnChangeProtected) then OnChangeProtected(Self, 'Pointer1Position');
end;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.SetPointer2Position(const Value: Double);
var
TempValue : Double;
CanEdit : Boolean;
begin
TempValue := Value;
while TempValue >= 360 do TempValue := TempValue - 360;
while TempValue < 0 do TempValue := TempValue + 360;
if FPointer2Position <> TempValue then
begin
CanEdit := True;
if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Pointer2Position', CanEdit);
if CanEdit then
begin
FPointer2Position := TempValue;
InvalidateChange;
if Assigned(OnChangeProtected) then OnChangeProtected(Self, 'Pointer2Position');
end;
end;
end;
//****************************************************************************************************************************************************
function TiSlidingCompass.GetPositionToPixels(Value: Double): Integer;
var
Center : Integer;
Difference : Double;
begin
Difference := FPointer1Position - Value;
while Difference > 180 do Difference := Difference - 360;
while Difference < -180 do Difference := Difference + 360;
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(Difference/FScaleSpan*FRangePixels)
else Result := Center - Round(Difference/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(Difference/FScaleSpan*FRangePixels)
else Result := Center - Round(Difference/FScaleSpan*FRangePixels);
end;
end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.CalcPoints(Canvas: TCanvas);
var
WidthStart : Integer;
WidthStop : Integer;
HeightStart : integer;
HeightStop : Integer;
ScaleWidthStart : Integer;
ScaleWidthStop : Integer;
TickCount : Integer;
DrawRect : TRect;
TitleTotalHeight : Integer;
SizeSide1 : Integer;
SizeSide2 : Integer;
begin
FCenterPoint := GetCenterPoint(Canvas);
//-------------------------------- Title -------------------------------------------------------
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;
//----------------------------- Max Pointer Size -----------------------------------------------
SizeSide1 := 0;
SizeSide2 := 0;
case FPointer1Style of
isspsDualArrow : begin
SizeSide1 := FPointer1Size;
SizeSide2 := FPointer1Size;
end;
isspsArrow : SizeSide1 := FPointer1Size;
isspsPointer : SizeSide1 := 2*FPointer1Size;
end;
case FPointer2Style of
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -