⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 candlech.pas

📁 TeeChart7Source 控件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{**********************************************}
{   TCandleSeries (derived from OHLCSeries)    }
{   TVolumeSeries (derived from TCustomSeries) }
{   TRSIFunction  (Resistance Strength Index)  }
{   TADXFunction                               }
{                                              }
{   Copyright (c) 1995-2004 by David Berneda   }
{**********************************************}
unit CandleCh;
{$I TeeDefs.inc}

interface

{
  Financial TCandleSeries derives from TOHLCSeries (Open, High, Low & Close).
  See OHLChart.pas unit for TOHLCSeries source code.

  TCandleSeries overrides the TChartSeries.DrawValue method to paint its
  points in several financial styles (CandleStick, Bars, OpenClose, etc).

  TVolumeSeries overrides the TChartSeries.DrawValue method to paint
  points as thin vertical bars.

  TADXFunction is a commonly used financial indicator. It requires an
  OHLC (financial) series as the datasource.

  TRSIFunction (Resistence Strength Index) is a commonly used financial
  indicator. It requires an OHLC (financial) series as the datasource.
}
Uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     Classes,
     {$IFDEF CLX}
     QGraphics, Types,
     {$ELSE}
     Graphics,
     {$ENDIF}
     Chart, Series, OHLChart, TeEngine, TeCanvas;

Const DefCandleWidth = 4;  { 2 + 1 + 2  Default width for Candle points }

type
  TCandleStyle=(csCandleStick,csCandleBar,csOpenClose,csLine);

  TCandleItem=packed record
    yOpen  : Integer;
    yClose : Integer;
    yHigh  : Integer;
    yLow   : Integer;
    tmpX   : Integer;
    tmpLeftWidth  : Integer;
    tmpRightWidth : Integer;
  end;

  TCandleSeries=class(TOHLCSeries)
  private
    FCandleStyle    : TCandleStyle;
    FCandleWidth    : Integer;
    FDownCloseColor : TColor;
    FHighLowPen     : TChartPen;
    FShowCloseTick  : Boolean;
    FShowOpenTick   : Boolean;
    FUpCloseColor   : TColor;

    OldP            : TPoint;
    procedure CalcItem(ValueIndex:Integer; var AItem:TCandleItem);
    Function GetDark3D:Boolean;
    Function GetDraw3D:Boolean;
    Function GetPen:TChartPen;
    procedure SetCandlePen(Value:TChartPen);
    Procedure SetCandleStyle(Value:TCandleStyle);
    Procedure SetCandleWidth(Value:Integer);
    procedure SetDark3D(Value:Boolean);
    Procedure SetDownColor(Value:TColor);
    procedure SetDraw3D(Value:Boolean);
    Procedure SetShowCloseTick(Value:Boolean);
    Procedure SetShowOpenTick(Value:Boolean);
    Procedure SetUpColor(Value:TColor);
    procedure SetHighLowPen(const Value: TChartPen);
  protected
    Function CalculateColor(ValueIndex:Integer):TColor;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    procedure DrawValue(ValueIndex:Integer); override;
    class Function GetEditorClass:String; override;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Function AddCandle( Const ADate:TDateTime;
                        Const AOpen,AHigh,ALow,AClose:Double):Integer;
    Function Clicked(x,y:Integer):Integer; override;
    function ClickedCandle(ValueIndex:Integer; const P:TPoint):Boolean;
    Function LegendItemColor(LegendIndex:Integer):TColor; override;
    Function MaxYValue:Double; override;
    Function MinYValue:Double; override;
  published
    property Active;
    property ColorEachPoint;
    property ColorSource;
    property Cursor;
    property Depth;
    property HorizAxis;
    property Marks;
    property ParentChart;
    property DataSource;
    property PercentFormat;
    property SeriesColor;
    property ShowInLegend;
    property Title;
    property ValueFormat;
    property VertAxis;
    property XLabelsSource;

    { events }
    property AfterDrawValues;
    property BeforeDrawValues;
    property OnAfterAdd;
    property OnBeforeAdd;
    property OnClearValues;
    property OnClick;
    property OnDblClick;
    property OnGetMarkText;
    property OnMouseEnter;
    property OnMouseLeave;

    property CandleStyle:TCandleStyle read FCandleStyle write SetCandleStyle
                                      default csCandleStick;
    property CandleWidth:Integer read FCandleWidth write SetCandleWidth
                                 default DefCandleWidth;
    property Draw3D:Boolean read GetDraw3D write SetDraw3D default False;
    property Dark3D:Boolean read GetDark3D write SetDark3D default True;
    property DownCloseColor:TColor read FDownCloseColor write SetDownColor
                                   default clRed;
    property HighLowPen:TChartPen read FHighLowPen write SetHighLowPen;
    property ShowCloseTick:Boolean read FShowCloseTick write SetShowCloseTick
                                   default True;
    property ShowOpenTick:Boolean read FShowOpenTick write SetShowOpenTick
                                  default True;
    property UpCloseColor:TColor read FUpCloseColor write SetUpColor
                                 default clWhite;
    property Pen:TChartPen read GetPen write SetCandlePen;
  end;

  { Used in financial charts for Volume quantities (or OpenInterest) }
  { Overrides FillSampleValues to create random POSITIVE values }
  { Overrides DrawValue to paint a thin vertical bar }
  { Declares VolumeValues (same like YValues) }
  TVolumeSeries=class(TCustomSeries)
  private
    FUseYOrigin: Boolean;

    FOrigin: Double;
    IColor : TColor;
    Function GetVolumeValues:TChartValueList;
    Procedure PrepareCanvas(Forced:Boolean; AColor:TColor);
    procedure SetOrigin(const Value: Double);
    procedure SetUseOrigin(const Value: Boolean);
    Procedure SetVolumeValues(Value:TChartValueList);
  protected
    Procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    Procedure DrawLegendShape(ValueIndex:Integer; Const Rect:TRect); override;
    procedure DrawValue(ValueIndex:Integer); override;
    class Function GetEditorClass:String; override;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    Procedure PrepareLegendCanvas( ValueIndex:Integer; Var BackColor:TColor;
                                   Var BrushStyle:TBrushStyle); override;
    Procedure SetSeriesColor(AColor:TColor); override;
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;
  public
    Constructor Create(AOwner: TComponent); override;
    Procedure Assign(Source:TPersistent); override;
    Function NumSampleValues:Integer; override;
  published
    property Active;
    property ColorEachPoint;
    property ColorSource;
    property Cursor;
    property HorizAxis;
    property Marks;
    property ParentChart;
    property DataSource;
    property PercentFormat;
    property SeriesColor;
    property ShowInLegend;
    property Title;
    property ValueFormat;
    property VertAxis;
    property XLabelsSource;

    { events }
    property AfterDrawValues;
    property BeforeDrawValues;
    property OnAfterAdd;
    property OnBeforeAdd;
    property OnClearValues;
    property OnClick;
    property OnDblClick;
    property OnGetMarkText;
    property OnMouseEnter;
    property OnMouseLeave;

    property LinePen;
    property UseYOrigin:Boolean read FUseYOrigin write SetUseOrigin default False;
    property VolumeValues:TChartValueList read GetVolumeValues write SetVolumeValues;
    property XValues;
    property YOrigin:Double read FOrigin write SetOrigin;
  end;

  { Financial A.D.X function }
  TADXFunction=class(TTeeFunction)
  private
    IDMDown : TFastLineSeries;
    IDMUp   : TFastLineSeries;
    function GetDownPen: TChartPen;
    function GetUpPen: TChartPen;
    procedure SetDownPen(const Value: TChartPen);
    procedure SetUpPen(const Value: TChartPen);
  protected
    class Function GetEditorClass:String; override;
    Function IsValidSource(Value:TChartSeries):Boolean; override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override; { 5.01 }

    procedure AddPoints(Source:TChartSeries); override;
    property DMDown:TFastLineSeries read IDMDown;
    property DMUp:TFastLineSeries read IDMUp;
  published
    property DownLinePen:TChartPen read GetDownPen write SetDownPen;
    property UpLinePen:TChartPen read GetUpPen write SetUpPen;
  end;

  { RSI, Relative Strentgh Index }
  TRSIStyle=(rsiOpenClose,rsiClose);

  TRSIFunction = class(TTeeMovingFunction)
  private
    FStyle  : TRSIStyle;

    ISeries : TChartSeries;
    Opens   : TChartValueList;
    Closes  : TChartValueList;
    procedure SetStyle(Const Value:TRSIStyle);
  protected
    Function IsValidSource(Value:TChartSeries):Boolean; override;
  public
    Constructor Create(AOwner:TComponent); override;

    Function Calculate( Series:TChartSeries;
                        FirstIndex,LastIndex:Integer):Double; override;
  published
    property Style:TRSIStyle read FStyle write SetStyle default rsiOpenClose;
  end;

implementation

Uses {$IFDEF CLR}
     {$ELSE}
     Math, SysUtils,
     {$ENDIF}
     TeeProcs, TeeProCo, TeeConst;

{ TCandleSeries }
Constructor TCandleSeries.Create(AOwner: TComponent);
Begin
  inherited;
  FUpCloseColor  :=clWhite;
  FDownCloseColor:=clRed;
  FCandleWidth   :=DefCandleWidth;
  FCandleStyle   :=csCandleStick;
  FShowOpenTick  :=True;
  FShowCloseTick :=True;
  Pointer.Draw3D :=False;

  FHighLowPen:=TChartPen.Create(CanvasChanged);  // 7.0
  FHighLowPen.Color:=clTeeColor;
end;

Procedure TCandleSeries.SetShowOpenTick(Value:Boolean);
Begin
  SetBooleanProperty(FShowOpenTick,Value);
End;

Procedure TCandleSeries.SetShowCloseTick(Value:Boolean);
Begin
  SetBooleanProperty(FShowCloseTick,Value);
End;

Function TCandleSeries.CalculateColor(ValueIndex:Integer):TColor;
Begin
  result:=ValueColor[ValueIndex];
  if result=SeriesColor then
  begin
    if OpenValues.Value[ValueIndex]>CloseValues.Value[ValueIndex] then { 5.01 }
       result:=FDownCloseColor
    else
    if OpenValues.Value[ValueIndex]<CloseValues.Value[ValueIndex] then
       result:=FUpCloseColor
    else
    Begin
      { color algorithm when open is equal to close }
      if ValueIndex=0 then
         result:=FUpCloseColor  { <-- first point }
      else
      if CloseValues.Value[ValueIndex-1]>CloseValues.Value[ValueIndex] then
         result:=FDownCloseColor
      else
      if CloseValues.Value[ValueIndex-1]<CloseValues.Value[ValueIndex] then
         result:=FUpCloseColor
      else
         result:=ValueColor[ValueIndex-1];
    end;
  end;
end;

procedure TCandleSeries.CalcItem(ValueIndex:Integer; var AItem:TCandleItem);
begin
  with AItem do
  begin
    tmpX:=CalcXPosValue(DateValues.Value[ValueIndex]); { The horizontal position }

    { Vertical positions of Open, High, Low & Close values for this point }
    YOpen :=CalcYPosValue(OpenValues.Value[ValueIndex]);
    YHigh :=CalcYPosValue(HighValues.Value[ValueIndex]);
    YLow  :=CalcYPosValue(LowValues.Value[ValueIndex]);
    YClose:=CalcYPosValue(CloseValues.Value[ValueIndex]);

    tmpLeftWidth:=FCandleWidth div 2; { calc half Candle Width }
    tmpRightWidth:=FCandleWidth-tmpLeftWidth;
  end;
end;

procedure TCandleSeries.DrawValue(ValueIndex:Integer);

  Procedure CheckHighLowPen;
  begin
    with ParentChart.Canvas do
    begin
      if HighLowPen.Color=clTeeColor then
         AssignVisiblePenColor(HighLowPen,Self.Pen.Color)
      else
         AssignVisiblePen(HighLowPen);

      BackMode:=cbmTransparent;
    end;
  end;

var tmpItem   : TCandleItem;
    tmpTop    : Integer;
    tmpBottom : Integer;
    P         : TPoint;
    tmpFirst  : Integer;
begin
  if Assigned(OnGetPointerStyle) then  { 5.02 }
     OnGetPointerStyle(Self,ValueIndex);

  { Prepare Pointer Pen and Brush styles }
  Pointer.PrepareCanvas(ParentChart.Canvas,clTeeColor);

  CalcItem(ValueIndex,tmpItem);

  with tmpItem,ParentChart,Canvas do
  begin
    if (FCandleStyle=csCandleStick) or (FCandleStyle=csOpenClose) then
    begin { draw Candle Stick }

      CheckHighLowPen;

      if View3D and Pointer.Draw3D then
      begin
        tmpTop:=yClose;
        tmpBottom:=yOpen;
        if tmpTop>tmpBottom then SwapInteger(tmpTop,tmpBottom);

        { Draw Candle Vertical Line from bottom to Low }
        if FCandleStyle=csCandleStick then
           VertLine3D(tmpX,tmpBottom,yLow,MiddleZ);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -