qislidingscale.pas

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

  FRangePixels   := HeightStop - HeightStart;

  if FScaleAntiAliasEnabled then
    begin
      TickCount := (FTickMajorCount) * (FTickMinorCount+1);
      FRangePixels := Trunc((FRangePixels)/TickCount)*TickCount;
    end;

  case FOrientation of
    ioVertical   : FScaleRect := Rect(ScaleWidthStart, HeightStop, ScaleWidthStop, HeightStart);
    ioHorizontal : FScaleRect := Rect(HeightStart, ScaleWidthStart, HeightStop, ScaleWidthStop);
  end;
  
  FHalfMajorLength       := FTickMajorLength;
  FHalfMidLength         := FTickMidLength;
  FHalfMinorLength       := FTickMinorLength;

  FTickMajorStepValue  := FScaleSpan / FTickMajorCount;
  FTickMinorStepValue  := FTickMajorStepValue /(FTickMinorCount+1);

  Canvas.Font.Assign(FTickMajorLabelFont);
  FTickMajorLabelMarginPixels := Round(Canvas.TextWidth('0') * FTickMajorLabelMargin);

  Canvas.Font.Assign(FTickMidLabelFont);
  FTickMidLabelMarginPixels := Round(Canvas.TextWidth('0') * FTickMidLabelMargin);

  if FShowMidTicks and (FTickMinorCount mod 2 = 1) then
    begin
      FMidTicksEnabled := True;
      FMidTickNumber   := FTickMinorCount div 2;
    end
  else FMidTicksEnabled := False;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.iPaintTo(Canvas: TCanvas);
{$ifdef iVCL}
var
  ARegion : HRGN;
{$endif}
begin
  FScaleStartPosition := Trunc(FPosition/FScaleSpan) * FScaleSpan  - FScaleSpan;
  if FPosition < 0 then FScaleStartPosition := FScaleStartPosition - FScaleSpan;

  FScaleStopPosition  := FScaleStartPosition + 3*FScaleSpan;

  if CachedDrawing then
    begin
      if BackGroundChanged then
        begin
          CreateBackGroundBitmap;
          CalcPoints(Canvas);
          DrawBackGround     (BackGroundBitmap.Canvas, BackGroundColor);
          DrawScaleBackGround(BackGroundBitmap.Canvas);
          ResetBackGroundChange;
        end;

      TransferBackGround(Canvas);

      {$ifdef iVCL}
      ARegion := CreateRectRgn(FScaleRect.Left, FScaleRect.Top, FScaleRect.Right, FScaleRect.Bottom);
      try
        SelectClipRgn(Canvas.Handle, ARegion);
      {$endif}
        DrawScale          (Canvas);
      {$ifdef iVCL}
        SelectClipRgn(Canvas.Handle, 0);
      finally
        DeleteObject(ARegion);
      end;
      {$endif}

      DrawPointer        (Canvas);
      DrawTitle          (Canvas);
      DrawBorder         (Canvas);
    end
  else
    begin
      CalcPoints(Canvas);
      DrawBackGround     (Canvas, BackGroundColor);
      DrawScaleBackGround(Canvas);

      {$ifdef iVCL}
      ARegion := CreateRectRgn(FScaleRect.Left, FScaleRect.Top, FScaleRect.Right, FScaleRect.Bottom);
      try
        SelectClipRgn(Canvas.Handle, ARegion);
      {$endif}
        DrawScale          (Canvas);
      {$ifdef iVCL}
        SelectClipRgn(Canvas.Handle, 0);
      finally
        DeleteObject(ARegion);
      end;
      {$endif}

      DrawPointer        (Canvas);
      DrawTitle          (Canvas);
      DrawBorder         (Canvas);
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.DrawTitle(Canvas: TCanvas);
var
  AText       : String;
  ARect       : TRect;
  ATextHeight : Integer;
begin
  with Canvas do
    begin
      Font.Assign(FTitleFont);
      Brush.Style := bsClear;
      AText       := FTitleText;
      ATextHeight := TextHeight(AText);
      case FTitleAlignment of
        iasvTop    : ARect := Rect(FCenterPoint.x, FOuterMarginTop,   FCenterPoint.x, FOuterMarginTop   + ATextHeight);
        iasvBottom : ARect := Rect(FCenterPoint.x, Height - FOuterMarginBottom - ATextHeight, FCenterPoint.x, Height - FOuterMarginBottom);
      end;

      with ARect do
        TextOut((Left + Right) div 2 - TextWidth(AText) div 2, (Top + Bottom) div 2 - TextHeight(AText) div 2, AText);
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.DrawScaleBackGround(Canvas: TCanvas);
var
  Red, Green, Blue : Integer;
  StartRed         : Integer;
  StartGreen       : Integer;
  StartBlue        : Integer;
  StopRed          : Integer;
  StopGreen        : Integer;
  StopBlue         : Integer;
  x                : Integer;
  NumOfLines       : Integer;
  Center           : Integer;
begin
  with Canvas do
    begin
      Brush.Color := FScaleBackGroundColor;
      Pen.Color   := FScaleBackGroundColor;
      Rectangle(FScaleRect.Left, FScaleRect.Top, FScaleRect.Right, FScaleRect.Bottom);

      if not FScaleShadowEnabled then exit;

      StartRed   := (FScaleBackgroundColor and $0000FF);
      StartGreen := (FScaleBackgroundColor and $00FF00) shr 8;
      StartBlue  := (FScaleBackgroundColor and $FF0000) shr 16;

      StopRed    := (FScaleShadowColor and $0000FF);
      StopGreen  := (FScaleShadowColor and $00FF00) shr 8;
      StopBlue   := (FScaleShadowColor and $FF0000) shr 16;
      Brush.Style := bsClear;

      case FOrientation of
        ioVertical : begin
                       NumOfLines := (FScaleRect.Bottom - FScaleRect.Top ) div 2;
                       Center     := (FScaleRect.Bottom + FScaleRect.Top ) div 2;
                     end;
        else         begin
                       NumOfLines := (FScaleRect.Right  - FScaleRect.Left) div 2;
                       Center     := (FScaleRect.Right  + FScaleRect.Left) div 2;
                     end;
      end;

      if NumOfLines = 0 then exit;

      for x := 0 to NumOfLines do

        begin
          Red   := Round((x/NumOfLines*StopRed    + (NumOfLines-x)/NumOfLines*StartRed  ));
          Green := Round((x/NumOfLines*StopGreen  + (NumOfLines-x)/NumOfLines*StartGreen));
          Blue  := Round((x/NumOfLines*StopBlue   + (NumOfLines-x)/NumOfLines*StartBlue ));

          Pen.Color := Red + (Green shl 8) + (Blue shl 16);

          case FOrientation of
            ioVertical : begin
                           Polyline([Point(FScaleRect.Left, Center + x+1), Point(FScaleRect.Right, Center + x+1)]);
                           Polyline([Point(FScaleRect.Left, Center - x  ), Point(FScaleRect.Right, Center - x  )]);
                         end;
            else         begin
                           Polyline([Point(Center + x+1, FScaleRect.Top), Point(Center + x+1, FScaleRect.Bottom)]);
                           Polyline([Point(Center - x,   FScaleRect.Top), Point(Center - x,   FScaleRect.Bottom)]);
                         end;
          end;
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.DrawPointer(Canvas: TCanvas);
var
  PositionPixels : Integer;
begin
  with Canvas do
    begin
      PositionPixels := GetPositionToPixels(Position);
      Pen.Color := PointerLineColor;
      Pen.Width := PointerLineWidth;
      case FOrientation of
        ioVertical : Polyline([Point(FScaleRect.Left, PositionPixels), Point(FScaleRect.Right, PositionPixels   )]);
        else         Polyline([Point(PositionPixels,  FScaleRect.Top), Point(PositionPixels,   FScaleRect.Bottom)]);
      end;

      case FPointerStyle of
        isspsDualArrow : DrawPointerDualArrow(Canvas);
        isspsArrow     : DrawPointerArrow    (Canvas);
        isspsPointer   : DrawPointerPointer  (Canvas);
      end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingScale.DrawPointerArrow(Canvas: TCanvas);
var
  Point1         : TPoint;
  Point2         : TPoint;
  Point3         : TPoint;
  PositionPixels : Integer;
begin
  with Canvas do
    begin
      PositionPixels := GetPositionToPixels(Position);
      Brush.Style    := bsSolid;
      Brush.Color    := FPointerColor;
      Pen.Color      := FPointerColor;
      Pen.Width      := 1;

      case FOrientation of
        ioVertical : case FPointerOrientation of
                       iosBottomRight : begin
                                          Point1 := Point(FScaleRect.Right,                PositionPixels                     );
                                          Point2 := Point(FScaleRect.Right + FPointerSize, PositionPixels + FPointerSize div 2);
                                          Point3 := Point(FScaleRect.Right + FPointerSize, PositionPixels - FPointerSize div 2);
                                        end;
                       else             begin
                                          Point1 := Point(FScaleRect.Left,                PositionPixels                     );
                                          Point2 := Point(FScaleRect.Left - FPointerSize, PositionPixels + FPointerSize div 2);
                                          Point3 := Point(FScaleRect.Left - FPointerSize, PositionPixels - FPointerSize div 2);
                                        end;
                     end;
        else         case FPointerOrientation of
                       iosBottomRight : begin
                                          Point1 := Point(PositionPixels,                      FScaleRect.Bottom               );
                                          Point2 := Point(PositionPixels + FPointerSize div 2, FScaleRect.Bottom + FPointerSize);
                                          Point3 := Point(PositionPixels - FPointerSize div 2, FScaleRect.Bottom + FPointerSize);
                                        end;
                       else             begin
                                          Point1 := Point(PositionPixels,                      FScaleRect.Top               );
                                          Point2 := Point(PositionPixels + FPointerSize div 2, FScaleRect.Top - FPointerSize);