iplotchannel.pas

iocopm3.04源码,一套很好的工控开发工具

  FBarBrushUseChannelColor := True;

  FHighLowOpenShow         := True;
  FHighLowCloseShow        := True;

  FHighLowBarColor         := clAqua;
  FHighLowOpenColor        := clLime;
  FHighLowCloseColor       := clRed;

  FHighLowBarWidth         := 0.5;
  FHighLowOpenWidth        := 1;
  FHighLowCloseWidth       := 1;
  FHighLowOpenHeight       := 1.0;
  FHighLowCloseHeight      := 1.0;

  FHighLowShadowColor      := clGray;
  FHighLowBullishColor     := clWhite;
  FHighLowBearishColor     := clGray;

  SetBarWidth     (5);
  SetBarPenColor  (clRed);
  SetBarBrushColor(clRed);

  FFastDrawEnabled         := True;

  FXIncreasing             := True;

  FPixelList               := TStringList.Create;
end;
//****************************************************************************************************************************************************
destructor TiPlotChannel.Destroy;
begin
  while FPixelList.Count <> 0 do
    begin
      FPixelList.Objects[0].Free;
      FPixelList.Delete(0);
    end;
  FPixelList.Free;
  inherited Destroy;
end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.SetFillEnabled            (const Value:Boolean);begin SetBooleanProperty(Value,FFillEnabled,            TriggerChange );end;
procedure TiPlotChannel.SetFillReference          (const Value:Double );begin SetDoubleProperty (Value,FFillReference,          TriggerChange );end;
procedure TiPlotChannel.SetFillColor              (const Value:TColor );begin SetColorProperty  (Value,FFillColor,              TriggerChange );end;
procedure TiPlotChannel.SetFillUseChannelColor    (const Value:Boolean);begin SetBooleanProperty(Value,FFillUseChannelColor,    TriggerChange );end;
procedure TiPlotChannel.SetDigitalEnabled         (const Value:Boolean);begin SetBooleanProperty(Value,FDigitalEnabled,         TriggerChange );end;
procedure TiPlotChannel.SetDigitalReferenceHigh   (const Value:Double );begin SetDoubleProperty (Value,FDigitalReferenceHigh,   TriggerChange );end;
procedure TiPlotChannel.SetDigitalReferenceLow    (const Value:Double );begin SetDoubleProperty (Value,FDigitalReferenceLow,    TriggerChange );end;
procedure TiPlotChannel.SetFastDrawEnabled        (const Value:Boolean);begin SetBooleanProperty(Value,FFastDrawEnabled,        TriggerChange );end;
procedure TiPlotChannel.SetBarEnabled             (const Value:Boolean);begin SetBooleanProperty(Value,FBarEnabled,             TriggerChange );end;
procedure TiPlotChannel.SetBarPenUseChannelColor  (const Value:Boolean);begin SetBooleanProperty(Value,FBarPenUseChannelColor,  TriggerChange );end;
procedure TiPlotChannel.SetBarBrushUseChannelColor(const Value:Boolean);begin SetBooleanProperty(Value,FBarBrushUseChannelColor,TriggerChange );end;
procedure TiPlotChannel.SetHighLowEnabled         (const Value:Boolean);begin SetBooleanProperty(Value,FHighLowEnabled,         TriggerChange );end;
procedure TiPlotChannel.SetHighLowBarColor        (const Value:TColor );begin SetColorProperty  (Value,FHighLowBarColor,        TriggerChange );end;
procedure TiPlotChannel.SetHighLowBarWidth        (const Value:Double );begin SetDoubleProperty (Value,FHighLowBarWidth,        TriggerChange );end;
procedure TiPlotChannel.SetHighLowOpenShow        (const Value:Boolean);begin SetBooleanProperty(Value,FHighLowOpenShow,        TriggerChange );end;
procedure TiPlotChannel.SetHighLowOpenColor       (const Value:TColor );begin SetColorProperty  (Value,FHighLowOpenColor,       TriggerChange );end;
procedure TiPlotChannel.SetHighLowOpenWidth       (const Value:Double );begin SetDoubleProperty (Value,FHighLowOpenWidth,       TriggerChange );end;
procedure TiPlotChannel.SetHighLowOpenHeight      (const Value:Double );begin SetDoubleProperty (Value,FHighLowOpenHeight,      TriggerChange );end;
procedure TiPlotChannel.SetHighLowCloseShow       (const Value:Boolean);begin SetBooleanProperty(Value,FHighLowCloseShow,       TriggerChange );end;
procedure TiPlotChannel.SetHighLowCloseColor      (const Value:TColor );begin SetColorProperty  (Value,FHighLowCloseColor,      TriggerChange );end;
procedure TiPlotChannel.SetHighLowCloseWidth      (const Value:Double );begin SetDoubleProperty (Value,FHighLowCloseWidth,      TriggerChange );end;
procedure TiPlotChannel.SetHighLowCloseHeight     (const Value:Double );begin SetDoubleProperty (Value,FHighLowCloseHeight,     TriggerChange );end;
procedure TiPlotChannel.SetHighLowShadowColor     (const Value:TColor );begin SetColorProperty  (Value,FHighLowShadowColor,     TriggerChange );end;
procedure TiPlotChannel.SetHighLowBullishColor    (const Value:TColor );begin SetColorProperty  (Value,FHighLowBullishColor,    TriggerChange );end;
procedure TiPlotChannel.SetHighLowBearishColor    (const Value:TColor );begin SetColorProperty  (Value,FHighLowBearishColor,    TriggerChange );end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.SetHighLowStyle(const Value: TiPlotHighLowStyle);
begin
  if FHighLowStyle <> Value then
    begin
      FHighLowStyle := Value;
      TriggerChange(Self);
    end;
end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.SetInterpolationStyle(const Value: TiPlotInterpolationStyle);
begin
  if FInterpolationStyle <> Value then
    begin
      FInterpolationStyle := Value;
      TriggerChange(Self);
    end;
end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.SetDigitalReferenceStyle(const Value: TiPlotDigitalReferenceStyle);
begin
  if FDigitalReferenceStyle <> Value then
    begin
      FDigitalReferenceStyle := Value;
      TriggerChange(Self);
    end;
end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.SetFillStyle(const Value: TBrushStyle);
begin
  if FFillStyle <> Value then
    begin
      FFillStyle := Value;
      TriggerChange(Self);
    end;
end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.AddYArray(XInterval: Double; YData: Variant);
var
  x          : Integer;
  LowBoundY  : Integer;
  HighBoundY : Integer;
  XStart     : Double;
begin
  if VarArrayDimCount(YData) <> 1 then raise Exception.Create('Y-Data array must be 1 dimensional');

  LowBoundY  := VarArrayLowBound (YData, 1);
  HighBoundY := VarArrayHighBound(YData, 1);

  if Count = 0 then XStart := 0 else XStart := DataX[Count-1];

  for x := LowBoundY to HighBoundY do
    AddXY(XStart + (x-LowBoundY)*XInterval, YData[x]);
end;
//****************************************************************************************************************************************************
function TiPlotChannel.AddXNull(X: Double): Integer;
begin
  Result := DataList.Add(X, 0);
  DataList.Null [DataList.Count-1] := True;
  DataList.Empty[DataList.Count-1] := False;

  if XAxisTrackingEnabled then
    begin
      if Assigned(XAxis) then XAxis.NewTrackingData(X);
    end;

  TriggerChange(Self);
end;
//****************************************************************************************************************************************************
function TiPlotChannel.AddXEmpty(X: Double): Integer;
begin
  Result := DataList.Add(X, 0);
  DataList.Null [DataList.Count-1] := False;
  DataList.Empty[DataList.Count-1] := True;

  if XAxisTrackingEnabled then
    begin
      if Assigned(XAxis) then XAxis.NewTrackingData(X);
    end;

  TriggerChange(Self);
end;
//****************************************************************************************************************************************************
function TiPlotChannel.AddHighLow(X, High, Low, Open, Close: Double): Integer;
begin
  Result := DataList.Add(X, 0);
  DataList.High [Result] := High;
  DataList.Low  [Result] := Low;
  DataList.Open [Result] := Open;
  DataList.Close[Result] := Close;

  if XAxisTrackingEnabled then
    begin
      if Assigned(XAxis) then XAxis.NewTrackingData(X);
    end;

  TriggerChange(Self);
end;
//****************************************************************************************************************************************************
function TiPlotChannel.AddYElapsedTime   (Y: Double): Integer;begin Result := AddXY (Now - FElapsedStartTime, Y);          end;
function TiPlotChannel.AddYElapsedSeconds(Y: Double): Integer;begin Result := AddXY((Now - FElapsedStartTime)*60*60*24, Y);end;
function TiPlotChannel.AddYNow           (Y: Double): Integer;begin Result := AddXY (Now, Y);                              end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.ResetElapsedStartTime;
begin
 FElapsedStartTime := Now;
end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.DrawSetup(const Canvas: TCanvas);
var
  x               : Integer;
  iPlotPixelPoint : TiPlotPixelPoint;
begin
  CanDraw := False;

  if not Assigned(XAxis) then exit;
  if not Assigned(YAxis) then exit;
  if not Visible         then exit;
  if DataList.Count = 0  then exit;

  if DataList.Count > 2 then
    begin
      if DataList.X[0] <= DataList.X[1] then FXIncreasing := True else FXIncreasing := False;
    end
  else FXIncreasing := True;

  CalcStartXIndex;
  CalcStopXIndex;

  if not (FInterpolationStyle in [ipistDifferential, ipistDifferentialTerminated]) then
    begin
      if StartIndex = - 1 then exit;
      if StopIndex  = - 1 then exit;
    end;

  case FDigitalReferenceStyle of
    ipdrScale : begin
                  FPixelsHigh := YAxis.PositionToPixels(FDigitalReferenceHigh);
                  FPixelsLow  := YAxis.PositionToPixels(FDigitalReferenceLow);
                end
    else        begin
                  FPixelsHigh := YAxis.PositionToPixels(YAxis.Span*FDigitalReferenceHigh/100 + YAxis.Min);
                  FPixelsLow  := YAxis.PositionToPixels(YAxis.Span*FDigitalReferenceLow /100 + YAxis.Min);
                end;
  end;


  if XAxis.MinPixels < XAxis.MaxPixels then
    begin
      FPixelListStart := XAxis.MinPixels;
      FPixelListStop  := XAxis.MaxPixels;
    end
  else
    begin
      FPixelListStart := XAxis.MaxPixels;
      FPixelListStop  := XAxis.MinPixels;
    end;

  while FPixelList.Count < (FPixelListStop - FPixelListStart +1) do
    begin
      iPlotPixelPoint := TiPlotPixelPoint.Create;
      FPixelList.AddObject('', iPlotPixelPoint);
    end;

  for x := 0 to FPixelList.Count - 1 do
    (FPixelList.Objects[x] as TiPlotPixelPoint).Null := True;

  CanDraw := True;
end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.Draw(const Canvas: TCanvas; const BackGroundColor: TColor);
begin
  try
    DrawFill         (Canvas, XYAxesReversed);
    DrawBar          (Canvas, XYAxesReversed);
    DrawConnectPoints(Canvas, XYAxesReversed);
    DrawMarkers      (Canvas, XYAxesReversed);

    case FHighLowStyle of
      iphlsOpenClose   : DrawHighLow           (Canvas, XYAxesReversed);
      iphlsCandleStick : DrawHighLowCandleStick(Canvas, XYAxesReversed);
    end;

  except
  end;
end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.DrawConnectPoints(Canvas: TCanvas; XYAxisReverse: Boolean);
begin
  if not TraceVisible then Exit;

  with Canvas do
    begin
      Pen.Color   := Color;
      Brush.Style := bsClear;
      Pen.Style   := TPenStyle(TraceLineStyle);
      if TraceLineWidth = 1 then Pen.Width := 0 else Pen.Width := TraceLineWidth;
    end;

  if FDigitalEnabled then
    DrawDigital(Canvas, XYAxisReverse)
  else
    case FInterpolationStyle of
      ipistStraightLine           : if FFastDrawEnabled then DrawFast(Canvas, XYAxisReverse) else inherited DrawConnectPoints(Canvas, XYAxisReverse);
      ipistCubicSpline            : DrawCubicSpline (Canvas, XYAxisReverse);
      ipistPolynomial             : DrawPolynomial  (Canvas, XYAxisReverse);
      ipistRational               : DrawRational    (Canvas, XYAxisReverse);
      ipistDifferential           : DrawDifferential(Canvas, XYAxisReverse);
      ipistDifferentialTerminated : DrawDifferential(Canvas, XYAxisReverse);
    end;
end;
//****************************************************************************************************************************************************
procedure TiPlotChannel.DrawFill(Canvas: TCanvas; XYAxisReverse: Boolean);
var
  i            : Integer;
  Point1Empty  : Boolean;
  Point1XValue : Double;
  Point1YValue : Double;
begin
  if not FFillEnabled                         then Exit;
  if FFillStyle = bsClear                     then Exit;
  if FInterpolationStyle <> ipistStraightLine then Exit;
  if FDigitalEnabled                          then Exit;

  Point1Empty  := True;
  Point1XValue := 0;
  Point1YValue := 0;

  with Canvas do
    begin
      Brush.Style := FFillStyle;
      if FillUseChannelColor then Brush.Color := Color else Brush.Color := FillColor;
      Pen.Color := Brush.Color;