iscaleobject.pas

iocopm3.04源码,一套很好的工控开发工具

      FTickMinorAlignment := Value;
      Change;
    end;
end;
//****************************************************************************************************************************************************
procedure TiScaleObject.SetTickMinorColor(const Value: TColor);
begin
  if FTickMinorColor <> Value then
    begin
      FTickMinorColor := Value;
      Change;
    end;
end;
//****************************************************************************************************************************************************
procedure TiScaleObject.SetTickMinorCount(const Value: Integer);
begin
  if FTickMinorCount <> Value then
    begin
      FTickMinorCount := Value;
      if FTickMinorCount <   1 then FTickMinorCount := 1;
      if FTickMinorCount > 100 then FTickMinorCount := 100;
      Change;
    end;
end;
//****************************************************************************************************************************************************
procedure TiScaleObject.SetTickMinorLength(const Value: Integer);
begin
  if FTickMinorLength <> Value then
    begin
      FTickMinorLength := Value;
      if FTickMinorLength < 1 then FTickMinorLength := 1;
      Change;
    end;
end;
//****************************************************************************************************************************************************
procedure TiScaleObject.SetTickMinorStyle(const Value: TiBevelStyle);
begin
  if FTickMinorStyle <> Value then
    begin
      FTickMinorStyle := Value;
      Change;
    end;
end;
//****************************************************************************************************************************************************
procedure TiScaleObject.SetReverseScale(const Value: Boolean);
begin
  if FReverseScale <> Value then
    begin
      FReverseScale := Value;
      Change;
    end;
end;
//****************************************************************************************************************************************************
procedure TiScaleObject.SetPrecisionStyle(const Value: TiPrecisionStyle);
begin
  if FPrecisionStyle <> Value then
    begin
      FPrecisionStyle := Value;
      Change;
    end;
end;
//****************************************************************************************************************************************************
function TiScaleObject.PositionToPixelsRelative(Value: Double): Integer;
var
  ActualStart : Integer;
  ActualStop  : Integer;
begin
  if FReverseScale then
    begin
      ActualStart := FStop;
      ActualStop  := FStart;
    end
  else
    begin
      ActualStart := FStart;
      ActualStop  := FStop;
    end;

  Result := Round((Value - FPositionMin)/(FPositionMax - FPositionMin)*(ActualStart - ActualStop));
end;
//****************************************************************************************************************************************************
function TiScaleObject.PositionToPixelsAbsolute(Value: Double): Integer;
var
  ActualStart : Integer;
  ActualStop  : Integer;
begin
  if FReverseScale then
    begin
      ActualStart := FStop;
      ActualStop  := FStart;
    end
  else
    begin
      ActualStart := FStart;
      ActualStop  := FStop;
    end;

  if FPositionMax <> FPositionMin then
    Result := ActualStart - Round((Value - FPositionMin)/(FPositionMax - FPositionMin)*(ActualStart - ActualStop))
  else Result := (ActualStart + ActualStop) div 2;
end;
//****************************************************************************************************************************************************
procedure TiScaleObject.Draw(Canvas: TCanvas);
var
  SidePolarity             : Integer;
  MinorEdge                : Integer;
  MajorEdge                : Integer;
  LabelEdge                : Integer;
  x, y                     : Integer;
  TextString               : String;
  ShowMajorTick            : Boolean;
  TempRect                 : TRect;
  ATextHeight              : Integer;
  ATextWidth               : Integer;
  ActualTickMinorAlignment : TiTickMinorAlignment;
  ActualMin                : Double;
  ActualMax                : Double;
  CurrentPosition          : Double;
  MajorStepValue           : Double;
  MinorStepValue           : Double;
  PositionPixels           : Integer;
begin
  if AutoScaleEnabled and (AutoScaleStyle = iassFixedMinMax) then
    begin
      ActualMin   := FAutoScaleMinTick;
      ActualMax   := FAutoScaleMaxTick;
    end
  else                    
    begin
      ActualMin   := PositionMin;
      ActualMax   := PositionMax;
    end;

  if FReverseTickMinorAlign then
    case FTickMinorAlignment of
      itmnaInside  : ActualTickMinorAlignment := itmnaOutside;
      itmnaOutside : ActualTickMinorAlignment := itmnaInside;
      else           ActualTickMinorAlignment := itmnaCenter;
    end
  else ActualTickMinorAlignment := FTickMinorAlignment;

  MajorStepValue := (ActualMax - ActualMin)/(TickMajorCount-1);
  MinorStepValue := MajorStepValue/(TickMinorCount+1);

  with Canvas do
    begin
      Brush.Style := bsClear;
      Font.Assign(TickLabelFont);

      case FOrientationTickMarks of
        iosBottomRight : SidePolarity :=  1;
        else             SidePolarity := -1;
      end;

      MajorEdge := FEdge + SidePolarity*FTickMargin;
      LabelEdge := MajorEdge + SidePolarity*(FTickMajorLength + FTickLabelMargin);

      case ActualTickMinorAlignment of
        itmnaInside  : MinorEdge := MajorEdge;
        itmnaCenter  : MinorEdge := MajorEdge + SidePolarity*(FTickMajorLength div 2 - FTickMinorLength div 2);
        else           MinorEdge := MajorEdge + SidePolarity*(FTickMajorLength       - FTickMinorLength      );
      end;


      for x := 0 to FTickMajorCount - 1 do
        begin
          CurrentPosition := ActualMin + (MajorStepValue*x);
          PositionPixels  := PositionToPixelsAbsolute(CurrentPosition);

          //-------------------------------------------------------------------------------------------------------------------------------
          if FShowTicksMajor then
            begin
              ShowMajorTick := True;
              if not FShowTicksMajorFirstLast and (x = 0               ) then ShowMajorTick := False;
              if not FShowTicksMajorFirstLast and (x = TickMajorCount-1) then ShowMajorTick := False;
              if ShowMajorTick then
                begin
                  Pen.Color      := FTickMajorColor;
                  case FOrientation of
                    ioVertical   : TempRect := Rect(MajorEdge, PositionPixels, MajorEdge + SidePolarity*FTickMajorLength, PositionPixels);
                    ioHorizontal : TempRect := Rect(PositionPixels, MajorEdge, PositionPixels, MajorEdge + SidePolarity*FTickMajorLength);
                  end;
                  LineBevel(Canvas, TempRect.Left, TempRect.Top, TempRect.Right, TempRect.Bottom, FTickMajorStyle);
                end;
            end;
          //-------------------------------------------------------------------------------------------------------------------------------
          if FShowTickLabels then
            begin
              TextString  := Trim(SysUtils.Format('%.' + IntToStr(GetDecimalPoints) + 'f', [CurrentPosition]));
              if Assigned(OnCustomizeTickLabel) then TOnCustomizeTickLabel(OnCustomizeTickLabel)(Self, x, TextString);

              ATextHeight := TextHeight(TextString);
              ATextWidth  := TextWidth (TextString);

              case FOrientation of
                ioVertical : case FOrientationTickMarks of
                               iosBottomRight : TextOut(LabelEdge,              PositionPixels - ATextHeight div 2, TextString);
                               else             TextOut(LabelEdge - ATextWidth, PositionPixels - ATextHeight div 2, TextString);
                             end;
                else         case FOrientationTickMarks of
                               iosBottomRight : TextOut(PositionPixels - ATextWidth div 2, LabelEdge, TextString);
                               else             TextOut(PositionPixels - ATextWidth div 2, LabelEdge - ATextHeight, TextString);
                             end;
              end;

            end;
          //-------------------------------------------------------------------------------------------------------------------------------
          if FShowTicksMinor and FShowTicksMajor and (x < FTickMajorCount - 1) then
            begin
              Pen.Color := FTickMinorColor;
              for y := 1 to FTickMinorCount do
                begin
                  PositionPixels  := PositionToPixelsAbsolute(ActualMin + MajorStepValue*x + MinorStepValue*y);
                  case FOrientation of
                    ioVertical   : TempRect := Rect(MinorEdge, PositionPixels, MinorEdge + SidePolarity*FTickMinorLength, PositionPixels);
                    ioHorizontal : TempRect := Rect(PositionPixels, MinorEdge, PositionPixels, MinorEdge + SidePolarity*FTickMinorLength);
                  end;
                  LineBevel(Canvas, TempRect.Left, TempRect.Top, TempRect.Right, TempRect.Bottom, FTickMinorStyle);
                end;
            end;
          //-------------------------------------------------------------------------------------------------------------------------------
        end;

      if (FAutoScaleStyle = iassFixedMinMax) and FShowTicksMinor and (MinorStepValue <> 0) then
        begin
          CurrentPosition := ActualMax + MinorStepValue;
          while CurrentPosition <= FPositionMax do
            begin
              PositionPixels  := PositionToPixelsAbsolute(CurrentPosition);
              case FOrientation of
                ioVertical   : TempRect := Rect(MinorEdge, PositionPixels, MinorEdge + SidePolarity*FTickMinorLength, PositionPixels);
                ioHorizontal : TempRect := Rect(PositionPixels, MinorEdge, PositionPixels, MinorEdge + SidePolarity*FTickMinorLength);
              end;
              LineBevel(Canvas, TempRect.Left, TempRect.Top, TempRect.Right, TempRect.Bottom, FTickMinorStyle);

              CurrentPosition := CurrentPosition + MinorStepValue;
            end;

          CurrentPosition := ActualMin - MinorStepValue;
          while CurrentPosition >= FPositionMin do
            begin
              PositionPixels  := PositionToPixelsAbsolute(CurrentPosition);
              case FOrientation of
                ioVertical   : TempRect := Rect(MinorEdge, PositionPixels, MinorEdge + SidePolarity*FTickMinorLength, PositionPixels);
                ioHorizontal : TempRect := Rect(PositionPixels, MinorEdge, PositionPixels, MinorEdge + SidePolarity*FTickMinorLength);
              end;
              LineBevel(Canvas, TempRect.Left, TempRect.Top, TempRect.Right, TempRect.Bottom, FTickMinorStyle);

              CurrentPosition := CurrentPosition - MinorStepValue;
            end;
        end;

    end;
end;
//****************************************************************************************************************************************************
procedure TiScaleObject.FontChange(Sender: TObject);
begin
  Change;
end;
//****************************************************************************************************************************************************
function TiScaleObject.GetDecimalPoints: Integer;
var
  Span : Double;
begin
  Result := 0;
  case FPrecisionStyle of
    ipsSignificantDigits : if FTickLabelPrecision > 0 then
                             begin
                               Span := ABS(PositionMax - PositionMin);
                               if Span <> 0 then Result := FTickLabelPrecision - (Trunc(Log10(Span))+1) else Result := 0;
                               if Span < 1 then Result := Result + 1;
                               if Result < 0 then Result := 0;
                             end;
    ipsFixedDecimalPoints : Result := FTickLabelPrecision;
  end;
end;
//****************************************************************************************************************************************************
end.