teetools.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

                                       Button:TMouseButton;
                                       Shift: TShiftState; X, Y: Integer);

  Procedure MouseMove;

    Procedure CheckCursor;

      Function CheckCursorSeries(ASeries:TChartSeries):Boolean;
      begin
        result:=ASeries.Active and ASeries.Marks.Visible and
                (ASeries.Marks.Clicked(x,y)<>-1);
      end;

    var tmp : Boolean;
        t   : Integer;
    begin
      tmp:=False;
      if Assigned(Series) then tmp:=CheckCursorSeries(Series)
      else
      With ParentChart do
      for t:=SeriesCount-1 downto 0 do
      begin
        tmp:=CheckCursorSeries(Series[t]);
        if tmp then break;
      end;
      if tmp then
      begin
        ParentChart.Cursor:=crHandPoint;
        ParentChart.CancelMouse:=True;
      end;
    end;

  var DifX : Integer;
      DifY : Integer;
  begin
    if not Assigned(IPosition) then CheckCursor
    else
    With IPosition do
    begin
      DifX:=X-IOldX;
      DifY:=Y-IOldY;
      Custom:=True;
      Inc(LeftTop.X,DifX);
      Inc(LeftTop.Y,DifY);
      Inc(ArrowTo.X,DifX);
      Inc(ArrowTo.Y,DifY);
      IOldX:=X;
      IOldY:=Y;
      ParentChart.CancelMouse:=True;
      Repaint;
    end;
  end;

  Procedure MouseDown;

    Function CheckSeries(ASeries:TChartSeries):Integer;
    begin
      result:=-1;
      if ASeries.Active then
      begin
        result:=ASeries.Marks.Clicked(x,y);
        if result<>-1 then
        begin
          ISeries:=ASeries;
          IPosition:=ISeries.Marks.Positions.Position[result];
          Exit;
        end;
      end;
    end;

  var t : Integer;
  begin
    if Assigned(Series) then CheckSeries(Series)
    else
    With ParentChart do
    for t:=SeriesCount-1 downto 0 do
        if CheckSeries(Series[t])<>-1 then break;

    if Assigned(IPosition) then
    begin
      IOldX:=X;
      IOldY:=Y;
    end;
  end;

begin
  Case AEvent of
    cmeUp  : IPosition:=nil;
    cmeDown: begin
               MouseDown;
               if Assigned(IPosition) then ParentChart.CancelMouse:=True;
             end;
    cmeMove: MouseMove;
  end;
end;

class function TDragMarksTool.GetEditorClass: String;
begin
  result:='TDragMarksToolEditor';
end;

{ TAxisArrowTool }
Constructor TAxisArrowTool.Create(AOwner: TComponent);
begin
  inherited;
  FLength:=16;
  FHeadWidth:=8;  
  FPosition:=aaBoth;
  FScrollPercent:=10;
  FSizePercent:=50;
end;

procedure TAxisArrowTool.ChartEvent(AEvent: TChartToolEvent);
Var tmpZ : Integer;

  Procedure DrawArrow(APos,ALength:Integer);
  var P0 : TPoint;
      P1 : TPoint;
  begin
    With Axis do
    if Horizontal then
    begin
      P0:=TeePoint(APos+ALength,PosAxis);
      P1:=TeePoint(APos,PosAxis)
    end
    else
    begin
      P0:=TeePoint(PosAxis,APos+ALength);
      P1:=TeePoint(PosAxis,APos);
    end;

    ParentChart.Canvas.Arrow(True,P0,P1,HeadWidth,HeadWidth,tmpZ,SizePercent);
  end;

begin
  inherited;

  if (AEvent=cteAfterDraw) and Assigned(Axis) then
  begin
    ParentChart.Canvas.AssignBrush(Self.Brush,Self.Brush.Color);
    ParentChart.Canvas.AssignVisiblePen(Self.Pen);

    if ParentChart.View3D and Axis.OtherSide then
       tmpZ:=ParentChart.Width3D
    else
       tmpZ:=0;

    if (FPosition=aaStart) or (FPosition=aaBoth) then
       DrawArrow(Axis.IStartPos,Length);

    if (FPosition=aaEnd) or (FPosition=aaBoth) then
       DrawArrow(Axis.IEndPos,-Length);
  end;
end;

class function TAxisArrowTool.Description: String;
begin
  result:=TeeMsg_AxisArrowTool;
end;

procedure TAxisArrowTool.SetHeadWidth(const Value: Integer);
begin
  SetIntegerProperty(FHeadWidth,Value);
end;

procedure TAxisArrowTool.SetLength(const Value: Integer);
begin
  SetIntegerProperty(FLength,Value);
end;

Function TAxisArrowTool.ClickedArrow(x,y:Integer):Integer;

  Procedure Check(Pos1,Pos2:Integer);
  begin
    { to-do: right/top axis Z ! }
    With Axis do
    if (Abs(Pos1-PosAxis)<TeeClickTolerance) then
    begin
      if (FPosition=aaStart) or (FPosition=aaBoth) then
        if (Pos2>IStartPos) and (Pos2<IStartPos+Length) then
        begin
          result:=0;
          exit;
        end;
      if (FPosition=aaEnd) or (FPosition=aaBoth) then
        if (Pos2<IEndPos) and (Pos2>IEndPos-Length) then
        begin
          result:=1;
          exit;
        end;
    end;
  end;

begin
  result:=-1;
  if Axis.Horizontal then Check(y,x) else Check(x,y);
end;

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

  Procedure DoScroll(const ADelta:Double);

    // Returns True when there is at least on series in the chart,
    // that has "both" axis associated (left and right, or top and bottom).
    // The OtherAxis parameter returns the "other" axis (right axis if
    // series axis is left, left axis if series axis is right, and so on).
    Function AnySeriesBothAxis(Axis:TChartAxis; Var OtherAxis:TChartAxis):Boolean;
    var t : Integer;
    begin
      result:=False;

      for t:=0 to ParentChart.SeriesCount-1 do
      if ParentChart[t].AssociatedToAxis(Axis) then
      begin
        if Axis.Horizontal then
        begin
          if ParentChart[t].HorizAxis=aBothHorizAxis then
          begin
            if Axis=ParentChart.TopAxis then OtherAxis:=ParentChart.BottomAxis
                                        else OtherAxis:=ParentChart.TopAxis;
            result:=True;
          end;
        end
        else
        begin
          if ParentChart[t].VertAxis=aBothVertAxis then
          begin
            if Axis=ParentChart.LeftAxis then OtherAxis:=ParentChart.RightAxis
                                         else OtherAxis:=ParentChart.LeftAxis;
            result:=True;
          end;
        end;
      end;
    end;

  var tmp      : Boolean;
      tmpMin   : Double;
      tmpMax   : Double;
      tmpAxis2 : TChartAxis;
  begin
    tmp:=True;

    if Assigned(TCustomChart(ParentChart).OnAllowScroll) then
    begin
      tmpMin:=Axis.Minimum+ADelta;
      tmpMax:=Axis.Maximum+ADelta;
      TCustomChart(ParentChart).OnAllowScroll(Axis,tmpMin,tmpMax,tmp);
    end;

    if tmp then
    begin
      Axis.Scroll(ADelta,False);

      if AnySeriesBothAxis(Axis,tmpAxis2) then
         tmpAxis2.Scroll(ADelta,False);

      With TCustomChart(Axis.ParentChart) do
        if Assigned(OnScroll) then OnScroll(Axis.ParentChart); { 5.01 }
    end;
  end;

var tmp   : Integer;
    Delta : Double;
begin
  if Assigned(Axis) and Axis.Visible then
  Case AEvent of
    cmeDown: if ScrollPercent<>0 then
             With Axis do
             begin
               tmp:=ClickedArrow(x,y);
               Delta:=(Maximum-Minimum)*ScrollPercent/100.0;  // 5.02
               if ScrollInverted then Delta:=-Delta; // 5.02
               if tmp=0 then DoScroll(Delta)
               else
               if tmp=1 then DoScroll(-Delta);
               if (tmp=0) or (tmp=1) then ParentChart.CancelMouse:=True;

               if Assigned(FOnClick) and (tmp<>-1) then
                  FOnClick(Self,tmp=0); // 6.0
             end;
    cmeMove: begin
               if ClickedArrow(x,y)<>-1 then
               begin
                 ParentChart.Cursor:=crHandPoint;
                 ParentChart.CancelMouse:=True;
               end;
             end;
  end;
end;

class function TAxisArrowTool.GetEditorClass: String;
begin
  result:='TAxisArrowToolEditor';
end;

procedure TAxisArrowTool.SetPosition(const Value: TAxisArrowToolPosition);
begin
  if FPosition<>Value then
  begin
    FPosition:=Value;
    Repaint;
  end;
end;

procedure TAxisArrowTool.SetSizePercent(const Value: Integer);
begin
  SetIntegerProperty(FSizePercent,Value);
end;

{ TDrawLine }
Function TDrawLine.StartHandle:TRect;
begin
  With Parent.AxisPoint(StartPos) do result:=TeeRect(X-3,Y-3,X+3,Y+3);
end;

Function TDrawLine.EndHandle:TRect;
begin
  With Parent.AxisPoint(EndPos) do result:=TeeRect(X-3,Y-3,X+3,Y+3);
end;

Procedure TDrawLine.DrawHandles;
begin
  With Parent.ParentChart.Canvas do
  begin
    Brush.Style:=bsSolid;
    if Parent.ParentChart.Color=clBlack then Brush.Color:=clSilver
                                        else Brush.Color:=clBlack;
    Pen.Style:=psClear;
    RectangleWithZ(StartHandle,0);
    RectangleWithZ(EndHandle,0);
  end;
end;

{ TDrawLines }
function TDrawLines.Get(Index: Integer): TDrawLine;
begin
  result:=TDrawLine(inherited Items[Index]);
end;

function TDrawLines.Last: TDrawLine;
begin
  if Count=0 then result:=nil else result:=Get(Count-1);
end;

procedure TDrawLines.Put(Index: Integer; const Value: TDrawLine);
begin
  Items[Index].Assign(Value);
end;

{ TDrawLine }
{$IFNDEF CLR}
Constructor TDrawLine.CreateXY(Collection:TCollection; const X0, Y0, X1, Y1: Double);
begin
  Create(Collection);
  StartPos.X:=X0;
  StartPos.Y:=Y0;
  EndPos.X:=X1;
  EndPos.Y:=Y1;

  if Assigned(Parent) then  // 7.04
     Parent.Repaint;
end;
{$ENDIF}

Destructor TDrawLine.Destroy;  { 5.02 }
begin
  if Self=Parent.ISelected then
     Parent.ISelected:=nil;

  FPen.Free;
  inherited;
end;

procedure TDrawLine.Assign(Source: TPersistent);
begin
  if Source is TDrawLine then
  With TDrawLine(Source) do
  Begin
    Self.StartPos :=StartPos;
    Self.EndPos   :=EndPos;
    Self.FStyle   :=FStyle;

    if Assigned(FPen) then
       SetPen(FPen)
    else
    if Assigned(Self.FPen) then
       FreeAndNil(Self.FPen);

  end
  else inherited;
end;

function TDrawLine.Clicked(X,Y:Integer; AHandle:TDrawLineHandle; PixelsTolerance:Integer=0):Boolean; // 7.04
var tmpStart : TPoint;
    tmpEnd   : TPoint;
    P        : TPoint;
begin
  P:=TeePoint(X,Y);

  tmpStart:=Parent.AxisPoint(StartPos);
  tmpEnd:=Parent.AxisPoint(EndPos);

  Case AHandle of
    chStart: result:=PointInRect(StartHandle,P);
    chEnd  : result:=PointInRect(EndHandle,P);
  else
    Case Style of
        dlLine  : result:=PointInLine(P,tmpStart,tmpEnd,PixelsTolerance);
dlHorizParallel : begin
                    result:=PointInLine(P,tmpStart.X,tmpStart.Y,
                                                  tmpEnd.X,tmpStart.Y,PixelsTolerance);
                    if not result then
                       result:=PointInLine( P,tmpStart.X,tmpEnd.Y,
                                              tmpEnd.X,tmpEnd.Y,PixelsTolerance);
                  end;
    else
    begin
      result:=PointInLine( P,tmpStart.X,tmpStart.Y,