candlech.pas

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

Procedure TVolumeSeries.SetVolumeValues(Value:TChartValueList);
Begin
  SetYValues(Value);
end;

Procedure TVolumeSeries.PrepareCanvas(Forced:Boolean; AColor:TColor);
begin
  if Forced or (AColor<>IColor) then
  begin
    ParentChart.Canvas.AssignVisiblePenColor(LinePen,AColor);
    ParentChart.Canvas.BackMode:=cbmTransparent;
    IColor:=AColor;
  end;
end;

procedure TVolumeSeries.DrawValue(ValueIndex:Integer);
Begin
  PrepareCanvas(ValueIndex=FirstDisplayedIndex, ValueColor[ValueIndex]);

  { moves to x,y coordinates and draws a vertical bar to top or bottom,
    depending on the vertical Axis.Inverted property }

  with ParentChart do
  if View3D then
     Canvas.VertLine3D(CalcXPos(ValueIndex),CalcYPos(ValueIndex),OriginPosition,MiddleZ)
  else
     Canvas.DoVertLine(CalcXPos(ValueIndex),OriginPosition,CalcYPos(ValueIndex)); { 5.02 }
end;

function TVolumeSeries.OriginPosition:Integer; // 7.05
begin
  if UseYOrigin then
     result:=CalcYPosValue(YOrigin) { 5.02 }
  else
  With GetVertAxis do
       if Inverted then result:=IStartPos
                   else result:=IEndPos;
end;

Function TVolumeSeries.NumSampleValues:Integer;
Begin
  result:=40;
end;

Procedure TVolumeSeries.AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False);
Var t : Integer;
    s : TSeriesRandomBounds;
begin
  s:=RandomBounds(NumValues);
  with s do
  for t:=1 to NumValues do
  Begin
    AddXY(tmpX,RandomValue(Round(DifY) div 15));
    tmpX:=tmpX+StepX;
  end;
end;

Procedure TVolumeSeries.PrepareForGallery(IsEnabled:Boolean);
begin
  inherited;
  FillSampleValues(26);
  Pointer.InflateMargins:=True;
end;

class Function TVolumeSeries.GetEditorClass:String;
Begin
  result:='TVolumeSeriesEditor';
End;

class procedure TVolumeSeries.CreateSubGallery(
  AddSubChart: TChartSubGalleryProc);
begin
  inherited;
  AddSubChart(TeeMsg_Dotted);
  AddSubChart(TeeMsg_Colors);
  AddSubChart(TeeMsg_Origin); { 5.02 }
end;

class procedure TVolumeSeries.SetSubGallery(ASeries: TChartSeries;
  Index: Integer);
begin
  With TVolumeSeries(ASeries) do
  Case Index of
    1: Pen.SmallDots:=True;
    2: ColorEachPoint:=True;
    3: UseYOrigin:=True;
  else inherited
  end;
end;

procedure TVolumeSeries.DrawLegendShape(ValueIndex: Integer; { 5.01 }
  const Rect: TRect);
begin
  With Rect do ParentChart.Canvas.DoHorizLine(Left,Right,(Top+Bottom) div 2);
end;

procedure TVolumeSeries.Assign(Source: TPersistent);
begin
  if Source is TVolumeSeries then
  with TVolumeSeries(Source) do
  begin
    Self.FUseYOrigin:= UseYOrigin;
    Self.FOrigin    := YOrigin;
  end;
  inherited;
end;

procedure TVolumeSeries.SetOrigin(const Value: Double);
begin
  SetDoubleProperty(FOrigin,Value);
end;

procedure TVolumeSeries.SetUseOrigin(const Value: Boolean);
begin
  SetBooleanProperty(FUseYOrigin,Value);
end;

procedure TVolumeSeries.PrepareLegendCanvas(ValueIndex: Integer;
  var BackColor: TColor; var BrushStyle: TBrushStyle);
begin
  PrepareCanvas(True,SeriesColor);
end;

function TVolumeSeries.Clicked(x, y: Integer): Integer;  // 7.05
var t    : Integer;
    P    : TPoint;
    tmpX : Integer;
    tmpOrigin : Integer;
begin
  if (FirstValueIndex>-1) and (LastValueIndex>-1) then  // AX 7.06
  begin
    P.X:=x;
    P.Y:=y;

    tmpOrigin:=OriginPosition;

    for t:=FirstValueIndex to LastValueIndex do
    begin
      tmpX:=CalcXPos(t);

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

  result:=TeeNoPointClicked;
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;
  begin
    Index:=Index-Round(Period);
    result:=(100*Abs(IDMUp.YValues.Value[Index]-IDMDown.YValues.Value[Index])/
                    (IDMUp.YValues.Value[Index]+IDMDown.YValues.Value[Index]));
  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';
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;

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);
  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]);
  UnRegisterTeeFunctions([ TADXFunction,TRSIFunction ]);
end.