teeshape.pas

TeeChart 7.0 With Source在Delphi 7.0中的安装

                                     TeePoint(tmpMidX,Top),
                                     BottomRight] );
     chasInvertTriangle,
     chasInvertPyramid  : Polygon( [ TopLeft,
                                     TeePoint(tmpMidX,Bottom),
                                     TeePoint(Right,Top)]);
     chasLine           : Line(Left,Top,Right,Bottom);
     chasDiamond        : Polygon( [ TeePoint(Left,tmpMidY),
                                     TeePoint(tmpMidX,R.Top),
                                     TeePoint(Right,tmpMidY),
                                     TeePoint(tmpMidX,Bottom)] );
     chasCube           : Rectangle(R);
     chasCross          : DrawCross2D;
     chasDiagCross      : DrawDiagonalCross2D;
     chasStar           : begin DrawCross2D; DrawDiagonalCross2D; end;
    end;
  end;
end;

procedure TChartShape.DrawText(Const R:TRect);
Const ShapeHorizMargin=4;
      BrushColors:Array[Boolean] of TColor=(clBlack,clWhite);
var t        : Integer;
    tmpPosX  : Integer;
    tmpH     : Integer;
    tmpMidX  : Integer;
    tmpMidY  : Integer;
    tmpPosY  : Integer;
    tmpWidth : Integer;
begin
  With ParentChart,Canvas do
  if Self.FText.Count>0 then
  begin
    AssignFont(Self.Font);
    With Font do
         if Brush.Color=Color then Color:=BrushColors[Color=clBlack];
    tmpH:=FontHeight;
    RectCenter(R,tmpMidX,tmpMidY);
    Case FVertAlign of
      vaTop:    tmpPosY:=R.Top;
      vaCenter: tmpPosY:=tmpMidY-Round(tmpH*Self.FText.Count/2.0);
    else
      tmpPosY:=R.Bottom-Round(tmpH*Self.FText.Count);
    end;
    BackMode:=cbmTransparent;
    for t:=0 to Self.FText.Count-1 do
    begin
      tmpWidth:=TextWidth(FText[t]);
      Case FAlignment of
        taCenter       : tmpPosX:=tmpMidX-(tmpWidth div 2);
        taLeftJustify  : tmpPosX:=R.Left+Pen.Width+ShapeHorizMargin;
      else
        tmpPosX:=R.Right-Pen.Width-tmpWidth-ShapeHorizMargin;
      end;
      TextAlign:=TA_LEFT; { 5.01 }
      if FXYStyle=xysPixels then
         TextOut(tmpPosX,tmpPosY,FText[t])
      else
         TextOut3D(tmpPosX,tmpPosY,StartZ,FText[t]);
      Inc(tmpPosY,tmpH);
    end;
  end;
end;

Procedure TChartShape.SetShapeRectangle(Const ARect:TRect);
begin
  FXYStyle:=xysPixels;
  With ARect do
  begin
    X0:=Left;
    Y0:=Top;
    X1:=Right;
    Y1:=Bottom;
  end;
end;

Function TChartShape.GetShapeRectangle:TRect;
begin
  Case FXYStyle of
    xysPixels: result:=TeeRect( Trunc(X0), Trunc(Y0), Trunc(X1), Trunc(Y1) );
    xysAxis  : result:=TeeRect( CalcXPos(0),CalcYPos(0),CalcXPos(1),CalcYPos(1) );
  else
    With Result do
    begin
      Left:=CalcXPos(0);
      Top :=CalcYPos(0);
      Right:=Left+Trunc(X1);
      Bottom:=Top+Trunc(Y1);
    end;
  end;
end;

Function TChartShape.GetAdjustedRectangle:TRect;
begin
  result:=OrientRectangle(GetShapeRectangle);
  with result do
  begin
    if Top=Bottom then Bottom:=Top+1;
    if Left=Right then Right:=Left+1;
  end;
end;

procedure TChartShape.DrawValue(ValueIndex:Integer);
Var R        : TRect;
    DestRect : TRect;
    tmp      : Boolean;
Begin
  if (Count=2) and (ValueIndex=0) then
  begin
    R:=GetAdjustedRectangle;
    if {$IFNDEF CLX}Windows.{$ENDIF}IntersectRect(DestRect,R,ParentChart.ChartRect) then
    begin
      if FXYStyle=xysPixels then tmp:=False
                            else tmp:=ParentChart.View3D;
      if FStyle=chasLine then DrawShape(tmp,GetShapeRectangle)
                         else DrawShape(tmp,R);
      DrawText(R);
    end;
  end;
End;

Procedure TChartShape.AddDefaultPoints;
begin
  AddXY(  0,  0);
  AddXY(100,100);
end;

Procedure TChartShape.AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False);
Begin
  With RandomBounds(1) do
  if StepX=0 then AddDefaultPoints
  else
  begin
    AddXY( tmpX+(StepX/8.0), tmpY/2);
    AddXY( tmpX+StepX-(StepX/8.0),tmpY+RandomValue(Round(DifY)));
  end;
end;

Function TChartShape.Clicked(x,y:Integer):Integer;
var R       : TRect;
    tmp     : Boolean;
    tmpMidX : Integer;
    tmpMidY : Integer;
    P       : TPoint;
Begin
  if (ParentChart<>nil) then ParentChart.Canvas.Calculate2DPosition(X,Y,StartZ);

  P.X:=X;
  P.Y:=Y;
  R:=GetShapeRectangle;
  RectCenter(R,tmpMidX,tmpMidY);

  Case FStyle of
     chasVertLine: tmp:=PointInLine(P,tmpMidX,R.Top,tmpMidX,R.Bottom);
    chasHorizLine: tmp:=PointInLine(P,R.Left,tmpMidY,R.Right,tmpMidY);
         chasLine: tmp:=PointInLine(P,R.TopLeft,R.BottomRight);
      chasDiamond: tmp:=PointInPolygon( P,[ TeePoint(tmpMidX,R.Top),
                                            TeePoint(R.Right,tmpMidY),
                                            TeePoint(tmpMidX,R.Bottom),
                                            TeePoint(R.Left,tmpMidY)] );
     chasTriangle,
     chasPyramid : tmp:=PointInTriangle( P,R.Left,R.Right,R.Bottom,R.Top);
chasInvertTriangle,
chasInvertPyramid: tmp:=PointInTriangle( P,R.Left,R.Right,R.Top,R.Bottom);
       chasCircle: tmp:=PointInEllipse(P,R);
  else
    tmp:=PointInRect(OrientRectangle(R),x,y);  // 7.0 #1227
  end;

  if tmp then result:=0 else result:=TeeNoPointClicked;
end;

Procedure TChartShape.PrepareForGallery(IsEnabled:Boolean);
Const EnabledColor1:Array[Boolean] of TColor=(clSilver,clBlue);
      EnabledColor2:Array[Boolean] of TColor=(clSilver,clRed);
Begin
  inherited;

  if IsEnabled then 
     Font.Color:=clYellow
  else
     Font.Color:=clDkGray;

  Font.Style:=[fsBold];
  Font.Size:=12;
  Text.Clear;

  if ParentChart.SeriesList.IndexOf(Self)=1 then
  begin
    Style:=chasCircle;
    Brush.Color:=EnabledColor1[IsEnabled];
    Text.Add(TeeMsg_ShapeGallery1);
  end
  else
  begin
    Style:=chasTriangle;
    Brush.Color:=EnabledColor2[IsEnabled];
    Text.Add(TeeMsg_ShapeGallery2);
  end
end;

class Function TChartShape.GetEditorClass:String;
Begin
  result:='TChartShapeEditor';  { <-- dont translate }
end;

Procedure TChartShape.Assign(Source:TPersistent);
begin
  if Source is TChartShape then
  With TChartShape(Source) do
  begin
    Self.FAlignment     :=FAlignment;
    Self.Font           :=FFont;
    Self.Gradient       :=Gradient;
    Self.FRoundRectangle:=FRoundRectangle;
    Self.FStyle         :=FStyle;
    Self.Text           :=FText;
    Self.FTransparent   :=FTransparent;
    Self.FVertAlign     :=FVertAlign;
    Self.FXYStyle       :=FXYStyle;
  end;
  inherited;
end;

Function TChartShape.IsValidSourceOf(Value:TChartSeries):Boolean;
begin
  result:=Value is TChartShape;
end;

procedure TChartShape.SetFont(Value: TTeeFont);
begin
  FFont.Assign(Value);
end;

procedure TChartShape.SetAlignment(Value: TAlignment);
begin
  if FAlignment<>Value then
  begin
    FAlignment:=Value;
    Repaint;
  end;
end;

procedure TChartShape.SetText(Value : TStrings);
begin
  FText.Assign(Value);
  Repaint;
end;

procedure TChartShape.SetTransparent(Value: Boolean);
begin
  SetBooleanProperty(FTransparent,Value);
end;

procedure TChartShape.SetRoundRectangle(Value: Boolean);
begin
  SetBooleanProperty(FRoundRectangle,Value);
end;

procedure TChartShape.SetXYStyle(Value: TChartShapeXYStyle);
begin
  if FXYStyle<>Value then
  begin
    FXYStyle:=Value;
    Repaint;
  end;
end;

Function TChartShape.UseAxis:Boolean;
begin
  result:=XYStyle<>xysPixels;
end;

Procedure TChartShape.CalcZOrder;
begin
  if UseAxis then inherited;
end;

Function TChartShape.MoreSameZOrder:Boolean;
begin
  result:=False;
end;

procedure TChartShape.SetVertAlign(Value: TTeeVertAlign);
begin
  if FVertAlign<>Value then
  begin
    FVertAlign:=Value;
    Repaint;
  end;
end;

class procedure TChartShape.CreateSubGallery(
  AddSubChart: TChartSubGalleryProc);
begin
  inherited;
  AddSubChart(TeeMsg_Rectangle);
  AddSubChart(TeeMsg_VertLine);
  AddSubChart(TeeMsg_HorizLine);
  AddSubChart(TeeMsg_Ellipse);
  AddSubChart(TeeMsg_DownTri);
  AddSubChart(TeeMsg_Line);
  AddSubChart(TeeMsg_Diamond);
  AddSubChart(TeeMsg_Cube);
  AddSubChart(TeeMsg_Cross);
  AddSubChart(TeeMsg_DiagCross);
  AddSubChart(TeeMsg_Star);
  AddSubChart(TeeMsg_Pyramid);
  AddSubChart(TeeMsg_InvPyramid);
  AddSubChart(TeeMsg_Hollow);
end;

class procedure TChartShape.SetSubGallery(ASeries: TChartSeries;
  Index: Integer);
begin
  With TChartShape(ASeries) do
  Case Index of
    1: Style:=chasRectangle;
    2: Style:=chasVertLine;
    3: Style:=chasHorizLine;
    4: Style:=chasCircle;
    5: Style:=chasInvertTriangle;
    6: Style:=chasLine;
    7: Style:=chasDiamond;
    8: Style:=chasCube;
    9: Style:=chasCross;
   10: Style:=chasDiagCross;
   11: Style:=chasStar;
   12: Style:=chasPyramid;
   13: Style:=chasInvertPyramid;
   14: Transparent:=not Transparent;
  end;
end;

procedure TChartShape.SetGradient(const Value: TChartGradient);
begin
  FGradient.Assign(Value);
end;

procedure TChartShape.ChangeToManual;
begin
  ManualData:=True;
  Repaint;
end;

initialization
  RegisterTeeSeries(TChartShape,
     {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryShape,
     {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryStandard, 2);
end.