islidingcompass.pas

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

    isspsDualArrow : begin
                       if FPointer2Size > SizeSide1 then SizeSide1 := FPointer2Size;
                       if FPointer2Size > SizeSide2 then SizeSide2 := FPointer2Size;
                     end;
    isspsArrow     : if FPointer2Size > SizeSide1 then SizeSide1 := FPointer2Size;
    isspsPointer   : if 2*FPointer2Size > SizeSide1 then SizeSide1 := 2*FPointer2Size;
  end;

  case FPointerOrientation of
    iosBottomRight : begin
                       ScaleWidthStart := WidthStart + SizeSide2;
                       ScaleWidthStop  := WidthStop  - SizeSide1;
                     end;
    else             begin
                       ScaleWidthStart := WidthStart + SizeSide1;
                       ScaleWidthStop  := WidthStop  - SizeSide2;
                     end;
  end;
  //-------------------------------- Scale ------------------------------------------------------
  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;
  //-------------------------------- Ticks -------------------------------------------------------
  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 TiSlidingCompass.iPaintTo(Canvas: TCanvas);
{$ifdef iVCL}
var
  ARegion : HRGN;
{$endif}
begin
  FScaleStartPosition := Trunc(FPointer1Position/FScaleSpan) * FScaleSpan - 2*FScaleSpan;
  FScaleStopPosition  := FScaleStartPosition + 4*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 TiSlidingCompass.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 TiSlidingCompass.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 TiSlidingCompass.DrawPointer(Canvas: TCanvas);
begin
  with Canvas do
    begin
      DrawPointerLine(Canvas, FPointer1Position, FPointer1LineColor, FPointer1LineWidth);
      case FPointer1Style of
        isspsDualArrow : DrawPointerDualArrow(Canvas, FPointer1Position, FPointer1Color, FPointer1Size);
        isspsArrow     : DrawPointerArrow    (Canvas, FPointer1Position, FPointer1Color, FPointer1Size);
        isspsPointer   : DrawPointerPointer  (Canvas, FPointer1Position, FPointer1Color, FPointer1Size);
      end;

      DrawPointerLine(Canvas, FPointer2Position, FPointer2LineColor, FPointer2LineWidth);
      case FPointer2Style of
        isspsDualArrow : DrawPointerDualArrow(Canvas, FPointer2Position, FPointer2Color, FPointer2Size);
        isspsArrow     : DrawPointerArrow    (Canvas, FPointer2Position, FPointer2Color, FPointer2Size);
        isspsPointer   : DrawPointerPointer  (Canvas, FPointer2Position, FPointer2Color, FPointer2Size);
      end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.DrawPointerLine(Canvas: TCanvas; APosition: Double; AColor: TColor; AWidth: Integer);
var
  PositionPixels : Integer;
begin
  with Canvas do
    begin
      PositionPixels := GetPositionToPixels(APosition);
      Pen.Color := AColor;
      Pen.Width := AWidth;
      case FOrientation of
        ioVertical : Polyline([Point(FScaleRect.Left, PositionPixels), Point(FScaleRect.Right, PositionPixels   )]);
        else         Polyline([Point(PositionPixels,  FScaleRect.Top), Point(PositionPixels,   FScaleRect.Bottom)]);
      end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlidingCompass.DrawPointerArrow(Canvas: TCanvas; APosition : Double; AColor : TColor; ASize : Integer);
var
  Point1         : TPoint;
  Point2         : TPoint;
  Point3         : TPoint;
  PositionPixels : Integer;
begin
  with Canvas do
    begin
      PositionPixels := GetPositionToPixels(APosition);
      Brush.Style    := bsSolid;
      Brush.Color    := AColor;
      Pen.Color      := AColor;
      Pen.Width      := 1;

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