teefibonacci.pas

BCB第三方组件

  ry:=GetVertAxis.CalcSizeValue(Abs(FEndY - FStartY));
  result:=TeeDistance(rx,ry)
end;

procedure TFibonacciTool.ClipDrawingRegion;
var tmpR : TRect;
begin
  if Assigned(Series) then
  begin
    tmpR.Left:=GetHorizAxis.IStartPos;
    tmpR.Top:=GetVertAxis.IStartPos;
    tmpR.Right:=GetHorizAxis.IEndPos;
    tmpR.Bottom:=GetVertAxis.IEndPos;
  end
  else
    tmpR:=ParentChart.ChartRect;

  if ParentChart.CanClip then
     ParentChart.Canvas.ClipCube(tmpR,0,ParentChart.Width3D);
end;

function TFibonacciTool.AxisPoint(const X,Y:Double):TPoint;
begin
  result:=TeePoint(GetHorizAxis.CalcPosValue(X),GetVertAxis.CalcPosValue(Y));
end;

procedure TFibonacciTool.ChartEvent(AEvent:TChartToolEvent);

  function SamePoint(const A,B:TPoint):Boolean;
  begin
    result:=(A.X=B.X) and (A.Y=B.Y);
  end;

var t : Integer;
begin
  inherited;

  if AEvent=cteAfterDraw then
  begin
    ClipDrawingRegion;

    ParentChart.Canvas.BackMode:=cbmTransparent;
    
    // Draw trendline
    if TrendPen.Visible then
    begin
      ParentChart.Canvas.AssignVisiblePen(TrendPen);
      ParentChart.Canvas.Line(AxisPoint(FStartX,FStartY),AxisPoint(FEndX,FEndY));
    end;

    // Draw levels, but only if there is a trendline
    if (FLevels.Count > 0) and
       (not SamePoint(AxisPoint(FStartX,FStartY),AxisPoint(FEndX,FEndY))) then
    begin
      case FDrawStyle of
        fsArc: ISp:=AxisPoint(endx,endy);
        fsFan: ISp:=AxisPoint(startx,starty);
      end;

      for t:=0 to FLevels.Count-1 do
          DrawLevel(t);
    end;

    ParentChart.Canvas.UnClipRectangle;
  end;
end;

procedure TFibonacciTool.DrawLevel(Index:Integer);

  procedure Arc(const Center:TPoint; Rad:Integer; Upper:Boolean);
  var l,r,t,b : Integer;
  begin
    l := Center.X - rad;
    r := Center.X + rad;
    t := Center.Y - rad;
    b := Center.Y + rad;

    if Upper then
       ParentChart.Canvas.Arc(l, t, r, b, 0, 180)
    else
       ParentChart.Canvas.Arc(l, t, r, b, 180, 180);
  end;

  procedure Fan(const startp, endp:TPoint);
  begin
    ParentChart.Canvas.MoveTo(startp);
    ParentChart.Canvas.LineTo(endp);
  end;

var tmpRadius : Integer;
    xend,
    yend,
    k    : Double;
    endP : TPoint;
begin
  ParentChart.Canvas.AssignVisiblePen(Levels[Index].Pen);

  case FDrawStyle of
   fsArc: begin
            tmpRadius:=Round(Radius* Levels[Index].Value * 0.01);
            Arc(ISp,tmpRadius,FEndY>FStartY);

            if ShowLabels then
            begin
              ParentChart.Canvas.AssignFont(LabelsFont);
              ParentChart.Canvas.RotateLabel(ISp.X-tmpRadius, ISp.Y,
                     FloatToStr(Levels[Index].Value), LabelsAngle);
            end;
          end;

   fsFan: begin
            if Assigned(Series) then xend:=Series.XValues.Last
                                else xend:=endx;

            k:=(endy - starty) / (endx - startx) * (100.0-Levels[Index].Value) * 0.01;
            yend:=Starty + k * (xend - startx);
            endp:=AxisPoint(xend,yend);

            Fan(ISp,endp);

            if ShowLabels then
            begin
              ParentChart.Canvas.AssignFont(LabelsFont);
              ParentChart.Canvas.RotateLabel(endp.X, endp.Y,
                      FloatToStr(Levels[Index].Value), LabelsAngle);
            end;
          end;
  end;
end;

procedure TFibonacciTool.CreateDefaultLevels;
var t : Integer;
begin
  FLevels.Clear;

  for t:=Low(IDefaultFab) to High(IDefaultFab) do
      TFibonacciItem(FLevels.Add).FValue:=IDefaultFab[t];
end;

{ TFibonacciItem }

procedure TFibonacciItem.Assign(Source: TPersistent);
begin
  if Source is TFibonacciItem then
  with TFibonacciItem(Source) do
  begin
    Self.Pen:=Pen;
    Self.FValue:=FValue;
  end;

  inherited;
end;

Constructor TFibonacciItem.Create(Collection:TCollection);
begin
  inherited;
  FPen:=TFibonacciLevels(Collection).ITool.CreateChartPen;
end;

Destructor TFibonacciItem.Destroy;
begin
  FPen.Free;
  inherited;
end;

procedure TFibonacciItem.SetPen(const Value: TChartPen);
begin
  FPen := Value;
end;

procedure TFibonacciItem.SetValue(const Value: Double);
begin
  FValue := Value;
end;

{ TFibonacciLevels }

function TFibonacciLevels.Get(Index: Integer): TFibonacciItem;
begin
  result:=TFibonacciItem(inherited Items[Index]);
end;

procedure TFibonacciLevels.Put(Index: Integer;
  const Value: TFibonacciItem);
begin
  inherited Items[Index]:=Value;
end;

{ TFibonacciEditor }

procedure TFibonacciEditor.RGStyleClick(Sender: TObject);
begin
  Fibonacci.DrawStyle:=TFibonacciStyle(RGStyle.ItemIndex);
end;

procedure TFibonacciEditor.FormShow(Sender: TObject);
begin
  inherited;

  Fibonacci:=TFibonacciTool(Tool);

  if Assigned(Fibonacci) then
  begin
    with Fibonacci do
    begin
      RGStyle.ItemIndex:=Ord(DrawStyle);
      CBLabels.Checked:=ShowLabels;
      BTrendPen.LinkPen(TrendPen);

      EXStart.Text:=FloatToStr(StartX);
      EYStart.Text:=FloatToStr(StartY);

      EXEnd.Text:=FloatToStr(EndX);
      EYEnd.Text:=FloatToStr(EndY);

      UDAngle.Position:=LabelsAngle;
    end;

    SetLevel(0);
  end;
end;

procedure TFibonacciEditor.CBLabelsClick(Sender: TObject);
begin
  Fibonacci.ShowLabels:=CBLabels.Checked;
end;

procedure TFibonacciEditor.EXStartChange(Sender: TObject);
var tmp : Double;
begin
  if Showing then
     with Fibonacci do
          if TryStrToFloat(EXStart.Text,tmp) then
             StartX:=tmp;
end;

procedure TFibonacciEditor.EYStartChange(Sender: TObject);
var tmp : Double;
begin
  if Showing then
     with Fibonacci do
          if TryStrToFloat(EYStart.Text,tmp) then
             StartY:=tmp;
end;

procedure TFibonacciEditor.EXEndChange(Sender: TObject);
var tmp : Double;
begin
  if Showing then
     with Fibonacci do
          if TryStrToFloat(EXEnd.Text,tmp) then
             EndX:=tmp;
end;

procedure TFibonacciEditor.EYEndChange(Sender: TObject);
var tmp : Double;
begin
  if Showing then
     with Fibonacci do
          if TryStrToFloat(EYEnd.Text,tmp) then
             EndY:=tmp;
end;

procedure TFibonacciEditor.Button1Click(Sender: TObject);
begin
  SetLevel(Fibonacci.Levels.Add.Index);
end;

procedure TFibonacciEditor.ELevelChange(Sender: TObject);
begin
  if GBLevels.Enabled then
  with Fibonacci.Levels[UDLevel.Position] do
  begin
    ELevelValue.Text:=FloatToStr(Value);
    BLevelPen.LinkPen(Pen);
  end;
end;

procedure TFibonacciEditor.SetLevel(Index:Integer);
begin
  GBLevels.Enabled:=(Fibonacci.Levels.Count>0);
  BRemoveLevel.Enabled:=GBLevels.Enabled;

  if GBLevels.Enabled then
  begin
    UDLevel.Max:=Fibonacci.Levels.Count-1;

    if Index>UDLevel.Max then
       Index:=UDLevel.Max;

    UDLevel.Position:=Index;
  end;
end;

procedure TFibonacciEditor.BRemoveLevelClick(Sender: TObject);
begin
  {$IFDEF D5}
  Fibonacci.Levels.Delete(UDLevel.Position);
  {$ELSE}
  Fibonacci.Levels[UDLevel.Position].Free;
  {$ENDIF}
  
  SetLevel(UDLevel.Position);
end;

procedure TFibonacciEditor.Button3Click(Sender: TObject);
begin
  Fibonacci.CreateDefaultLevels;
  SetLevel(0);
end;

procedure TFibonacciEditor.Button2Click(Sender: TObject);
begin
  EditTeeFontEx(Self,Fibonacci.LabelsFont);
end;

procedure TFibonacciEditor.EAngleChange(Sender: TObject);
begin
  if Showing then
     Fibonacci.LabelsAngle:=UDAngle.Position;
end;

initialization
  RegisterClass(TFibonacciEditor);
  RegisterTeeTools([TFibonacciTool]);
finalization
  UnRegisterTeeTools([TFibonacciTool]);
end.