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

📄 teesmith.pas

📁 Delphi TeeChartPro.6.01的源代码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{*********************************************}
{   TeeChart Delphi Component Library         }
{   TSmithSeries Component                    }
{   Copyright (c) 2000-2003 Marjan Slatinek   }
{*********************************************}
unit TeeSmith;
{$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}
     TeEngine, Chart, Series, TeCanvas, TeePolar;

type
  TSmithSeries = class(TCircledSeries)
  private
    FCirclePen  : TChartPen;
    FImagSymbol : String;
    FPointer    : TSeriesPointer;

    OldX,OldY   : Integer;
    function GetResistanceValues: TChartValueList;
    function GetReactance: TChartValueList;
    Function GetCPen:TChartPen;
    Function GetRPen:TChartPen;
    Function GetCLabels:Boolean;
    Function GetRLabels:Boolean;
    procedure SetResistanceValues(Value: TChartValueList);
    procedure SetReactance(Value: TChartValueList);
    procedure SetRPen(const Value: TChartPen);
    procedure SetCPen(const Value: TChartPen);
    procedure SetPointer(const Value: TSeriesPointer);
    procedure SetCLabels(const Value: Boolean);
    procedure SetRLabels(const Value: Boolean);
    Procedure SetCirclePen(Const Value:TChartPen);
    function GetCLabelsFont: TTeeFont;
    function GetRLabelsFont: TTeeFont;
    procedure SetCLabelsFont(const Value: TTeeFont);
    procedure SetRLabelsFont(const Value: TTeeFont);
    procedure SetImagSymbol(Const Value:String);
  protected
    procedure AddSampleValues(NumValues: Integer); override;
    procedure DoBeforeDrawValues; override;
    procedure DrawAllValues; override;
    procedure DrawValue(ValueIndex: Integer); override;
    class Function GetEditorClass:String; override;
    function GetXCircleLabel(Const Reactance:Double):String;
    procedure LinePrepareCanvas(ValueIndex:Integer);
    Procedure PrepareForGallery(IsEnabled:Boolean); override; { 5.02 }
    Procedure SetParentChart(Const Value:TCustomAxisPanel); override;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    function AddPoint(Const Resist,React: Double; Const ALabel: String='';
                      AColor: TColor=clTeeColor): Integer;
    function CalcXPos(ValueIndex: Integer): Integer; override;
    function CalcYPos(ValueIndex: Integer): Integer; override;
    function Clicked(X,Y:Integer):Integer;override;
    procedure DrawRCircle(Const Value:Double; Z:Integer; ShowLabel:Boolean=True);
    procedure DrawXCircle(Const Value:Double; Z:Integer; ShowLabel:Boolean=True);
    procedure PosToZ(X,Y: Integer; var Resist,React: Double);
    procedure ZToPos(Const Resist,React: Double; var X,Y: Integer);
  published
    property Active;
    property CCirclePen:TChartPen read GetCPen write SetCPen;
    property CircleBackColor;
    property CircleGradient;
    property CirclePen:TChartPen read FCirclePen write SetCirclePen;
    property CLabels:Boolean read GetCLabels write SetCLabels;
    property CLabelsFont:TTeeFont read GetCLabelsFont write SetCLabelsFont;
    property ColorEachPoint;
    property ImagSymbol:String read FImagSymbol write SetImagSymbol;

    property ResistanceValues:TChartValueList read GetResistanceValues write SetResistanceValues;
    property ReactanceValues:TChartValueList read GetReactance write SetReactance;
    property Pen;
    property Pointer:TSeriesPointer read FPointer write SetPointer;
    property RCirclePen:TChartPen read GetRPen write SetRPen;
    property RLabels:Boolean read GetRLabels write SetRLabels;
    property RLabelsFont:TTeeFont read GetRLabelsFont write SetRLabelsFont;
  end;

implementation

Uses TeeProCo, TeeConst;

{ TSmithSeries }
Constructor TSmithSeries.Create(AOwner: TComponent);
begin
  inherited;
  XValues.Name := TeeMsg_SmithResistance;
  XValues.Order:= loNone; { 5.02 }
  YValues.Name := TeeMsg_SmithReactance;
  FPointer     := TSeriesPointer.Create(Self);
  FCirclePen   := CreateChartPen;
  FImagSymbol  := 'i'; { 5.02 }
end;

Destructor TSmithSeries.Destroy;
begin
  FCirclePen.Free;
  FreeAndNil(FPointer);
  inherited;
end;

procedure TSmithSeries.SetCLabels(Const Value: Boolean);
begin
  GetVertAxis.Labels:=Value;
end;

procedure TSmithSeries.SetRLabels(Const Value: Boolean);
begin
  GetHorizAxis.Labels:=Value;
end;

procedure TSmithSeries.SetRPen(const Value: TChartPen);
begin
  GetVertAxis.Grid.Assign(Value);
end;

procedure TSmithSeries.SetCPen(const Value: TChartPen);
begin
  GetHorizAxis.Grid.Assign(Value);
end;

procedure TSmithSeries.SetPointer(const Value: TSeriesPointer);
begin
  FPointer.Assign(Value);
end;

function TSmithSeries.GetResistanceValues: TChartValueList;
begin
  Result:=XValues;
end;

function TSmithSeries.GetReactance: TChartValueList;
begin
  Result:=YValues;
end;

procedure TSmithSeries.SetResistanceValues(Value: TChartValueList);
begin
  SetXValues(Value);
end;

procedure TSmithSeries.SetReactance(Value: TChartValueList);
begin
  SetYValues(Value);
end;

procedure TSmithSeries.LinePrepareCanvas(ValueIndex:Integer);
begin
  With ParentChart.Canvas do
  begin
    if Self.Pen.Visible then
    begin
      if ValueIndex=-1 then AssignVisiblePenColor(Self.Pen,SeriesColor)
                       else AssignVisiblePenColor(Self.Pen,ValueColor[ValueIndex]);
    end
    else Pen.Style:=psClear;
    BackMode:=cbmTransparent;
  end;
end;

{ impendance to Position}
{ (GRe,GIm)=(1-z)/(1+z)                   }
procedure TSmithSeries.ZToPos(Const Resist,React: Double; var X,Y: Integer);
var GRe    : Double;
    GIm    : Double;
    Norm2  : Double;
    InvDen : Double;
begin
  Norm2 := Sqr(Resist)+Sqr(React);
  InvDen := 1/(Norm2+2*Resist+1);
  GRe := (Norm2-1)*InvDen;
  GIm := 2*React*InvDen;
  X := CircleXCenter+Round(GRe*XRadius);
  Y := CircleYCenter-Round(GIm*YRadius);
end;

{ Position to impendance}
{ (ZRe,ZIm)=(1+gamma)/(1-gamma)                }
procedure TSmithSeries.PosToZ(X,Y: Integer; var Resist,React: Double);
var GRe    : Double;
    GIm    : Double;
    Norm2  : Double;
    InvDen : Double;
begin
  X := X-CircleXCenter;
  Y := CircleYCenter-Y;
  GRe := X/XRadius;
  GIm := Y/YRadius;
  Norm2 := Sqr(GRe)+Sqr(GIm);
  InvDen := 1/(Norm2-2*GRe+1);
  Resist := (1-Norm2)*InvDen;
  React := 2*GIm*InvDen;
end;

Procedure TSmithSeries.DrawRCircle(Const Value:Double; Z:Integer;
                                   ShowLabel: Boolean);

  Procedure DrawrCircleLabel(rVal: Double; X,Y: Integer);
  begin
    if GetHorizAxis.Visible and ShowLabel then { 5.02 }
    With ParentChart.Canvas do
    begin
      AssignFont(RLabelsFont);
      TextAlign:=ta_Center;
      BackMode:=cbmTransparent;
      TextOut3D(X,Y,EndZ,FloatToStr(rVal));
    end;
  end;

Var tmp       : Double;
    HalfXSize : Integer;
    HalfYSize : Integer;
begin
  if Value<>-1 then
  begin
    { Transform R }
    tmp := 1/(1+Value);
    HalfXSize := Round(tmp*XRadius);
    HalfYSize := Round(tmp*YRadius);
    { Circles are always right aligned }
    With ParentChart.Canvas do
        EllipseWithZ(CircleRect.Right-2*HalfXSize,CircleYCenter-HalfYSize,
                     CircleRect.Right,CircleYCenter+HalfYSize,Z);
    if ShowLabel then { 5.02 (was if RLabels) }
       DrawRCircleLabel(Value,CircleRect.Right-2*HalfXSize,CircleYCenter);
  end;
end;

procedure TSmithSeries.DrawValue(ValueIndex: Integer);
var X : Integer;
    Y : Integer;
begin
  ZToPos(XValues.Value[ValueIndex],YValues.Value[ValueIndex],X,Y);
  LinePrepareCanvas(ValueIndeX);
  With ParentChart.Canvas do
    if ValueIndex=FirstValueIndex then MoveTo3D(X,Y,StartZ)  { <-- first point }
    else
    if (X<>OldX) or (Y<>OldY) then LineTo3D(X,Y,StartZ);

  OldX:=X;
  OldY:=Y;
end;

type TPointerAccess=class(TSeriesPointer);
     TAxisAccess=class(TChartAxis);

procedure TSmithSeries.DrawAllValues;
var t        : Integer;
    tmpColor : TColor;
begin
  inherited;

  With FPointer do
  if Visible then
    for t:=FirstValueIndex to LastValueIndex do
    begin
      tmpColor:=ValueColor[t];
      TPointerAccess(FPointer).PrepareCanvas(ParentChart.Canvas,tmpColor);
      Draw(CalcXPos(t),CalcYPos(t),tmpColor,Style);
    end;
end;

Procedure TSmithSeries.SetParentChart(Const Value:TCustomAxisPanel);
Begin
  inherited;
  if Assigned(FPointer) then Pointer.ParentChart:=Value;
  if Assigned(ParentChart) and (csDesigning in ComponentState) then
     ParentChart.View3D:=False;
end;

procedure TSmithSeries.DrawXCircle(Const Value:Double; Z: Integer; ShowLabel: boolean);

  Procedure DrawXCircleLabel(XVal: Double; X,Y: Integer);
  var Angle     : Double;
      tmpHeight : Integer;
      tmpWidth  : Integer;
      tmpSt     : String;
  begin
    if GetVertAxis.Visible and ShowLabel then { 5.02 }
    With ParentChart.Canvas do
    begin
      AssignFont(CLabelsFont);
      tmpHeight:=FontHeight;
      tmpSt:=GetxCircleLabel(XVal);
      Angle := PointToAngle(X,Y)*57.29577;
      if Angle>=360 then Angle:=Angle-360;

⌨️ 快捷键说明

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