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

📄 teefibonacci.pas

📁 BCB第三方组件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{******************************************}
{ TSeriesTool Editor Dialog                }
{ Copyright (c) 2007 by Steema Software    }
{******************************************}
unit TeeFibonacci;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes,
  {$IFDEF CLX}
  QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls, QComCtrls,
  {$ELSE}
  Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls,
  {$ENDIF}
  TeeProcs, TeeToolSeriesEdit, TeCanvas, TeEngine, Chart, TeePenDlg;

type
  TFibonacciStyle=(fsArc, fsFan);

  TFibonacciTool=class;

  TFibonacciItem=class(TCollectionItem)
  private
    FPen   : TChartPen;
    FValue : TChartValue;
    procedure SetPen(const Value: TChartPen);
    procedure SetValue(const Value: Double);
  public
    Constructor Create(Collection:TCollection); override;
    Destructor Destroy; override;

    procedure Assign(Source:TPersistent); override;
  published
    property Pen:TChartPen read FPen write SetPen;
    property Value:Double read FValue write SetValue;
  end;

  TFibonacciLevels=class(TOwnedCollection)
  private
    ITool : TFibonacciTool;

    function Get(Index: Integer): TFibonacciItem;
    procedure Put(Index: Integer; const Value: TFibonacciItem);
  public
    property Level[Index:Integer]:TFibonacciItem read Get write Put; default;
  end;

  // Fibonacci fans and arcs financial tool. Tool supports Fibonacci arcs and
  // fans.
  //
  // Fibonacci arcs are charting technique consisting of three curved lines that
  // are drawn for the purpose of anticipating key support, resistance levels
  // and areas of ranging.
  // Fibonacci arcs are created by first drawing an invisible trendline between
  // two points  (usually the high and low in a given period), and then by
  // drawing three curves that intersect this trendline at the key Fibonacci
  // levels of 38.2%, 50% and 61.8%.
  //
  // Fibonacci fans are charting technique consisting of three diagonal lines
  // that use Fibonacci ratios to help identify key levels of support and
  // resistance.
  // Fibonacci fans are created by first drawing a trendline through two points
  // (usually the high and low in a given period), and then by dividing the
  // vertical distance between the two points by the key Fibonacci ratios of
  // 38.2%, 50% and 61.8%. The result of these divisions each represent a point
  // within the vertical distance. The three 'fan' lines are then created by
  // drawing a line from the leftmost point to each of the three representing
  // a Fibonacci ratio.

  TFibonacciTool=class(TTeeCustomToolSeries)
  private
    FDrawStyle  : TFibonacciStyle;
    FEndX       : Double;
    FEndY       : Double;
    FLabelsAngle: Integer;
    FLabelFont  : TTeeFont;
    FLevels     : TFibonacciLevels;
    FShowLabels : Boolean;
    FStartX     : Double;
    FStartY     : Double;
    FTrendPen   : TChartPen;

    IDefaultFab : Array of Double;
    ISp         : TPoint;

    procedure ClipDrawingRegion;
    procedure SetDrawStyle(const Value: TFibonacciStyle);
    procedure SetEndX(const Value: Double);
    procedure SetEndY(const Value: Double);
    procedure SetLabelsAngle(const Value: Integer);
    procedure SetLabelsFont(const Value: TTeeFont);
    procedure SetShowLabels(const Value: Boolean);
    procedure SetStartX(const Value: Double);
    procedure SetStartY(const Value: Double);
    procedure SetTrendPen(const Value: TChartPen);
    procedure SetLevels(const Value: TFibonacciLevels);
  protected
    Procedure ChartEvent(AEvent:TChartToolEvent); override;
    procedure DrawLevel(Index:Integer);
    class Function GetEditorClass:String; override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;

    function AxisPoint(const X,Y:Double):TPoint;
    procedure CreateDefaultLevels;
    class Function Description:String; override;
    class Function LongDescription:String; override;
    function Radius:Double;
  published
    property Active;
    property DrawStyle:TFibonacciStyle read FDrawStyle write SetDrawStyle default fsArc;
    property EndX:Double read FEndX write SetEndX;
    property EndY:Double read FEndY write SetEndY;
    property LabelsAngle:Integer read FLabelsAngle write SetLabelsAngle default 90;
    property LabelsFont:TTeeFont read FLabelFont write SetLabelsFont;
    property Levels:TFibonacciLevels read FLevels write SetLevels;
    property Pen;
    property Series;
    property ShowLabels:Boolean read FShowLabels write SetShowLabels default True;
    property StartX:Double read FStartX write SetStartX;
    property StartY:Double read FStartY write SetStartY;
    property TrendPen:TChartPen read FTrendPen write SetTrendPen;
  end;

  TFibonacciEditor = class(TSeriesToolEditor)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Panel2: TPanel;
    RGStyle: TRadioGroup;
    BTrendPen: TButtonPen;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    EXStart: TEdit;
    EYStart: TEdit;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    EXEnd: TEdit;
    EYEnd: TEdit;
    Button1: TButton;
    BRemoveLevel: TButton;
    Button3: TButton;
    GBLevels: TGroupBox;
    ELevel: TEdit;
    UDLevel: TUpDown;
    ELevelValue: TEdit;
    BLevelPen: TButtonPen;
    TabSheet3: TTabSheet;
    CBLabels: TCheckBox;
    Button2: TButton;
    Label6: TLabel;
    EAngle: TEdit;
    UDAngle: TUpDown;
    procedure FormShow(Sender: TObject);
    procedure RGStyleClick(Sender: TObject);
    procedure CBLabelsClick(Sender: TObject);
    procedure EXStartChange(Sender: TObject);
    procedure EYStartChange(Sender: TObject);
    procedure EXEndChange(Sender: TObject);
    procedure EYEndChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ELevelChange(Sender: TObject);
    procedure BRemoveLevelClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure EAngleChange(Sender: TObject);
  private
    { Private declarations }
    Fibonacci : TFibonacciTool;
    procedure SetLevel(Index:Integer);
  public
    { Public declarations }
  end;

implementation

{$IFNDEF CLX}
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{$ELSE}
{$R *.xfm}
{$ENDIF}

uses
  TeeProCo, TeeEdiFont;

{ TFibonacciTool }

Constructor TFibonacciTool.Create(AOwner: TComponent);
begin
  inherited;

  SetLength(IDefaultFab,3);
  IDefaultFab[0]:=38.2;
  IDefaultFab[1]:=50.0;
  IDefaultFab[2]:=61.8;

  FLevels:=TFibonacciLevels.Create(Self,TFibonacciItem);
  FLevels.ITool:=Self;

  FTrendPen:=CreateChartPen;
  FTrendPen.Color:=clRed;
  
  FDrawStyle:=fsArc;

  ISp:=TeePoint(-1,-1);

  FShowLabels:=True;
  FLabelsAngle:=90;

  FLabelFont:=TTeeFont.Create(CanvasChanged);

  CreateDefaultLevels;
end;

Destructor TFibonacciTool.Destroy;
begin
  IDefaultFab:=nil;
  FTrendPen.Free;
  FLabelFont.Free;
  FLevels.Free;
  inherited;
end;

procedure TFibonacciTool.Assign(Source: TPersistent);
begin
  if Source is TFibonacciTool then
  with TFibonacciTool(Source) do
  begin
    Self.FDrawStyle:=FDrawStyle;
    Self.FEndX:=FEndX;
    Self.FEndY:=FEndY;
    Self.FLabelsAngle:=FLabelsAngle;
    Self.LabelsFont:=LabelsFont;
    Self.Levels:=Levels;
    Self.FShowLabels:=FShowLabels;
    Self.FStartX:=FStartX;
    Self.FStartY:=FStartY;
    Self.TrendPen:=TrendPen;
  end;

  inherited;
end;

class function TFibonacciTool.Description: String;
begin
  result:=TeeMsg_Fibonacci;
end;

class function TFibonacciTool.GetEditorClass: String;
begin
  result:='TFibonacciEditor';
end;

class function TFibonacciTool.LongDescription: String;
begin
  result:=TeeMsg_FibonacciDesc;
end;

procedure TFibonacciTool.SetDrawStyle(const Value: TFibonacciStyle);
begin
  if FDrawStyle<>Value then
  begin
    FDrawStyle:=Value;
    Repaint;
  end;
end;

procedure TFibonacciTool.SetEndX(const Value: Double);
begin
  SetDoubleProperty(FEndX,Value);
end;

procedure TFibonacciTool.SetEndY(const Value: Double);
begin
  SetDoubleProperty(FEndY,Value);
end;

procedure TFibonacciTool.SetLabelsAngle(const Value: Integer);
begin
  SetIntegerProperty(FLabelsAngle,Value);
end;

procedure TFibonacciTool.SetLabelsFont(const Value: TTeeFont);
begin
  FLabelFont.Assign(Value);
end;

procedure TFibonacciTool.SetShowLabels(const Value: Boolean);
begin
  SetBooleanProperty(FShowLabels,Value);
end;

procedure TFibonacciTool.SetStartX(const Value: Double);
begin
  SetDoubleProperty(FStartX,Value);
end;

procedure TFibonacciTool.SetStartY(const Value: Double);
begin
  SetDoubleProperty(FStartY,Value);
end;

procedure TFibonacciTool.SetTrendPen(const Value: TChartPen);
begin
  FTrendPen.Assign(Value);
end;

procedure TFibonacciTool.SetLevels(const Value: TFibonacciLevels);
begin
  FLevels.Assign(Value);
end;

function TFibonacciTool.Radius:Double;
var rx : Integer;
    ry : Integer;
begin
  rx:=GetHorizAxis.CalcSizeValue(Abs(FEndX - FStartX));

⌨️ 快捷键说明

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