candlech.pas

BCB第三方组件

      if PointInLine(P,TeePoint(tmpX,tmpOrigin),TeePoint(tmpX,CalcYPos(t)),Pen.Width-1) then
      begin
        result:=t;
        exit;
      end;
    end;
  end;

  result:=TeeNoPointClicked;
end;

procedure TVolumeSeries.CalcHorizMargins(var LeftMargin,
  RightMargin: Integer);
begin
  inherited;
  Inc(LeftMargin,LinePen.Width);
  Inc(RightMargin,LinePen.Width);
end;

{ TADXFunction }
type TChartSeriesAccess=class(TChartSeries);

Constructor TADXFunction.Create(AOwner: TComponent);

  Procedure HideSeries(ASeries:TChartSeries);
  begin
    ASeries.ShowInLegend:=False;
    TChartSeriesAccess(ASeries).DontSerialize:=True;
    ASeries.ShowInEditor:=False;
  end;

begin
  inherited;
  InternalSetPeriod(14);
  SingleSource:=True;
  HideSourceList:=True;

  IDMDown:=TFastLineSeries.Create(Self);
  HideSeries(IDMDown);
  IDMDown.SeriesColor:=clRed;

  IDMUp:=TFastLineSeries.Create(Self);
  HideSeries(IDMUp);
  IDMUp.SeriesColor:=clGreen;
end;

procedure TADXFunction.AddPoints(Source: TChartSeries);

  Procedure PrepareSeries(ASeries:TChartSeries);
  begin
    With ASeries do
    begin
      ParentChart:=ParentSeries.ParentChart;
      CustomVertAxis:=ParentSeries.CustomVertAxis;
      VertAxis:=ParentSeries.VertAxis;
      XValues.DateTime:=ParentSeries.XValues.DateTime;
      AfterDrawValues:=ParentSeries.AfterDrawValues;
      BeforeDrawValues:=ParentSeries.BeforeDrawValues;
    end;
  end;

  Function CalcADX(Index:Integer):Double;
  var tmpUp   : TChartValue;
      tmpDown : TChartValue;
      tmp     : TChartValue;
  begin
    Index:=Index-Round(Period);

    tmpUp:=IDMUp.YValues.Value[Index];
    tmpDown:=IDMDown.YValues.Value[Index];

    tmp:=tmpUp+tmpDown;

    if tmp=0 then  // 7.07
       result:=0
    else
       result:=(100*Abs(tmpUp-tmpDown)/tmp);
  end;

var tmpTR,
    tmpDMUp,
    tmpDMDown : Array of Double;
    t         : Integer;
    tt        : Integer;
    tmpClose  : Double;
    Closes,
    Highs,
    Lows      : TChartValueList;
    tmpTR2,
    tmpUp2,
    tmpDown2  : Double;
    tmpX      : Double;
    tmp       : Integer;
    tmpADX    : Double;
begin
  if Period<2 then Exit; // 5.03

  ParentSeries.Clear;
  IDMUp.Clear;
  IDMDown.Clear;
  PrepareSeries(IDMUp);
  PrepareSeries(IDMDown);

  if Source.Count>=(2*Period) then
  begin
    With TOHLCSeries(Source) do
    begin
      Closes:=CloseValues;
      Highs:=HighValues;
      Lows:=LowValues;
    end;

    SetLength(tmpTR, Source.Count);
    SetLength(tmpDMUp, Source.Count);
    SetLength(tmpDMDown, Source.Count);

    for t:=1 to Source.Count-1 do
    begin
      tmpClose:=Closes.Value[t-1];
      tmpTR[t]:=Highs.Value[t]-Lows.Value[t];
      tmpTR[t]:=Math.Max(tmpTR[t],Abs(Highs.Value[t]-tmpClose));
      tmpTR[t]:=Math.Max(tmpTR[t],Abs(Lows.Value[t]-tmpClose));

      if (Highs.Value[t]-Highs.Value[t-1])>(Lows.Value[t-1]-Lows.Value[t]) then
          tmpDMUp[t]:=Math.Max(0,Highs.Value[t]-Highs.Value[t-1])
      else
          tmpDMUp[t]:=0;

      if (Lows.Value[t-1]-Lows.Value[t])>(Highs.Value[t]-Highs.Value[t-1]) then
          tmpDMDown[t]:=Math.Max(0,Lows.Value[t-1]-Lows.Value[t])
      else
          tmpDMDown[t]:=0;
    end;

    tmpTR2:=0;
    tmpUp2:=0;
    tmpDown2:=0;

    tmp:=Round(Period);

    for t:=tmp to Source.Count-1 do
    begin
      if t=tmp then
      begin
        for tt:=1 to Round(Period) do
        begin
          tmpTR2  :=tmpTR2+tmpTR[tt];
          tmpUp2  :=tmpUp2+tmpDMUp[tt];
          tmpDown2:=tmpDown2+tmpDMDown[tt];
        end;
      end
      else
      begin
        tmpTR2:=tmpTR2-(tmpTR2/Period)+tmpTR[t];
        tmpUp2:=tmpUp2-(tmpUp2/Period)+tmpDMUp[t];
        tmpDown2:=tmpDown2-(tmpDown2/Period)+tmpDMDown[t];
      end;

      tmpX:=Source.XValues[t];
      IDMUp.AddXY( tmpX, 100*(tmpUp2/tmpTR2));
      IDMDown.AddXY( tmpX, 100*(tmpDown2/tmpTR2));
    end;

    tmpTR:=nil;
    tmpDMUp:=nil;
    tmpDMDown:=nil;
    tmpADX:=0;

    tmp:=Round((2*Period)-2);

    for t:=tmp to Source.Count-1 do
    begin
      if t=tmp then
      begin
        tmpADX:=0;

        for tt:=Round(Period) to tmp do
            tmpADX:=tmpADX+CalcADX(tt);

        tmpADX:=tmpADX/(Period-1);
      end
      else
      begin
        tmpADX:=((tmpADX*(Period-1))+(CalcADX(t)))/Period;
      end;

      ParentSeries.AddXY(Source.XValues[t],tmpADX);
    end;
  end;
end;

Destructor TADXFunction.Destroy; { 5.01 }
begin
  DMDown.Free;
  DMUp.Free;
  inherited;
end;

class function TADXFunction.GetEditorClass: String;
begin
  result:='TADXFuncEditor'; // Do not localize
end;

function TADXFunction.IsValidSource(Value: TChartSeries): Boolean;
begin
  result:=Value is TOHLCSeries;
end;

function TADXFunction.GetDownPen: TChartPen;
begin
  result:=DMDown.Pen;
end;

function TADXFunction.GetUpPen: TChartPen;
begin
  result:=DMUp.Pen;
end;

procedure TADXFunction.SetDownPen(const Value: TChartPen);
begin
  DMDown.Pen:=Value;
end;

procedure TADXFunction.SetUpPen(const Value: TChartPen);
begin
  DMUp.Pen:=Value;
end;

{ R.S.I. }
Constructor TRSIFunction.Create(AOwner: TComponent);
begin
  inherited;
  FStyle:=rsiOpenClose;
  SingleSource:=True;
  HideSourceList:=True;
end;

Function TRSIFunction.Calculate( Series:TChartSeries;
                                 FirstIndex,LastIndex:Integer):Double;
var NumPoints : Integer;
    t         : Integer;
    tmpClose  : Double;
    Ups       : Double;
    Downs     : Double;
Begin
  if ISeries<>Series then
  begin // Cache lists during calculation
    Closes:=Series.GetYValueList(TeeMsg_ValuesClose);
    Opens :=Series.GetYValueList(TeeMsg_ValuesOpen);
    ISeries:=Series;
  end;

  Ups:=0;
  Downs:=0;

  With Series do
  Begin
    if Self.Style=rsiOpenClose then
    begin // use today Close and Open prices (do not use "yesterday" close)
      for t:=FirstIndex to LastIndex do
      Begin
        tmpClose:=Closes.Value[t];
        if Opens.Value[t]>tmpClose then Downs:=Downs+tmpClose
                                   else Ups  :=Ups  +tmpClose;
      end;
    end
    else
    begin // Use Close prices (today - yesterday)
      for t:=FirstIndex+1 to LastIndex do
      Begin
        tmpClose:=Closes.Value[t]-Closes.Value[t-1];
        if tmpClose<0 then Downs:=Downs-tmpClose
                      else Ups  :=Ups  +tmpClose;
      end;
    end;
  end;

  { Calculate RSI }
  NumPoints:=(LastIndex-FirstIndex)+1;
  Downs:=Downs/NumPoints;
  Ups  :=Ups  /NumPoints;
  if Downs<>0 then
  Begin
    result:=100.0 - ( 100.0 / ( 1.0+Abs(Ups/Downs) ) );
    if result<0   then result:=0 else
    if result>100 then result:=100;
  end
  else result:=100; // Special case, to avoid divide by zero
end;

// R.S.I. function needs an OHLC series values to calculate.
function TRSIFunction.IsValidSource(Value: TChartSeries): Boolean;
begin
  result:=Value is TOHLCSeries;
end;

procedure TRSIFunction.SetStyle(const Value: TRSIStyle);
begin
  if Style<>Value then
  begin
    FStyle:=Value;
    ReCalculate;
  end;
end;

{ TDarvasSeries }
constructor TDarvasSeries.Create(AOwner: TComponent);
begin
  inherited;
  FBoxBrush:=TChartBrush.Create(CanvasChanged);
  FBoxBrush.BackColor:=clTeeColor;

  FBoxPen:=CreateChartPen;

  Transparency:=70;
end;

Destructor TDarvasSeries.Destroy;
begin
  FBoxBrush.Free;
  FBoxPen.Free;
  Boxes:=nil;
  BoxesRect:=nil;
  inherited;
end;

// Algorithm based on:
// http://www.gerryco.com/tech/darvas.html state diagram.
procedure TDarvasSeries.CalculateBoxes;
var
  BoxTop,
  BoxBottom : TChartValue;
  StartIndex,
  EndIndex,
  TopIndex,
  BottomIndex,
  Today,
  State     : Integer;
begin
  FNumBoxes:=0;
  Boxes:=nil;
  BoxesRect:=nil;

  State:=0;
  Today:=0;
  TopIndex:=-1;
  BottomIndex:=-1;
  BoxTop:=HighValues.MinValue;
  BoxBottom:=LowValues.MaxValue;
  StartIndex:=0;

  repeat
    case State of
      0: begin
           StartIndex:=Today;
           State:=1;
         end;

      1: if Today<Count then
         begin
           BoxTop:=HighValues.Items[Today];
           TopIndex:=Today;
           BottomIndex:=Today;
           Inc(Today);

           if Today<Count then
              if BoxTop>HighValues.Items[Today] then State:=2
                                                else State:=1;
         end
         else State:=5;

      2: if Today<Count then
         begin
           Inc(Today);

           if Today<Count then
              if BoxTop>HighValues.Items[Today] then State:=3
                                                else State:=1;
         end
         else State:=5;

      3: if Today<Count then
         begin
           BoxBottom:=LowValues.Items[Today];
           BottomIndex:=Today;
           Inc(Today);

           if Today<Count then
              if BoxTop>HighValues.Items[Today] then
                 if BoxBottom<LowValues.Items[Today] then State:=4
                                                     else State:=3
              else State:=1;
         end
         else State:=5;

      4: if Today<Count then
         begin
           Inc(Today);

           if Today<Count then
              if BoxTop>HighValues.Items[Today] then
                 if BoxBottom<LowValues.Items[Today] then State:=5
                                                     else State:=3
              else State:=1;
         end
         else State:=5;

      5: if Today<Count then
         begin
           Inc(Today);

           if Today<Count then
              if ((BoxTop<HighValues.Items[Today]) or
                  (BoxBottom>LowValues.Items[Today])) then
                 State:=6
              else
                 State:=5;
         end
         else State:=6;

      6: begin
           if Today<Count then EndIndex:=Today
                          else EndIndex:=Today-1;

           SetLength(Boxes,FNumBoxes+1);
           with Boxes[NumBoxes] do
           begin
             Left:=StartIndex;
             Top:=TopIndex;
             Right:=EndIndex;
             Bottom:=BottomIndex;
           end;

           SetLength(BoxesRect,FNumBoxes+1);
           with BoxesRect[NumBoxes] do
           begin
             Left:=CalcXPos(StartIndex);
             Top:=GetVertAxis.CalcYPosValue(HighValues.Value[TopIndex]);
             Right:=CalcXPos(EndIndex);
             Bottom:=GetVertAxis.CalcYPosValue(LowValues.Value[BottomIndex]);
           end;

           Inc(FNumBoxes);

           if Today<Count then State:=0
                          else State:=7;
        end;
    end;

  until State=7;
end;

procedure TDarvasSeries.DrawAllValues;
var tmpBlend : TTeeBlend;
    t        : Integer;
    tmpColor : TColor;
begin
  inherited;

  CalculateBoxes;

  with ParentChart.Canvas do
  begin
    if Transparency<>0 then
       tmpBlend:=BeginBlending(TeeZeroRect, Transparency)
    else
       tmpBlend:=nil;

    try
      AssignVisiblePen(Self.FBoxPen);

      for t:=0 to NumBoxes-1 do
      begin
        if Assigned(tmpBlend) then
           tmpBlend.SetRectangle(BoxesRect[t]);

        tmpColor:=Self.FBoxBrush.BackColor;
        if tmpColor=clTeeColor then
           tmpColor:=ParentChart.GetDefaultColor(1);

        AssignBrush(Self.FBoxBrush,tmpColor);

        if ParentChart.View3D then
           RectangleWithZ(BoxesRect[t],StartZ)
        else
           Rectangle(BoxesRect[t]);

        if t<(NumBoxes-1) then
           if Assigned(tmpBlend) then
              tmpBlend.DoBlend(Transparency);
      end;

    finally
      if Assigned(tmpBlend) then
         EndBlending(tmpBlend);
    end;
  end;
end;

function TDarvasSeries.ClickedBox(x, y: Integer): Integer;
var t : Integer;
begin
  result:=TeeNoPointClicked;

  if Assigned(ParentChart) then
     ParentChart.Canvas.Calculate2DPosition(X,Y,StartZ);

  for t:=0 to NumBoxes-1 do
      if PointInRect(BoxesRect[t],x,y) then
      begin
        result:=t;
        break;
      end;
end;

procedure TDarvasSeries.Assign(Source: TPersistent);
begin
  if Source is TDarvasSeries then
  With TDarvasSeries(Source) do
  begin
    Self.BoxBrush:=FBoxBrush;
    Self.BoxPen:=FBoxPen;
  end;

  inherited;
end;

procedure TDarvasSeries.SetBoxBrush(const Value: TChartBrush);
begin
  FBoxBrush.Assign(Value);
end;

procedure TDarvasSeries.SetBoxPen(const Value: TChartPen);
begin
  FBoxPen.Assign(Value);
end;

initialization
  RegisterTeeSeries( TCandleSeries, {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryCandle,
                                    {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial, 1);
  RegisterTeeSeries( TVolumeSeries, {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryVolume,
                                    {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial, 1);
  RegisterTeeSeries( TDarvasSeries, {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryDarvas,
                                    {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial, 1);

  RegisterTeeFunction( TADXFunction, {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionADX,
                                     {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial );
  RegisterTeeFunction( TRSIFunction, {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionRSI,
                                     {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial );
finalization
  UnRegisterTeeSeries([TCandleSeries,TVolumeSeries,TDarvasSeries]);
  UnRegisterTeeFunctions([ TADXFunction,TRSIFunction ]);
end.