teetools.pas

BCB第三方组件

begin
  result:=TeeMsg_CursorTool;
end;

class Function TCursorTool.LongDescription:String;
begin
  result:=TeeMsg_CursorToolDesc;
end;

Function TeeGetFirstLastSeries(Series:TChartSeries;
                               out AMin,AMax:Integer):Boolean; { 5.01 }
begin
  AMin:=Series.FirstValueIndex;
  if AMin<0 then AMin:=0;

  AMax:=Series.LastValueIndex;
  if AMax<0 then AMax:=Series.Count-1
  else
  if AMax>=Series.Count then AMax:=Series.Count-1; { 5.03 }

  result:=(Series.Count>0) and (AMin<=Series.Count) and (AMax<=Series.Count);
end;

Function TCursorTool.NearestPoint(AStyle:TCursorToolStyle;
                                  out Difference:Double):Integer;
var t      : Integer;
    tmpDif : Double;
    tmpMin : Integer;
    tmpMax : Integer;
begin
  result:=-1;
  Difference:=-1;

  if TeeGetFirstLastSeries(Series,tmpMin,tmpMax) then
  for t:=tmpMin to tmpMax do
  begin

    if FSnapStyle=ssDefault then
    begin
      With Series do
      Case AStyle of
        cssHorizontal: tmpDif:=Abs(IYValue-YValues.Value[t]);
        cssVertical  : tmpDif:=Abs(IXValue-XValues.Value[t]);
      else
        tmpDif:=Sqrt(Sqr(IXValue-XValues.Value[t])+Sqr(IYValue-YValues.Value[t]));
      end;
    end
    else
    if FSnapStyle=ssHorizontal then
       tmpDif:=Abs(IYValue-Series.YValues.Value[t])
    else
       tmpDif:=Abs(IXValue-Series.XValues.Value[t]);

    if (Difference=-1) or (tmpDif<Difference) then
    begin
      Difference:=tmpDif;
      result:=t;
    end;
  end;
end;

Function TCursorTool.SnapToPoint:Integer;
var Difference : Double;
begin
  if Assigned(Series) and FSnap then result:=NearestPoint(FStyle,Difference)
                                else result:=-1;

  if result<>-1 then
  Case FStyle of
    cssHorizontal: IYValue:=Series.YValues.Value[result];
    cssVertical  : IXValue:=Series.XValues.Value[result];
  else
    begin
      IXValue:=Series.XValues.Value[result];
      IYValue:=Series.YValues.Value[result]
    end;
  end;
end;

Function TCursorTool.GetAxisRect:TRect;
begin
  if UseChartRect then result:=ParentChart.ChartRect
  else
  begin
    With GetHorizAxis do
    begin
      result.Left:=IStartPos;
      result.Right:=IEndPos;
    end;

    With GetVertAxis do
    begin
      result.Top:=IStartPos;
      result.Bottom:=IEndPos;
    end;

    if Assigned(FOnGetAxisRect) then
       FOnGetAxisRect(Self,result);
  end;
end;

Function TCursorTool.Z:Integer;
begin
  if UseSeriesZ and Assigned(Series) then
     result:=Series.StartZ
  else
     result:=0;
end;

procedure TCursorTool.RedrawCursor;

  Procedure DrawCursorLines(Draw3D:Boolean; Const R:TRect; X,Y:Integer);

    Procedure DrawHorizontal;
    begin
      With ParentChart.Canvas do
      if Draw3D then HorizLine3D(R.Left,R.Right,Y,Z)
                else DoHorizLine(R.Left,R.Right,Y);
    end;

    Procedure DrawVertical;
    begin
      With ParentChart.Canvas do
      if Draw3D then VertLine3D(X,R.Top,R.Bottom,Z)
                else DoVertLine(X,R.Top,R.Bottom);
    end;

    procedure DrawScope;
    var tmp : TRect;
    begin
      tmp.Left:=X-ScopeSize;
      tmp.Top:=Y-ScopeSize;
      tmp.Right:=X+ScopeSize;
      tmp.Bottom:=Y+ScopeSize;

      With ParentChart.Canvas do
      if Draw3D then
      begin
        if ScopeStyle=scsCamera then
        begin
          Rectangle(X-HorizSize-ScopeSize,Y-VertSize-ScopeSize,
                    X+HorizSize+ScopeSize,Y+VertSize+ScopeSize,Z);

          HorizLine3D(X-ScopeSize,X+ScopeSize,Y,Z);
          VertLine3D(X,Y-ScopeSize,Y+ScopeSize,Z);
        end
        else
        begin
          HorizLine3D(X-HorizSize-ScopeSize,X-ScopeSize,Y,Z);
          HorizLine3D(X+ScopeSize,X+HorizSize+ScopeSize,Y,Z);

          VertLine3D(X,Y-VertSize-ScopeSize,Y-ScopeSize,Z);
          VertLine3D(X,Y+ScopeSize,Y+VertSize+ScopeSize,Z);

          case ScopeStyle of
            scsRectangle: Rectangle(tmp,Z);
            scsCircle   : EllipseWithZ(tmp.Left,tmp.Top,tmp.Right,tmp.Bottom,Z);
            scsDiamond  : PolygonWithZ( [TeePoint(X-ScopeSize,Y),
                                        TeePoint(X,Y-ScopeSize),
                                        TeePoint(X+ScopeSize,Y),
                                        TeePoint(X,Y+ScopeSize)],
                                        Z);
          end;
        end;
      end
      else
      begin
        if ScopeStyle=scsCamera then
        begin
          Rectangle(X-HorizSize-ScopeSize,Y-VertSize-ScopeSize,
                    X+HorizSize+ScopeSize,Y+VertSize+ScopeSize);

          DoHorizLine(X-ScopeSize,X+ScopeSize,Y);
          DoVertLine(X,Y-ScopeSize,Y+ScopeSize);
        end
        else
        begin
          DoHorizLine(X-HorizSize-ScopeSize,X-ScopeSize,Y);
          DoHorizLine(X+ScopeSize,X+HorizSize+ScopeSize,Y);

          DoVertLine(X,Y-VertSize-ScopeSize,Y-ScopeSize);
          DoVertLine(X,Y+ScopeSize,Y+VertSize+ScopeSize);

          case ScopeStyle of
            scsRectangle: Rectangle(tmp);
            scsCircle   : Ellipse(tmp);
            scsDiamond  : Polygon( [TeePoint(X-ScopeSize,Y),
                                   TeePoint(X,Y-ScopeSize),
                                   TeePoint(X+ScopeSize,Y),
                                   TeePoint(X,Y+ScopeSize)]);
          end;
        end;
      end;
    end;

  begin
    Case FStyle of
      cssHorizontal: DrawHorizontal;
      cssVertical  : DrawVertical;
      cssScope     : begin
                       DrawScope;
                       DrawHorizontal;
                       DrawVertical;
                     end;
      cssScopeOnly : DrawScope;
    else
    begin
      DrawHorizontal;
      DrawVertical;
    end;
    end;
  end;

var tmpColor : TColor;
begin
  if Assigned(ParentChart) then
  begin
    tmpColor:=ParentChart.Color;
    if tmpColor=clTeeColor then tmpColor:=clBtnFace;

    With ParentChart.Canvas do
    begin
      AssignVisiblePenColor(Self.Pen,Self.Pen.Color xor ColorToRGB(tmpColor));
      Brush.Style:=bsClear;
      Pen.Mode:=pmXor;

      DrawCursorLines(ParentChart.View3D,MouseRectangle(IPoint.X,IPoint.Y,True),IPoint.X,IPoint.Y);

      Pen.Mode:=pmCopy;
      ParentChart.Canvas.Invalidate;
    end;
  end;
end;

function TCursorTool.MouseRectangle(X,Y:Integer; UseSize:Boolean):TRect;
begin
  result:=GetAxisRect;

  if UseSize then
  begin
    if HorizSize<>0 then
    begin
      result.Left:=X-HorizSize;
      result.Right:=X+HorizSize;
    end;

    if VertSize<>0 then
    begin
      result.Top:=Y-VertSize;
      result.Bottom:=Y+VertSize;
    end;
  end;
end;

Function TCursorTool.InMouseRectangle(x,y:Integer; UseSize:Boolean=False):Boolean;
begin
  if UseSeriesZ then
     ParentChart.Canvas.Calculate2DPosition(x,y,Z);

  result:=PointInRect(MouseRectangle(x,y,UseSize),x,y);
end;

Procedure TCursorTool.ChartMouseEvent( AEvent: TChartMouseEvent;
                                       Button:TMouseButton;
                                       Shift: TShiftState; X, Y: Integer);

  Procedure MouseMove;
  var tmpSnap : Integer;
      tmp     : TCursorClicked;
  begin
    { if mouse button is pressed and dragging then... }
    if ((IDragging<>ccNone) or FollowMouse) and InMouseRectangle(X,Y) then
    begin
      RedrawCursor;      { hide the cursor }
      CalcValuePositions(X,Y);

      tmpSnap:=SnapToPoint;  { snap to the nearest point of SnapSeries }

      { draw again the cursor at the new position }
      CalcScreenPositions;
      RedrawCursor;
      Changed(tmpSnap);

      if Assigned(FOnSnapChange) and (IOldSnap<>tmpSnap) then  // 7.0
         FOnSnapChange(Self,IPoint.X,IPoint.Y,IXValue,IYValue,Series,tmpSnap);

      IOldSnap:=tmpSnap;
    end
    else
    begin  { mouse button is not pressed, user is not dragging the cursor }
           { change the mouse cursor when passing over the Cursor }
      tmp:=Clicked(x,y);

      case tmp of
         ccHorizontal : ParentChart.Cursor:=crVSplit;
         ccVertical   : ParentChart.Cursor:=crHSplit;
         ccBoth       : ParentChart.Cursor:=crSizeAll;
      end;

      ParentChart.CancelMouse:=tmp<>ccNone;
    end;
  end;

begin
  Case AEvent of
      cmeUp: IDragging:=ccNone;

    cmeMove: MouseMove;

    cmeDown: if not FFollowMouse then
             begin
               IDragging:=Clicked(x,y);

               if IDragging<>ccNone then
                  ParentChart.CancelMouse:=True;
             end;
  end;
end;

Function TCursorTool.Clicked(x,y:Integer):TCursorClicked;
var tmp : TPoint;
begin
  result:=ccNone;

  if InMouseRectangle(x,y,True) then
  begin
    tmp:=IPoint;

    if UseSeriesZ then
       ParentChart.Canvas.Calculate2DPosition(x,y,Z);

    if ((FStyle=cssBoth) or (FStyle=cssScope) or (FStyle=cssScopeOnly)) and
        (Abs(Y-tmp.Y)<=ClickTolerance) and
        (Abs(X-tmp.X)<=ClickTolerance) then
       result:=ccBoth
    else
    if (FStyle<>cssVertical) and (Abs(Y-tmp.Y)<=ClickTolerance) then
       result:=ccHorizontal
    else
    if (FStyle<>cssHorizontal) and (Abs(X-tmp.X)<=ClickTolerance) then
       result:=ccVertical
  end;
end;

Procedure TCursorTool.SetHorizSize(const Value:Integer);
begin
  SetIntegerProperty(FHorizSize,Value);
end;

Procedure TCursorTool.SetScopeSize(const Value:Integer);
begin
  SetIntegerProperty(FScopeSize,Value);
end;

Procedure TCursorTool.SetScopeStyle(const Value:TScopeCursorStyle);
begin
  if FScopeStyle<>Value then
  begin
    FScopeStyle:=Value;
    Repaint;
  end;
end;

Procedure TCursorTool.SetVertSize(const Value:Integer);
begin
  SetIntegerProperty(FVertSize,Value);
end;

Procedure TCursorTool.SetStyle(Value:TCursorToolStyle);
begin
  if FStyle<>Value then
  begin
    FStyle:=Value;
    SnapToPoint;
    Repaint;
  end;
end;

procedure TCursorTool.SetSeries(const Value: TChartSeries);
begin
  inherited;

  IOldSnap:=-1;

  if Assigned(Series) and (not (csLoading in ComponentState)) then
  begin
    SnapToPoint;
    Repaint;
  end;
end;

procedure TCursorTool.SetParentChart(const Value: TCustomAxisPanel);
begin
  inherited;
  Repaint;
end;

procedure TCursorTool.ChartEvent(AEvent: TChartToolEvent);
begin
  inherited;

  if AEvent=cteAfterDraw then
  begin